diff options
| -rw-r--r-- | cachetheyaml.hs | 57 | ||||
| -rw-r--r-- | clientreport.hs | 48 | ||||
| -rw-r--r-- | duedatereport.hs | 62 | ||||
| -rw-r--r-- | sanitycheck.hs | 85 | ||||
| -rw-r--r-- | sevendaysactivity.hs | 42 |
5 files changed, 294 insertions, 0 deletions
diff --git a/cachetheyaml.hs b/cachetheyaml.hs new file mode 100644 index 0000000..78129ff --- /dev/null +++ b/cachetheyaml.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Control.Exception.Base as E +import qualified Data.FileStore as DF +import qualified Data.List as L +import qualified Data.List.Split as DLS +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import qualified Data.ByteString.Char8 as DBC8 +import qualified Data.ByteString as DB +import qualified Data.ByteString.Lazy as DBL +import qualified Data.Text as T +import qualified Data.Yaml as Y +import System.IO (hPutStr, hPutStrLn, stderr) + +isLeft :: Either a b -> Bool +isLeft (Left _) = True +isLeft (Right _) = False + +markdownFiles :: [FilePath] -> [FilePath] +markdownFiles = filter (L.isSuffixOf ".mdwn") + +extractYAML :: [DB.ByteString] -> [DB.ByteString] +extractYAML x + | elem topDelim x && elem bottomDelim x = DLS.splitOneOf [topDelim,bottomDelim] x !! 1 + | otherwise = [DB.empty] + where topDelim = DBC8.pack "--YAML--" + bottomDelim = DBC8.pack "..." + +revisionToContents :: (FilePath, DF.RevisionId) -> IO DBL.ByteString +revisionToContents (p,r) = E.catch (DF.retrieve repo p (Just r)) + (\e -> do let err = show (e :: E.IOException) + hPutStr stderr ("Warning: Couldn't retrieve " ++ show (p,r) ++ ": " ++ err) + return DBL.empty) + +contentsToYAML :: DBL.ByteString -> Either Y.ParseException (Map.Map T.Text T.Text) +contentsToYAML = fmap denullify . Y.decodeEither' . DBC8.unlines . extractYAML . DBC8.lines . DBL.toStrict + where + denullify :: Map.Map T.Text (Maybe T.Text) -> Map.Map T.Text T.Text + denullify = Map.map (fromMaybe "") + +stampFilename :: FilePath -> Map.Map T.Text T.Text -> Map.Map T.Text T.Text +stampFilename = Map.insert "filename" . T.pack + +repo :: DF.FileStore +repo = DF.gitFileStore "." + +main :: IO () +main = do + repofiles <- DF.index repo + let markdowns = markdownFiles repofiles + latestrevs <- mapM (DF.latest repo) markdowns + repodata <- mapM revisionToContents (zip markdowns latestrevs) + let repocontents = map contentsToYAML repodata + allfilemapping = zipWith (stampFilename) markdowns (map (either (const Map.empty) id) repocontents) + mapM_ (hPutStrLn stderr . show) (filter (\(_,y) -> isLeft y) (zip markdowns repocontents)) + Y.encodeFile "/home/report/tmp/yamlcache.yaml" allfilemapping diff --git a/clientreport.hs b/clientreport.hs new file mode 100644 index 0000000..c2cfdd5 --- /dev/null +++ b/clientreport.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.CaseInsensitive as CI +import Data.List (sortBy) +import Data.Maybe +import qualified Data.Map as Map +import Data.Monoid ((<>)) +import Data.Ord (comparing) -- , Down(..)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import Data.Yaml + +import System.Environment (getArgs) + +data Client = Client { + _assignee :: Text + , _status :: Text + , _clientname :: Text + , _filename :: Text -- should be ByteString? +} + +toClient :: Map.Map Text Text -> Client +toClient ymap = Client user status client filename + where + user = fromMaybe "ERROR" (Map.lookup "AssignedTo" ymap) + status = fromMaybe "ERROR" (Map.lookup "Status" ymap) + client = fromMaybe "ERROR" (Map.lookup "ClientName" ymap) + filename = fromMaybe "ERROR" (Map.lookup "filename" ymap) + +formatClient :: Client -> Text +formatClient c = T.concat [pad 10 (_assignee c), pad 7 (_status c), _clientname c, " (", _filename c, ")"] + where + pad x = T.justifyLeft x ' ' + +printIfNonEmpty :: [Client] -> IO () +printIfNonEmpty = mapM_ (TIO.putStrLn . formatClient) + +main :: IO () +main = do + yamlcache <- decodeFile "/home/report/tmp/yamlcache.yaml" + args <- fmap (map T.pack) getArgs + let ymap = fromJust yamlcache -- fix that + cs = map toClient ymap + statusopen = cs + useropen = if null args then statusopen else filter (\m -> elem (_assignee m) args) statusopen + uoclients = filter (\m -> "Client/" `T.isPrefixOf` (_filename m) && T.find (=='/') (T.drop 7 (_filename m)) == Nothing) useropen + printIfNonEmpty (sortBy (comparing (CI.mk . _clientname) <> comparing _assignee <> flip (comparing (_status))) uoclients) -- Down diff --git a/duedatereport.hs b/duedatereport.hs new file mode 100644 index 0000000..80cc396 --- /dev/null +++ b/duedatereport.hs @@ -0,0 +1,62 @@ +import Control.Monad (liftM2) +import Data.List (sortBy) +import Data.Time.Calendar +import Data.Time.Clock +import Data.Time.Clock.POSIX (posixDayLength) +import Data.Time.Format +import qualified Data.Map as Map +import Data.Maybe +import Data.Yaml +import System.Locale (defaultTimeLocale) +import System.Environment (getArgs) + +fieldFilter :: String -> String -> Map.Map String String -> Bool +fieldFilter field val ymap = Map.lookup field ymap == Just val + +statusFilter :: String -> Map.Map String String -> Bool +statusFilter = fieldFilter "Status" + +assigneeFilter :: String -> Map.Map String String -> Bool +assigneeFilter = fieldFilter "AssignedTo" + +formatDeadline :: Map.Map String String -> String +formatDeadline ymap = user ++ "|" ++ date ++ "|" ++ filename + where + user = fromMaybe "ERROR" (Map.lookup "AssignedTo" ymap) + date = fromMaybe "ERROR" (Map.lookup "Date" ymap) + filename = fromMaybe "ERROR" (Map.lookup "filename" ymap) + +dateParse :: String -> UTCTime +dateParse x = fromMaybe (UTCTime (fromGregorian 0 1 1) (secondsToDiffTime 0)) $ parseTime defaultTimeLocale "%Y-%m-%d" x + +dateConv :: Map.Map String String -> UTCTime +dateConv ymap = dateParse (fromMaybe "1900-01-01" (Map.lookup "Date" ymap)) + +dateSorter :: Map.Map String String -> Map.Map String String -> Ordering +dateSorter amap bmap = compare (dateConv amap) (dateConv bmap) + +dateFilter :: (UTCTime -> Bool) -> Map.Map String String -> Bool +dateFilter func ymap = func (dateConv ymap) + +printIfNonEmpty :: String -> [Map.Map String String] -> IO () +printIfNonEmpty _ [] = return () +printIfNonEmpty title ymap = do + putStrLn title + putStrLn $ take (length title) (repeat '=') + mapM_ (putStrLn . formatDeadline) ymap + putStrLn "" + +main :: IO () +main = do + Just yamlcache <- decodeFile "/home/report/tmp/yamlcache.yaml" + currentTime <- getCurrentTime + args <- getArgs + let ymap = yamlcache + statusdue = filter (\m -> statusFilter "Due" m) ymap + userdue = if args == [] then statusdue else filter (\m -> elem (fromMaybe "UNASSIGNED" (Map.lookup "AssignedTo" m)) args) statusdue + buggtime = sortBy dateSorter $ filter (dateFilter (<UTCTime (fromGregorian 2010 1 1) (secondsToDiffTime 0))) userdue + beforenow = sortBy dateSorter $ filter (dateFilter (liftM2 (&&) (<currentTime) (>=UTCTime (fromGregorian 2010 1 1) (secondsToDiffTime 0)))) userdue + nexteightweeks = sortBy dateSorter $ filter (dateFilter (liftM2 (&&) (<(addUTCTime (56 * posixDayLength) currentTime)) (>=currentTime))) userdue + printIfNonEmpty "Malformed Due Date" buggtime + printIfNonEmpty "PAST DUE" beforenow + printIfNonEmpty "Upcoming" nexteightweeks diff --git a/sanitycheck.hs b/sanitycheck.hs new file mode 100644 index 0000000..8744f5c --- /dev/null +++ b/sanitycheck.hs @@ -0,0 +1,85 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Control.Monad (when) +import Control.Monad.Trans.Either (runEitherT, left, right) +import Control.Monad.Writer (execWriter, tell, Writer) +import Data.Yaml +import Data.Maybe +import qualified Data.Map as Map +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Data.Time.Calendar +import Data.Time.Clock +import Data.Time.Format +import System.Locale (defaultTimeLocale) + +-- mix code and data +validassignees :: [Text] +validassignees = [ + "clint" + , "eben" + , "jdbean" + , "mishi" + , "mjones" + , "sullivan" + , "tanisha" + + , "jsavitt" + , "emorales" + ] + +data Page = Page { + _assignee :: Maybe Text + , _status :: Maybe Text + , _clientname :: Maybe Text + , _filename :: Maybe Text -- should be ByteString? + , _date :: Maybe Text + , _pageAddress :: Maybe Text + , _activityTitle :: Maybe Text + , _others :: [Text] +} + +toPage :: Map.Map Text Text -> Page +toPage ymap = Page user status client filename date pageaddr actitle weirds + where + user = Map.lookup "AssignedTo" ymap + status = Map.lookup "Status" ymap + client = Map.lookup "ClientName" ymap + filename = Map.lookup "filename" ymap + date = Map.lookup "Date" ymap + pageaddr = Map.lookup "PageAddress" ymap + actitle = Map.lookup "ActivityTitle" ymap + weirds = Map.keys . Map.filter (not . (`elem` ["AssignedTo", "Status", "ClientName", "filename", "Date", "PageAddress", "ActivityTitle"])) $ ymap + +vetPage :: Page -> Writer [Text] () +vetPage (Page muser mstatus mclient mfilename mdate mpageaddr mactitle weirds) = (runEitherT $ do + fn <- maybe (tell ["YAML block missing filename; this is seriously broken"] >> left ()) right mfilename + case (muser, mstatus `elem` [Just "Due", Just "open"]) of + (Nothing,True) -> tell ["No assignee for active page " `T.append` fn] + (Just u,True) -> if u `elem` validassignees then return () else tell ["Unknown assignee (" `T.append` u `T.append` ") for active page " `T.append` fn] + _ -> return () + status <- maybe (tell ["Missing status for " `T.append` fn] >> left ()) right mstatus + let clientdepth = case ("Client/" `T.isPrefixOf` fn, T.count "/" fn) of + (False, _) -> 0 + (True, x) -> x + when (not (status `elem` ["Due", "open", "closed"]) && clientdepth == 1) (tell [T.concat ["Unknown status (", status, ") for client page ", fn]]) + when (not (status `elem` ["Due", "open", "closed", "waiting"]) && clientdepth > 1) (tell [T.concat ["Unknown status (", status, ") for client matter page ", fn]]) + maybe (tell ["Missing date for " `T.append` fn]) (\x -> if dateParse x == UTCTime (fromGregorian 0 1 1) (secondsToDiffTime 0) && status `elem` ["Due", "open"] then tell [T.concat ["Bad date (", x, ") for active page ", fn]] else return ()) mdate + return () -- datecheck here + return () -- duplicate client name NOT here + ) >> return () + +dateParse :: Text -> UTCTime +dateParse x = fromMaybe (UTCTime (fromGregorian 0 1 1) (secondsToDiffTime 0)) $ parseTime defaultTimeLocale "%Y-%m-%d" (T.unpack x) + +dateConv :: Map.Map Text Text -> UTCTime +dateConv ymap = dateParse (fromMaybe "1900-01-01" (Map.lookup "Date" ymap)) + +main :: IO () +main = do + yamlcache <- decodeFile "/home/report/tmp/yamlcache.yaml" + let ymap = fromJust yamlcache -- fix that + ws = execWriter (mapM_ (vetPage . toPage) ymap) + TIO.putStr $ T.unlines ws diff --git a/sevendaysactivity.hs b/sevendaysactivity.hs new file mode 100644 index 0000000..63da735 --- /dev/null +++ b/sevendaysactivity.hs @@ -0,0 +1,42 @@ +import Data.List (null, nub, sort) +import Data.Time.Clock (getCurrentTime, addUTCTime) +import Data.Time.Clock.POSIX (posixDayLength) +import System.Environment (getArgs) + +import Data.FileStore (gitFileStore, history, TimeRange(TimeRange), Revision(Revision), Author(authorEmail), Change(Added,Deleted,Modified)) + +matchUsername :: String -> Revision -> Bool +matchUsername u (Revision _ _ author _ _) = u == localPart (authorEmail author) + where + localPart = takeWhile (/='@') + +extractFilename :: Change -> FilePath +extractFilename (Added f) = f +extractFilename (Deleted f) = f +extractFilename (Modified f) = f + +extractFilenames :: Revision -> [FilePath] +extractFilenames (Revision _ _ _ _ cs) = map extractFilename cs + +main :: IO () +main = do + args <- getArgs + let username = head args + currentTime <- getCurrentTime + let weekago = addUTCTime (-7 * posixDayLength) currentTime + let store = gitFileStore "." + + revs <- history store [] (TimeRange (Just weekago) Nothing) Nothing + let verrevs = if null args then revs else filter (matchUsername username) revs + let filestouched = sort . nub . concat $ map extractFilenames verrevs + + putStrLn "Summary" + putStrLn "=======" + putStrLn $ "Number of commits: " ++ (show (length verrevs)) + putStrLn $ "Files touched: " ++ (show (length filestouched)) + mapM_ (putStrLn . (" "++)) filestouched + + putStrLn "" + putStrLn "Details" + putStrLn "=======" + mapM_ (putStrLn . show) verrevs |