{-# LANGUAGE ScopedTypeVariables #-}
module Main (main) where
import Data.Complex (Complex)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List.NonEmpty (NonEmpty)
import Data.Proxy (Proxy (..))
import Data.Typeable (Typeable, typeRep)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Test.QuickCheck (Arbitrary (..), Property, counterexample, label, (===),
sized, chooseInt, vectorOf)
import Test.QuickCheck.Instances ()
import Test.Tasty (defaultMain, testGroup, TestTree)
import Test.Tasty.QuickCheck (testProperty)
import qualified Data.List as L
import Data.Discrimination
import Utils
main :: IO ()
main = defaultMain $ testGroup "discrimination"
[ testGroup "examples"
[ testGroup "nub"
[ testProperty "List.nub" $
let prop :: [Word64] -> Property
prop xs = L.nub xs === nub xs
in prop
, testProperty "ordNub" $
let prop :: [Word64] -> Property
prop xs = ordNub xs === nub xs
in prop
, testProperty "hashNub" $
let prop :: [Word64] -> Property
prop xs = hashNub xs === nub xs
in prop
]
, testGroup "sort"
[ testProperty "List.sort" $
let prop :: [Word64] -> Property
prop xs = L.sort xs === sort xs
in prop
, testProperty "introsort" $
-- for Word64 unstable sort works too
let prop :: [Word64] -> Property
prop xs = introsort xs === sort xs
in prop
, testProperty "mergesort" $
let prop :: [Word64] -> Property
prop xs = mergesort xs === sort xs
in prop
]
]
, testGroup "Grouping"
[ testGrouping (Proxy :: Proxy ())
, testGrouping (Proxy :: Proxy Int)
, testGrouping (Proxy :: Proxy Int8)
, testGrouping (Proxy :: Proxy Int16)
, testGrouping (Proxy :: Proxy Int32)
, testGrouping (Proxy :: Proxy Int64)
, testGrouping (Proxy :: Proxy Word)
, testGrouping (Proxy :: Proxy Word8)
, testGrouping (Proxy :: Proxy Word16)
, testGrouping (Proxy :: Proxy Word32)
, testGrouping (Proxy :: Proxy Word64)
, testGrouping (Proxy :: Proxy Bool)
, testGrouping (Proxy :: Proxy Ordering)
, testGrouping (Proxy :: Proxy (Word8,Word8))
, testGrouping (Proxy :: Proxy (Word8,Word8,Word8))
, testGrouping (Proxy :: Proxy (Word8,Word8,Word8,Word8))
, testGrouping (Proxy :: Proxy Rational)
, testGrouping (Proxy :: Proxy (Complex Word8))
, testGrouping (Proxy :: Proxy (Maybe Word8))
, testGrouping (Proxy :: Proxy (Either Word8 Word8))
, testGrouping (Proxy :: Proxy Char)
, testGrouping (Proxy :: Proxy String)
, testGrouping (Proxy :: Proxy (NonEmpty Int))
, testGrouping (Proxy :: Proxy Natural)
, testGrouping (Proxy :: Proxy Integer)
, testGrouping' listToNatural
, testGrouping' listToInteger
]
, testGroup "Sorting"
[ testSorting (Proxy :: Proxy ())
, testSorting (Proxy :: Proxy Int)
, testSorting (Proxy :: Proxy Int8)
, testSorting (Proxy :: Proxy Int16)
, testSorting (Proxy :: Proxy Int32)
, testSorting (Proxy :: Proxy Int64)
, testSorting (Proxy :: Proxy Word)
, testSorting (Proxy :: Proxy Word8)
, testSorting (Proxy :: Proxy Word16)
, testSorting (Proxy :: Proxy Word32)
, testSorting (Proxy :: Proxy Word64)
, testSorting (Proxy :: Proxy Bool)
, testSorting (Proxy :: Proxy Ordering)
, testSorting (Proxy :: Proxy (Word8,Word8))
, testSorting (Proxy :: Proxy (Word8,Word8,Word8))
, testSorting (Proxy :: Proxy (Word8,Word8,Word8,Word8))
, testSorting (Proxy :: Proxy (Maybe Word8))
, testSorting (Proxy :: Proxy (Either Word8 Word8))
, testSorting (Proxy :: Proxy Char)
, testSorting (Proxy :: Proxy String)
, testSorting (Proxy :: Proxy (NonEmpty Int))
, testSorting (Proxy :: Proxy Natural)
, testSorting (Proxy :: Proxy Integer)
, testSorting' listToNatural
, testSorting' listToInteger
]
]
listToNatural :: SmallList Word64 -> Natural
listToNatural = L.foldl' (\x y -> x * 2 ^ (64 :: Int) + fromIntegral y) 0 . getSmallList
listToInteger :: SmallList Int64 -> Integer
listToInteger = L.foldl' (\x y -> x * 2 ^ (64 :: Int) + fromIntegral y) 0 . getSmallList
newtype SmallList a = SmallList { getSmallList :: [a] } deriving (Eq, Show)
instance Arbitrary a => Arbitrary (SmallList a) where
arbitrary = sized $ \n -> do
m <- chooseInt (0, min 10 n)
SmallList <$> vectorOf m arbitrary
shrink = fmap SmallList . shrink . getSmallList
testGrouping
:: forall a. (Grouping a, Typeable a, Arbitrary a, Eq a, Show a)
=> Proxy a
-> TestTree
testGrouping _ = testGrouping' (id :: a -> a)
testGrouping'
:: forall a b. (Grouping b, Typeable a, Typeable b, Arbitrary a, Eq b, Show a, Show b)
=> (a -> b)
-> TestTree
testGrouping' f = testGroup name
[ testProperty "groupingEq" prop_eq
, testProperty "nub" prop_nub
]
where
tra = typeRep (Proxy :: Proxy a)
trb = typeRep (Proxy :: Proxy b)
name = if tra == trb then show tra else show trb ++ " from " ++ show tra
prop_eq :: a -> a -> Property
prop_eq x' y' =
counterexample (show (x,y)) $
label (show lhs) $
lhs === groupingEq x y
where
x = f x'
y = f y'
lhs = x == y
prop_nub :: [a] -> Property
prop_nub xs' = L.nub xs === nub xs
where
xs = take 100 (map f xs')
testSorting
:: forall a. (Sorting a, Typeable a, Arbitrary a, Ord a, Show a)
=> Proxy a
-> TestTree
testSorting _ = testSorting' (id :: a -> a)
testSorting'
:: forall a b. (Sorting b, Typeable a, Typeable b, Arbitrary a, Ord b, Show a, Show b)
=> (a -> b)
-> TestTree
testSorting' f = testGroup name
[ testProperty "sortingCompare" prop_cmp
, testProperty "sort" prop_sort
]
where
tra = typeRep (Proxy :: Proxy a)
trb = typeRep (Proxy :: Proxy b)
name = if tra == trb then show tra else show trb ++ " from " ++ show tra
prop_cmp :: a -> a -> Property
prop_cmp x' y' =
counterexample (show (x,y)) $
label (show lhs) $
lhs === sortingCompare x y
where
x = f x'
y = f y'
lhs = compare x y
prop_sort :: [a] -> Property
prop_sort xs' = L.sort xs === sort xs
where
xs = map f xs'