From 61307263c9ec3627df867836fc7e4db812c54621 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 19 Dec 2012 16:36:19 -0400
Subject: more quickcheck fun

---
 Annex/Content/Direct.hs |  7 ++++++-
 Command/Sync.hs         |  1 -
 test.hs                 | 35 ++++++++++++++++++++++++-----------
 3 files changed, 30 insertions(+), 13 deletions(-)

diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 64182ddc6..75a32e3fc 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -17,7 +17,8 @@ module Annex.Content.Direct (
 	removeCache,
 	genCache,
 	toCache,
-	Cache
+	Cache(..),
+	prop_read_show_direct
 ) where
 
 import Common.Annex
@@ -123,6 +124,10 @@ readCache s = case words s of
 		<*> readish mtime
 	_ -> Nothing
 
+-- for quickcheck
+prop_read_show_direct :: Cache -> Bool
+prop_read_show_direct c = readCache (showCache c) == Just c
+
 genCache :: FilePath -> IO (Maybe Cache)
 genCache f = catchDefaultIO Nothing $ toCache <$> getFileStatus f
 
diff --git a/Command/Sync.hs b/Command/Sync.hs
index d6736a616..e70524ee3 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -15,7 +15,6 @@ import qualified Annex
 import qualified Annex.Branch
 import qualified Annex.Queue
 import Annex.Content
-import Annex.Content.Direct
 import Annex.Direct
 import Annex.CatFile
 import qualified Git.Command
diff --git a/test.hs b/test.hs
index 44520b84b..b0bca8a92 100644
--- a/test.hs
+++ b/test.hs
@@ -51,21 +51,18 @@ import qualified Utility.Format
 import qualified Utility.Verifiable
 import qualified Utility.Process
 import qualified Utility.Misc
+import qualified Annex.Content.Direct
 
 import Data.Time.Clock.POSIX
 import System.Posix.Types
 
 -- instances for quickcheck
 instance Arbitrary Types.Key.Key where
-	arbitrary = do
-		n <- arbitrary
-		b <- elements ['A'..'Z']
-		return Types.Key.Key {
-			Types.Key.keyName = n,
-			Types.Key.keyBackendName = [b],
-			Types.Key.keySize = Nothing,
-			Types.Key.keyMtime = Nothing
-		}
+	arbitrary = Types.Key.Key
+		<$> arbitrary
+		<*> ((\b -> [b]) <$> elements ['A'..'Z']) -- BACKEND
+		<*> ((abs <$>) <$> arbitrary) -- size cannot be negative
+		<*> arbitrary
 
 instance Arbitrary Logs.Transfer.TransferInfo where
 	arbitrary = Logs.Transfer.TransferInfo
@@ -78,10 +75,25 @@ instance Arbitrary Logs.Transfer.TransferInfo where
 		<*> arbitrary
 
 instance Arbitrary POSIXTime where
-	arbitrary = arbitrarySizedIntegral
+	arbitrary = abs <$> arbitrarySizedIntegral
 
 instance Arbitrary ProcessID where
-	arbitrary = arbitraryBoundedIntegral
+	arbitrary = abs <$> arbitraryBoundedIntegral
+
+instance Arbitrary Annex.Content.Direct.Cache where
+	arbitrary = Annex.Content.Direct.Cache
+		<$> arbitrary
+		<*> arbitrary
+		<*> arbitrary
+
+instance Arbitrary EpochTime where
+	arbitrary = abs <$> arbitrarySizedIntegral
+
+instance Arbitrary FileID where
+	arbitrary = abs <$> arbitrarySizedIntegral
+
+instance Arbitrary FileOffset where
+	arbitrary = abs <$> arbitrarySizedIntegral
 
 main :: IO ()
 main = do
@@ -115,6 +127,7 @@ quickcheck = TestLabel "quickcheck" $ TestList
 	, qctest "prop_verifiable_sane" Utility.Verifiable.prop_verifiable_sane
 	, 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
 	]
 
 blackbox :: Test
-- 
cgit v1.2.3