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