summaryrefslogtreecommitdiff
path: root/sanitycheck.hs
diff options
context:
space:
mode:
Diffstat (limited to 'sanitycheck.hs')
-rw-r--r--sanitycheck.hs85
1 files changed, 85 insertions, 0 deletions
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