summaryrefslogtreecommitdiff
path: root/Logs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-02-27 21:42:07 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-02-27 21:42:07 -0400
commitca59b87b11c01c417a7b3b8f0cf15426e6fadcfb (patch)
tree36c342a8ae999986aabf51d6a3371515e9ac1dfd /Logs
parentf54b34a6e6cb000d3117106fd19c13ef9dc7f38f (diff)
move Arbitrary instances out of Test and into modules that define the types
This is possible now that we build-depend on QuickCheck.
Diffstat (limited to 'Logs')
-rw-r--r--Logs/Presence.hs16
-rw-r--r--Logs/Transfer.hs31
2 files changed, 34 insertions, 13 deletions
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index 49573df69..83cbe0684 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -29,6 +29,8 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as M
+import Test.QuickCheck
+import Utility.QuickCheck ()
import Common.Annex
import qualified Annex.Branch
@@ -74,10 +76,6 @@ 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
@@ -113,3 +111,13 @@ mapLog l m
better = maybe True newer $ M.lookup i m
newer l' = date l' <= date l
i = info l
+
+instance Arbitrary LogLine where
+ arbitrary = LogLine
+ <$> arbitrary
+ <*> elements [minBound..maxBound]
+ <*> arbitrary `suchThat` ('\n' `notElem`)
+
+prop_parse_show_log :: [LogLine] -> Bool
+prop_parse_show_log l = parseLog (showLog l) == l
+
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index e92dce2c0..018e1d4ff 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -21,6 +21,8 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import Control.Concurrent
+import Test.QuickCheck
+import Utility.QuickCheck ()
{- Enough information to uniquely identify a transfer, used as the filename
- of the transfer information file. -}
@@ -306,15 +308,6 @@ readTransferInfo mpid s = TransferInfo
then Just <$> readish =<< headMaybe (drop 1 bits)
else pure Nothing -- not failure
-{- for quickcheck -}
-prop_read_write_transferinfo :: TransferInfo -> Bool
-prop_read_write_transferinfo info
- | transferRemote info /= Nothing = True -- remote not stored
- | transferTid info /= Nothing = True -- tid not stored
- | otherwise = Just (info { transferPaused = False }) == info'
- where
- info' = readTransferInfo (transferPid info) (writeTransferInfo info)
-
parsePOSIXTime :: String -> Maybe POSIXTime
parsePOSIXTime s = utcTimeToPOSIXSeconds
<$> parseTime defaultTimeLocale "%s%Qs" s
@@ -330,3 +323,23 @@ failedTransferDir u direction r = gitAnnexTransferDir r
</> "failed"
</> showLcDirection direction
</> filter (/= '/') (fromUUID u)
+
+instance Arbitrary TransferInfo where
+ arbitrary = TransferInfo
+ <$> arbitrary
+ <*> arbitrary
+ <*> pure Nothing -- cannot generate a ThreadID
+ <*> pure Nothing -- remote not needed
+ <*> arbitrary
+ -- associated file cannot be empty (but can be Nothing)
+ <*> arbitrary `suchThat` (/= Just "")
+ <*> arbitrary
+
+prop_read_write_transferinfo :: TransferInfo -> Bool
+prop_read_write_transferinfo info
+ | transferRemote info /= Nothing = True -- remote not stored
+ | transferTid info /= Nothing = True -- tid not stored
+ | otherwise = Just (info { transferPaused = False }) == info'
+ where
+ info' = readTransferInfo (transferPid info) (writeTransferInfo info)
+