more quickcheck fun

and the code gets better..
This commit is contained in:
Joey Hess 2012-12-19 22:14:12 -04:00
parent 295c2552ea
commit 8491917d04
3 changed files with 27 additions and 12 deletions

View file

@ -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

View file

@ -309,7 +309,6 @@ readTransferInfo mpid s = TransferInfo
{- for quickcheck -}
prop_read_write_transferinfo :: TransferInfo -> Bool
prop_read_write_transferinfo info
| associatedFile info == Just "" = True -- file cannot be empty
| transferRemote info /= Nothing = True -- remote not stored
| transferTid info /= Nothing = True -- tid not stored
| otherwise = Just (info { transferPaused = False }) == info'