diff options
author | Joey Hess <joey@kitenet.net> | 2012-12-19 22:14:12 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-12-19 22:14:12 -0400 |
commit | e12b224621c873b2d7fdaad1242e437b2b07cf30 (patch) | |
tree | ca7fd71ed7d7448f2751b0b7deb10f1f0c5f973a /Logs/Presence.hs | |
parent | 77993297167b7045632f005495f7f618557ce142 (diff) |
more quickcheck fun
and the code gets better..
Diffstat (limited to 'Logs/Presence.hs')
-rw-r--r-- | Logs/Presence.hs | 25 |
1 files changed, 16 insertions, 9 deletions
diff --git a/Logs/Presence.hs b/Logs/Presence.hs index ce5dd5780..49573df69 100644 --- a/Logs/Presence.hs +++ b/Logs/Presence.hs @@ -13,7 +13,7 @@ module Logs.Presence ( LogStatus(..), - LogLine, + LogLine(LogLine), addLog, readLog, getLog, @@ -22,6 +22,7 @@ module Logs.Presence ( logNow, compactLog, currentLog, + prop_parse_show_log, ) where import Data.Time.Clock.POSIX @@ -36,10 +37,10 @@ data LogLine = LogLine { date :: POSIXTime, status :: LogStatus, info :: String -} deriving (Eq) +} deriving (Eq, Show) data LogStatus = InfoPresent | InfoMissing - deriving (Eq) + deriving (Eq, Show, Bounded, Enum) addLog :: FilePath -> LogLine -> Annex () addLog file line = Annex.Branch.change file $ \s -> @@ -52,13 +53,15 @@ readLog = parseLog <$$> Annex.Branch.get {- Parses a log file. Unparseable lines are ignored. -} parseLog :: String -> [LogLine] -parseLog = mapMaybe (parseline . words) . lines +parseLog = mapMaybe parseline . lines where - parseline (a:b:c:_) = do - d <- parseTime defaultTimeLocale "%s%Qs" a - s <- parsestatus b - Just $ LogLine (utcTimeToPOSIXSeconds d) s c - parseline _ = Nothing + parseline l = LogLine + <$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d) + <*> parsestatus s + <*> pure rest + where + (d, pastd) = separate (== ' ') l + (s, rest) = separate (== ' ') pastd parsestatus "1" = Just InfoPresent parsestatus "0" = Just InfoMissing parsestatus _ = Nothing @@ -71,6 +74,10 @@ showLog = unlines . map genline genstatus InfoPresent = "1" genstatus InfoMissing = "0" +-- for quickcheck +prop_parse_show_log :: [LogLine] -> Bool +prop_parse_show_log l = parseLog (showLog l) == l + {- Generates a new LogLine with the current date. -} logNow :: LogStatus -> String -> Annex LogLine logNow s i = do |