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'

13
test.hs
View file

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