diff options
| -rw-r--r-- | Logs/Presence.hs | 25 | ||||
| -rw-r--r-- | Logs/Transfer.hs | 1 | ||||
| -rw-r--r-- | test.hs | 13 |
3 files changed, 27 insertions, 12 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' @@ -38,6 +38,7 @@ import qualified Logs.Trust import qualified Logs.Remote import qualified Logs.Unused import qualified Logs.Transfer +import qualified Logs.Presence import qualified Remote import qualified Types.Key import qualified Types.Messages @@ -60,7 +61,7 @@ import System.Posix.Types instance Arbitrary Types.Key.Key where arbitrary = Types.Key.Key <$> arbitrary - <*> ((\b -> [b]) <$> elements ['A'..'Z']) -- BACKEND + <*> (listOf1 $ elements ['A'..'Z']) -- BACKEND <*> ((abs <$>) <$> arbitrary) -- size cannot be negative <*> arbitrary @@ -71,7 +72,8 @@ instance Arbitrary Logs.Transfer.TransferInfo where <*> pure Nothing -- cannot generate a ThreadID <*> pure Nothing -- remote not needed <*> arbitrary - <*> arbitrary + -- associated file cannot be empty (but can be Nothing) + <*> arbitrary `suchThat` (/= Just "") <*> arbitrary instance Arbitrary POSIXTime where @@ -95,6 +97,12 @@ instance Arbitrary FileID where instance Arbitrary FileOffset where arbitrary = abs <$> arbitrarySizedIntegral +instance Arbitrary Logs.Presence.LogLine where + arbitrary = Logs.Presence.LogLine + <$> arbitrary + <*> elements [minBound..maxBound] + <*> (arbitrary `suchThat` ('\n' `notElem`)) + main :: IO () main = do prepare @@ -128,6 +136,7 @@ quickcheck = TestLabel "quickcheck" $ TestList , qctest "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest , qctest "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo , qctest "prop_read_show_direct" Annex.Content.Direct.prop_read_show_direct + , qctest "prop_parse_show_log" Logs.Presence.prop_parse_show_log ] blackbox :: Test |