diff options
author | Joey Hess <joey@kitenet.net> | 2013-02-27 21:42:07 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-02-27 21:42:07 -0400 |
commit | ca59b87b11c01c417a7b3b8f0cf15426e6fadcfb (patch) | |
tree | 36c342a8ae999986aabf51d6a3371515e9ac1dfd /Logs | |
parent | f54b34a6e6cb000d3117106fd19c13ef9dc7f38f (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.hs | 16 | ||||
-rw-r--r-- | Logs/Transfer.hs | 31 |
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) + |