git.iko.soy/typerep-map
on cbcbb07 help sign in
typerep-map/test/Test/TypeRep/MapProperty.hs
69 lines 2.3 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE KindSignatures #-}
3{-# LANGUAGE PolyKinds #-}
5{-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-}
7module Test.TypeRep.MapProperty where
9import Prelude hiding (lookup)
11import Data.Proxy (Proxy (..))
12import GHC.Stack (HasCallStack)
13import GHC.TypeLits (Nat, SomeNat (..), someNatVal)
14import Hedgehog (MonadGen, PropertyT, forAll, property, (===))
15import Test.Tasty (TestName, TestTree)
16import Test.Tasty.Hedgehog (testProperty)
18import Data.TypeRep.CacheMap (TF (..), TypeRepMap, delete, fromList, insert, lookup, member)
20import qualified Hedgehog.Gen as Gen
21import qualified Hedgehog.Range as Range
23type PropertyTest = [TestTree]
25prop :: HasCallStack => TestName -> PropertyT IO () -> PropertyTest
26prop testName = pure . testProperty testName . property
28test_InsertLookup :: PropertyTest
29test_InsertLookup = prop "lookup k (insert k v m) == Just v" $ do
30 m <- forAll genMap
31 TF (proxy :: IntProxy n) <- forAll genTF
33 lookup @n @IntProxy (insert proxy m) === Just proxy
35test_InsertInsert :: PropertyTest
36test_InsertInsert = prop "insert k b . insert k a == insert k b" $ do
37 m <- forAll genMap
38 TF a@(IntProxy (proxy :: Proxy n) i) <- forAll genTF
39 let b = IntProxy proxy (i + 1)
40 lookup @n @IntProxy (insert b $ insert a m) === Just b
42test_DeleteMember :: PropertyTest
43test_DeleteMember = prop "member k . delete k == False" $ do
44 m <- forAll genMap
45 TF (proxy :: IntProxy n) <- forAll genTF
46 shouldInsert <- forAll Gen.bool
48 if shouldInsert then
49 member @n (delete @n $ insert proxy m) === False
50 else
51 member @n (delete @n m) === False
53----------------------------------------------------------------------------
54-- Generators
55----------------------------------------------------------------------------
57data IntProxy (n :: Nat) = IntProxy (Proxy n) Int
58 deriving (Show, Eq)
60genMap :: MonadGen m => m (TypeRepMap IntProxy)
61genMap = fromList <$> Gen.list (Range.linear 0 1000) genTF
63genTF :: MonadGen m => m (TF IntProxy)
64genTF = do
65 randNat :: Integer <- Gen.integral (Range.linear 0 10000)
66 randInt <- Gen.int Range.constantBounded
67 case someNatVal randNat of
68 Just (SomeNat proxyNat) -> pure $ TF $ IntProxy proxyNat randInt
69 Nothing -> error "Invalid test generator"