summaryrefslogtreecommitdiff
path: root/sanitycheck.hs
blob: 8744f5c85ba0233681074a0f5be4e8776a84e6a2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
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