more quickcheck fun
and the code gets better..
This commit is contained in:
parent
295c2552ea
commit
8491917d04
3 changed files with 27 additions and 12 deletions
|
@ -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
|
||||
|
|
|
@ -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
13
test.hs
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue