{-# 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