1{- ORMOLU_DISABLE -} 2{-# LANGUAGE CPP #-} 3 4-- CPP: GHC >= 7.8 for overloaded lists, Safe Haskell 5#if __GLASGOW_HASKELL__ >= 708 6-- For the IsList test 7{-# LANGUAGE OverloadedLists #-} 8{-# LANGUAGE Safe #-} 9#endif 10 11-- CPP: GHC == 7.8 for using pattern synonyms 12#if __GLASGOW_HASKELL__ == 708 13{-# LANGUAGE PatternSynonyms #-} 14#endif 15{- ORMOLU_ENABLE -} 16 17#if __GLASGOW_HASKELL__ >= 708 18#endif 19 20-------------------------------------------------------------------------------- 21 22-- | QuickCheck property tests for DList. 23module DListProperties (test) where 24 25-------------------------------------------------------------------------------- 26 27import qualified Control.Applicative as Applicative 28import Data.DList 29import qualified Data.List as List 30-- CPP: GHC >= 8 for NonEmpty, Semigroup 31#if __GLASGOW_HASKELL__ >= 800 32import Data.List.NonEmpty (NonEmpty) 33import qualified Data.Semigroup as Semigroup 34#endif 35import qualified Data.Traversable as Traversable 36import QuickCheckUtil 37import Test.QuickCheck 38import Text.Show.Functions () 39import Prelude hiding (concat, foldr, head, map, replicate, tail) 40 41-------------------------------------------------------------------------------- 42 43prop_model :: [Int] -> Bool 44prop_model = eqWith id (toList . fromList) 45 46prop_empty :: Bool 47prop_empty = ([] :: [Int]) == (toList empty :: [Int]) 48 49prop_singleton :: Int -> Bool 50prop_singleton = eqWith Applicative.pure (toList . singleton) 51 52prop_cons :: Int -> [Int] -> Bool 53prop_cons c = eqWith (c :) (toList . cons c . fromList) 54 55prop_snoc :: [Int] -> Int -> Bool 56prop_snoc xs c = xs ++ [c] == toList (snoc (fromList xs) c) 57 58prop_append :: [Int] -> [Int] -> Bool 59prop_append xs ys = xs ++ ys == toList (fromList xs `append` fromList ys) 60 61prop_concat :: [[Int]] -> Bool 62prop_concat = eqWith List.concat (toList . concat . List.map fromList) 63 64-- The condition reduces the size of replications and thus the eval time. 65prop_replicate :: Int -> Int -> Property 66prop_replicate n = 67 eqOn (const (n < 100)) (List.replicate n) (toList . replicate n) 68 69prop_head :: [Int] -> Property 70prop_head = eqOn (not . null) List.head (head . fromList) 71 72prop_tail :: [Int] -> Property 73prop_tail = eqOn (not . null) List.tail (tail . fromList) 74 75prop_unfoldr :: (Int -> Maybe (Int, Int)) -> Int -> Int -> Property 76prop_unfoldr f n = 77 eqOn (const (n >= 0)) (take n . List.unfoldr f) (take n . toList . unfoldr f) 78 79prop_foldr :: (Int -> Int -> Int) -> Int -> [Int] -> Bool 80prop_foldr f x = eqWith (List.foldr f x) (foldr f x . fromList) 81 82prop_map :: (Int -> Int) -> [Int] -> Bool 83prop_map f = eqWith (List.map f) (toList . map f . fromList) 84 85prop_map_fusion :: (Int -> Int) -> (a -> Int) -> [a] -> Bool 86prop_map_fusion f g = 87 eqWith (List.map f . List.map g) (toList . map f . map g . fromList) 88 89prop_intercalate :: [Int] -> [[Int]] -> Bool 90prop_intercalate sep = 91 eqWith (List.intercalate sep) (toList . intercalate (fromList sep) . List.map fromList) 92 93prop_show_read :: [Int] -> Bool 94prop_show_read = eqWith id (read . show) 95 96prop_read_show :: [Int] -> Bool 97prop_read_show x = eqWith id (show . f . read) $ "fromList " ++ show x 98 where 99 f :: DList Int -> DList Int 100 f = id 101 102prop_fail :: String -> Bool 103prop_fail str = fail str == (empty :: DList ()) 104 105prop_Traversable_traverse :: [Int] -> Bool 106prop_Traversable_traverse xs = 107 (==) 108 (Traversable.traverse Applicative.pure xs :: [[Int]]) 109 (fmap toList (Traversable.traverse Applicative.pure (fromList xs))) 110 111-- CPP: GHC >= 7.8 for overloaded lists 112#if __GLASGOW_HASKELL__ >= 708 113 114-- | Test that the IsList instance methods compile and work with simple lists 115prop_IsList :: Bool 116prop_IsList = test_fromList [1, 2, 3] && test_toList (fromList [1, 2, 3]) 117 where 118 test_fromList, test_toList :: DList Int -> Bool 119 test_fromList x = x == fromList [1, 2, 3] 120 test_toList [1, 2, 3] = True 121 test_toList _ = False 122 123-- | Test the pattern synonyms 124prop_patterns :: [Int] -> Bool 125prop_patterns xs = case fromList xs of 126 Nil -> xs == [] 127 Cons y ys -> xs == (y : ys) 128 _ -> False 129 130#endif 131 132-- CPP: GHC >= 8 for NonEmpty, Semigroup 133#if __GLASGOW_HASKELL__ >= 800 134 135prop_Semigroup_append :: [Int] -> [Int] -> Bool 136prop_Semigroup_append xs ys = 137 xs Semigroup.<> ys == toList (fromList xs Semigroup.<> fromList ys) 138 139prop_Semigroup_sconcat :: NonEmpty [Int] -> Bool 140prop_Semigroup_sconcat xs = 141 Semigroup.sconcat xs == toList (Semigroup.sconcat (fmap fromList xs)) 142 143prop_Semigroup_stimes :: Int -> [Int] -> Bool 144prop_Semigroup_stimes n xs = 145 n < 0 || Semigroup.stimes n xs == toList (Semigroup.stimes n (fromList xs)) 146 147#endif 148 149-------------------------------------------------------------------------------- 150 151properties :: [(String, Property)] 152properties = 153 [ ("model", property prop_model), 154 ("empty", property prop_empty), 155 ("singleton", property prop_singleton), 156 ("cons", property prop_cons), 157 ("snoc", property prop_snoc), 158 ("append", property prop_append), 159 ("concat", property prop_concat), 160 ("replicate", property prop_replicate), 161 ("head", property prop_head), 162 ("tail", property prop_tail), 163 ("fail", property prop_fail), 164 ("unfoldr", property prop_unfoldr), 165 ("foldr", property prop_foldr), 166 ("map", property prop_map), 167 ("map fusion", property (prop_map_fusion (+ 1) (+ 1))), 168 ("intercalate", property prop_intercalate), 169 ("read . show", property prop_show_read), 170 ("show . read", property prop_read_show), 171 ("Traversable traverse", property prop_Traversable_traverse) 172-- CPP: GHC >= 7.8 for IsList, pattern synonyms 173#if __GLASGOW_HASKELL__ >= 708 174 , 175 ("IsList", property prop_IsList), 176 ("patterns", property prop_patterns) 177#endif 178-- CPP: GHC >= 8 for NonEmpty, Semigroup 179#if __GLASGOW_HASKELL__ >= 800 180 , 181 ("Semigroup <>", property prop_Semigroup_append), 182 ("Semigroup sconcat", property prop_Semigroup_sconcat), 183 ("Semigroup stimes", property prop_Semigroup_stimes) 184#endif 185 ] 186 187test :: IO () 188test = quickCheckLabeledProperties properties 189