summaryrefslogtreecommitdiff
path: root/Logs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-12-19 22:14:12 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-12-19 22:14:12 -0400
commite12b224621c873b2d7fdaad1242e437b2b07cf30 (patch)
treeca7fd71ed7d7448f2751b0b7deb10f1f0c5f973a /Logs
parent77993297167b7045632f005495f7f618557ce142 (diff)
more quickcheck fun
and the code gets better..
Diffstat (limited to 'Logs')
-rw-r--r--Logs/Presence.hs25
-rw-r--r--Logs/Transfer.hs1
2 files changed, 16 insertions, 10 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
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index fa85846bb..e92dce2c0 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -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'