QuickCheck: migrate properties from Bool to Property and (===)

test/Codec/Archive/Tar/Index/IntTrie/Tests.hs

@@ -125,7 +125,7 @@ example2''' = mktrie [ mknode 0 t3 ]
 
 -- We convert from the 'Paths' to the 'IntTrieBuilder' using 'inserts':
 --
-test1 = example2 == inserts example1 empty
+test1 = example2 === inserts example1 empty
 
 -- So the overall array form of the above trie is:
 --
@@ -145,7 +145,7 @@ example3 =
 
 -- We get the array form by using flattenTrie:
 
-test2 = example3 == flattenTrie example2
+test2 = example3 === flattenTrie example2
 
 example4 :: IntTrie Int Int
 example4 = IntTrie (mkArray example3)
@@ -157,25 +157,24 @@ test3 = case lookup example4 [1] of
           Just (Completions [(2,_),(3,_),(4,_)]) -> True
           _                          -> False
 
-test1, test2, test3 :: Bool
+test1 :: Property
 
 prop_lookup :: (Ord k, Enum k, Eq v, Enum v, Show k, Show v)
-            => [([k], v)] -> Bool
+            => [([k], v)] -> Property
 prop_lookup paths =
-  flip all paths $ \(key, value) ->
+  conjoin $ flip map paths $ \(key, value) ->
     case lookup trie key of
-      Just (Entry value') | value' == value -> True
-      Just (Entry value')   -> error $ "IntTrie: " ++ show (key, value, value')
+      Just (Entry value')   -> value' === value
       Nothing               -> error $ "IntTrie: didn't find " ++ show key
       Just (Completions xs) -> error $ "IntTrie: " ++ show xs
 
   where
     trie = construct paths
 
-prop_completions :: forall k v. (Ord k, Enum k, Eq v, Enum v) => [([k], v)] -> Bool
+prop_completions :: forall k v. (Ord k, Enum k, Eq v, Enum v) => [([k], v)] -> Property
 prop_completions paths =
     inserts paths empty
- == convertCompletions (completionsFrom (construct paths) 0)
+ === convertCompletions (completionsFrom (construct paths) 0)
   where
     convertCompletions :: Ord k => Completions k v -> IntTrieBuilder k v
     convertCompletions kls =
@@ -187,37 +186,37 @@ prop_completions paths =
           | (k, l) <- sortBy (compare `on` fst) kls ]
 
 
-prop_lookup_mono :: ValidPaths -> Bool
+prop_lookup_mono :: ValidPaths -> Property
 prop_lookup_mono (ValidPaths paths) = prop_lookup paths
 
-prop_completions_mono :: ValidPaths -> Bool
+prop_completions_mono :: ValidPaths -> Property
 prop_completions_mono (ValidPaths paths) = prop_completions paths
 
-prop_construct_toList :: ValidPaths -> Bool
+prop_construct_toList :: ValidPaths -> Property
 prop_construct_toList (ValidPaths paths) =
        sortBy (compare `on` fst) (toList (construct paths))
-    == sortBy (compare `on` fst) paths
+    === sortBy (compare `on` fst) paths
 
-prop_finalise_unfinalise :: ValidPaths -> Bool
+prop_finalise_unfinalise :: ValidPaths -> Property
 prop_finalise_unfinalise (ValidPaths paths) =
-    builder == unfinalise (finalise builder)
+    builder === unfinalise (finalise builder)
   where
     builder :: IntTrieBuilder Char Char
     builder = inserts paths empty
 
-prop_serialise_deserialise :: ValidPaths -> Bool
+prop_serialise_deserialise :: ValidPaths -> Property
 prop_serialise_deserialise (ValidPaths paths) =
-    Just (trie, BS.empty) == (deserialise
+    Just (trie, BS.empty) === (deserialise
                             . LBS.toStrict . BS.toLazyByteString
                             . serialise) trie
   where
     trie :: IntTrie Char Char
     trie = construct paths
 
-prop_serialiseSize :: ValidPaths -> Bool
+prop_serialiseSize :: ValidPaths -> Property
 prop_serialiseSize (ValidPaths paths) =
     (fromIntegral . LBS.length . BS.toLazyByteString . serialise) trie
- == serialiseSize trie
+ === serialiseSize trie
   where
     trie :: IntTrie Char Char
     trie = construct paths

test/Codec/Archive/Tar/Index/StringTable/Tests.hs

@@ -10,6 +10,7 @@ module Codec.Archive.Tar.Index.StringTable.Tests (
 
 import Prelude hiding (lookup)
 import Codec.Archive.Tar.Index.StringTable
+import Test.Tasty.QuickCheck
 
 import Data.List hiding (lookup, insert)
 import qualified Data.Array.Unboxed as A
@@ -23,51 +24,53 @@ import Data.ByteString.Lazy.Builder     as BS
 import Data.ByteString.Lazy.Builder.Extras as BS (byteStringCopy)
 #endif
 
-prop_valid :: [BS.ByteString] -> Bool
+prop_valid :: [BS.ByteString] -> Property
 prop_valid strs =
-     all lookupIndex (enumStrings tbl)
-  && all indexLookup (enumIds tbl)
+       conjoin (map lookupIndex (enumStrings tbl))
+  .&&. conjoin (map indexLookup (enumIds tbl))
 
   where
     tbl :: StringTable Int
     tbl = construct strs
 
-    lookupIndex str = index tbl ident == str
+    lookupIndex :: BS.ByteString -> Property
+    lookupIndex str = index tbl ident === str
       where Just ident = lookup tbl str
 
-    indexLookup ident = lookup tbl str == Just ident
+    indexLookup :: Int -> Property
+    indexLookup ident = lookup tbl str === Just ident
       where str       = index tbl ident
 
 -- this is important so we can use Map.fromAscList
-prop_sorted :: [BS.ByteString] -> Bool
-prop_sorted strings =
+prop_sorted :: [BS.ByteString] -> Property
+prop_sorted strings = property $
     isSorted [ index' strs offsets ix
              | ix <- A.range (A.bounds ids) ]
   where
     _tbl :: StringTable Int
     _tbl@(StringTable strs offsets ids _ixs) = construct strings
     isSorted xs = and (zipWith (<) xs (tail xs))
 
-prop_finalise_unfinalise :: [BS.ByteString] -> Bool
+prop_finalise_unfinalise :: [BS.ByteString] -> Property
 prop_finalise_unfinalise strs =
-    builder == unfinalise (finalise builder)
+    builder === unfinalise (finalise builder)
   where
     builder :: StringTableBuilder Int
     builder = foldl' (\tbl s -> fst (insert s tbl)) empty strs
 
-prop_serialise_deserialise :: [BS.ByteString] -> Bool
+prop_serialise_deserialise :: [BS.ByteString] -> Property
 prop_serialise_deserialise strs =
-    Just (strtable, BS.empty) == (deserialiseV2
+    Just (strtable, BS.empty) === (deserialiseV2
                                 . LBS.toStrict . BS.toLazyByteString
                                 . serialise) strtable
   where
     strtable :: StringTable Int
     strtable = construct strs
 
-prop_serialiseSize :: [BS.ByteString] -> Bool
+prop_serialiseSize :: [BS.ByteString] -> Property
 prop_serialiseSize strs =
     (fromIntegral . LBS.length . BS.toLazyByteString . serialise) strtable
- == serialiseSize strtable
+ === serialiseSize strtable
   where
     strtable :: StringTable Int
     strtable = construct strs

test/Codec/Archive/Tar/Index/Tests.hs

@@ -58,34 +58,33 @@ import qualified Data.ByteString.Handle as HBS
 -- Not quite the properties of a finite mapping because we also have lookups
 -- that result in completions.
 
-prop_lookup :: ValidPaths -> NonEmptyFilePath -> Bool
+prop_lookup :: ValidPaths -> NonEmptyFilePath -> Property
 prop_lookup (ValidPaths paths) (NonEmptyFilePath p) =
   case (lookup index p, Prelude.lookup p paths) of
-    (Nothing,                    Nothing)          -> True
-    (Just (TarFileEntry offset), Just (_,offset')) -> offset == offset'
+    (Nothing,                    Nothing)          -> property True
+    (Just (TarFileEntry offset), Just (_,offset')) -> offset === offset'
     (Just (TarDir entries),      Nothing)          -> sort (nub (map fst entries))
-                                                   == sort (nub completions)
-    _                                              -> False
+                                                   === sort (nub completions)
+    _                                              -> property False
   where
     index       = construct paths
     completions = [ head (FilePath.splitDirectories completion)
                   | (path,_) <- paths
                   , completion <- maybeToList $ stripPrefix (p ++ "/") path ]
 
-prop_toList :: ValidPaths -> Bool
+prop_toList :: ValidPaths -> Property
 prop_toList (ValidPaths paths) =
     sort (toList index)
- == sort [ (path, off) | (path, (_sz, off)) <- paths ]
+ === sort [ (path, off) | (path, (_sz, off)) <- paths ]
   where
     index = construct paths
 
-prop_valid :: ValidPaths -> Bool
-prop_valid (ValidPaths paths)
-  | not $ StringTable.prop_valid   pathbits = error "TarIndex: bad string table"
-  | not $ IntTrie.prop_lookup      intpaths = error "TarIndex: bad int trie"
-  | not $ IntTrie.prop_completions intpaths = error "TarIndex: bad int trie"
-  | not $ prop'                             = error "TarIndex: bad prop"
-  | otherwise                               = True
+prop_valid :: ValidPaths -> Property
+prop_valid (ValidPaths paths) =
+  StringTable.prop_valid   pathbits .&&.
+  IntTrie.prop_lookup      intpaths .&&.
+  IntTrie.prop_completions intpaths .&&.
+  prop'
 
   where
     index@(TarIndex pathTable _ _) = construct paths
@@ -95,22 +94,22 @@ prop_valid (ValidPaths paths)
     intpaths = [ (cids, offset)
                | (path, (_size, offset)) <- paths
                , let Just cids = toComponentIds pathTable path ]
-    prop' = flip all paths $ \(file, (_size, offset)) ->
+    prop' = conjoin $ flip map paths $ \(file, (_size, offset)) ->
       case lookup index file of
-        Just (TarFileEntry offset') -> offset' == offset
-        _                           -> False
+        Just (TarFileEntry offset') -> offset' === offset
+        _                           -> property False
 
-prop_serialise_deserialise :: ValidPaths -> Bool
+prop_serialise_deserialise :: ValidPaths -> Property
 prop_serialise_deserialise (ValidPaths paths) =
-    Just (index, BS.empty) == (deserialise . serialise) index
+    Just (index, BS.empty) === (deserialise . serialise) index
   where
     index = construct paths
 
-prop_serialiseSize :: ValidPaths -> Bool
+prop_serialiseSize :: ValidPaths -> Property
 prop_serialiseSize (ValidPaths paths) =
     case (LBS.toChunks . serialiseLBS) index of
-      [c1] -> BS.length c1 == serialiseSize index
-      _    -> False
+      [c1] -> BS.length c1 === serialiseSize index
+      _    -> property False
   where
     index = construct paths
 
@@ -145,7 +144,7 @@ instance Arbitrary ValidPaths where
 -- Helper for bulk construction.
 construct :: [(FilePath, (Int64, TarEntryOffset))] -> TarIndex
 construct =
-    either (\_ -> undefined) id
+    either (const undefined) id
   . build
   . foldr (\(path, (size, _off)) es -> Next (testEntry path size) es) Done
 
@@ -261,9 +260,9 @@ instance Arbitrary SimpleIndexBuilder where
           go !builder  Done       = builder
           go !_       (Fail err)  = error (show err)
 
-prop_finalise_unfinalise :: SimpleIndexBuilder -> Bool
+prop_finalise_unfinalise :: SimpleIndexBuilder -> Property
 prop_finalise_unfinalise (SimpleIndexBuilder index) =
-    unfinalise (finalise index) == index
+    unfinalise (finalise index) === index
 
 #if !(MIN_VERSION_base(4,5,0))
 (<>) :: Monoid m => m -> m -> m

test/Codec/Archive/Tar/Tests.hs

@@ -21,22 +21,23 @@ import Codec.Archive.Tar
 import Codec.Archive.Tar.Types
 import Codec.Archive.Tar.Types.Tests
 import Prelude hiding (read)
+import Test.Tasty.QuickCheck
 
-prop_write_read_ustar :: [Entry] -> Bool
+prop_write_read_ustar :: [Entry] -> Property
 prop_write_read_ustar entries =
-    foldr Next Done entries' == read (write entries')
+    foldr Next Done entries' === read (write entries')
   where
     entries' = [ e { entryFormat = UstarFormat } | e <- entries ]
 
-prop_write_read_gnu :: [Entry] -> Bool
+prop_write_read_gnu :: [Entry] -> Property
 prop_write_read_gnu entries =
-    foldr Next Done entries' == read (write entries')
+    foldr Next Done entries' === read (write entries')
   where
     entries' = [ e { entryFormat = GnuFormat } | e <- entries ]
 
-prop_write_read_v7 :: [Entry] -> Bool
+prop_write_read_v7 :: [Entry] -> Property
 prop_write_read_v7 entries =
-    foldr Next Done entries' == read (write entries')
+    foldr Next Done entries' === read (write entries')
   where
     entries' = [ limitToV7FormatCompat e { entryFormat = V7Format }
                | e <- entries ]