frdm-legacy reportingHEADmaster

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