more quickcheck fun

and the code gets better..

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'
diff --git a/test.hs b/test.hs
index b0bca8a92..efd264cc8 100644
--- a/test.hs
+++ b/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