monoidmap-0.0.1.2: src/test/Examples/RecoveredMapSpec.hs
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use any" #-}
{-# HLINT ignore "Use null" #-}
-- |
-- Copyright: © 2022–2024 Jonathan Knowles
-- License: Apache-2.0
--
module Examples.RecoveredMapSpec
where
import Prelude
import Data.Function
( on, (&) )
import Data.List
( nubBy )
import Data.Monoid
( Sum (..) )
import Data.Proxy
( Proxy (..) )
import Data.Semigroup
( Semigroup (stimes) )
import Data.Set
( Set )
import Data.Text
( Text )
import Data.Typeable
( Typeable, typeRep )
import Numeric.Natural
( Natural )
import Test.Hspec
( Spec, describe, it )
import Test.QuickCheck
( Arbitrary (..)
, CoArbitrary
, Fun
, Function
, NonNegative (..)
, Property
, Testable
, applyFun
, checkCoverage
, cover
, listOf
, shrinkMapBy
, (===)
)
import Test.QuickCheck.Classes
( eqLaws, functorLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws )
import Test.QuickCheck.Classes.Hspec
( testLawsMany )
import Test.QuickCheck.Instances.Natural
()
import Test.QuickCheck.Instances.Text
()
import qualified Data.Map.Strict as OMap
import qualified Data.Set as Set
import qualified Examples.RecoveredMap as RMap
import qualified Test.QuickCheck as QC
spec :: Spec
spec = do
specFor (Proxy @Int) (Proxy @(Set Int))
specFor (Proxy @Int) (Proxy @(Set Natural))
specFor (Proxy @Int) (Proxy @(Sum Int))
specFor (Proxy @Int) (Proxy @(Sum Natural))
specFor (Proxy @Int) (Proxy @Text)
specFor
:: forall k v. () =>
( Arbitrary k
, Arbitrary v
, CoArbitrary v
, Eq v
, Function v
, Monoid v
, Ord k
, Show k
, Show v
, Typeable k
, Typeable v
)
=> Proxy k
-> Proxy v
-> Spec
specFor keyType valueType = do
let description = mconcat
[ "RecoveredMap ("
, show (typeRep keyType)
, ") ("
, show (typeRep valueType)
, ")"
]
let property :: Testable t => t -> Property
property = checkCoverage . QC.property
describe description $ do
describe "Class laws" $ do
testLawsMany @(RMap.Map k v)
[ eqLaws
, monoidLaws
, semigroupLaws
, semigroupMonoidLaws
]
testLawsMany @(RMap.Map k)
[ functorLaws
]
describe "Conversion to and from lists" $ do
it "prop_fromList_toList" $
prop_fromList_toList
@k @v & property
describe "Empty" $ do
it "prop_empty_keysSet" $
prop_empty_keysSet
@k & property
it "prop_empty_lookup" $
prop_empty_lookup
@k @v & property
it "prop_empty_show" $
prop_empty_show
@k @v & property
it "prop_empty_toList" $
prop_empty_toList
@k @v & property
describe "Singleton" $ do
it "prop_singleton_keysSet" $
prop_singleton_keysSet
@k @v & property
it "prop_singleton_lookup" $
prop_singleton_lookup
@k @v & property
it "prop_singleton_show" $
prop_singleton_show
@k @v & property
it "prop_singleton_toList" $
prop_singleton_toList
@k @v & property
describe "Append" $ do
it "prop_append_toList" $
prop_append_toList
@k @v & property
describe "Times" $ do
it "prop_stimes_toList" $
prop_stimes_toList
@k @v & property
describe "Delete" $ do
it "prop_delete_lookup" $
prop_delete_lookup
@k @v & property
it "prop_delete_member" $
prop_delete_member
@k @v & property
it "prop_delete_toList" $
prop_delete_toList
@k @v & property
describe "Insert" $ do
it "prop_insert_lookup" $
prop_insert_lookup
@k @v & property
it "prop_insert_member" $
prop_insert_member
@k @v & property
it "prop_insert_toList" $
prop_insert_toList
@k @v & property
describe "Map" $ do
it "prop_map" $
prop_map
@k @v @v & property
it "prop_map_mempty" $
prop_map_mempty
@k @v @v & property
--------------------------------------------------------------------------------
-- Conversion to and from lists
--------------------------------------------------------------------------------
prop_fromList_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> [(k, v)]
-> Property
prop_fromList_toList kvs =
(===)
(RMap.toList (RMap.fromList kvs))
(OMap.toList (OMap.fromList kvs))
& cover 10
(length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs)
"length kvs > 1 && length (nubBy ((==) `on` fst) kvs) /= length kvs"
& cover 10
(length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs)
"length kvs > 1 && length (nubBy ((==) `on` fst) kvs) == length kvs"
--------------------------------------------------------------------------------
-- Empty
--------------------------------------------------------------------------------
prop_empty_keysSet
:: forall k. (Eq k, Show k)
=> Property
prop_empty_keysSet =
(===)
(RMap.keysSet (RMap.empty @k))
(OMap.keysSet (OMap.empty @k))
prop_empty_lookup
:: forall k v. (Ord k, Eq v, Show v)
=> k
-> Property
prop_empty_lookup k =
(===)
(RMap.lookup k (RMap.empty @k @v))
(OMap.lookup k (OMap.empty @k @v))
prop_empty_show
:: forall k v. (Show k, Show v)
=> Property
prop_empty_show =
(===)
(show (RMap.empty @k @v))
(show (OMap.empty @k @v))
prop_empty_toList
:: forall k v. (Eq k, Show k, Eq v, Show v)
=> Property
prop_empty_toList =
(===)
(RMap.toList (RMap.empty @k @v))
(OMap.toList (OMap.empty @k @v))
--------------------------------------------------------------------------------
-- Singleton
--------------------------------------------------------------------------------
prop_singleton_keysSet
:: forall k v. (Ord k, Show k)
=> k
-> v
-> Property
prop_singleton_keysSet k v =
(===)
(RMap.keysSet (RMap.singleton k v))
(OMap.keysSet (OMap.singleton k v))
prop_singleton_lookup
:: forall k v. (Ord k, Eq v, Show v)
=> k
-> v
-> Property
prop_singleton_lookup k v =
(===)
(RMap.lookup k (RMap.singleton k v))
(OMap.lookup k (OMap.singleton k v))
prop_singleton_show
:: forall k v. (Ord k, Show k, Show v)
=> k
-> v
-> Property
prop_singleton_show k v =
(===)
(show (RMap.singleton k v))
(show (OMap.singleton k v))
prop_singleton_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> k
-> v
-> Property
prop_singleton_toList k v =
(===)
(RMap.toList (RMap.singleton k v))
(OMap.toList (OMap.singleton k v))
--------------------------------------------------------------------------------
-- Append
--------------------------------------------------------------------------------
prop_append_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> [(k, v)]
-> [(k, v)]
-> Property
prop_append_toList kvs1 kvs2 =
(===)
(RMap.toList (RMap.fromList kvs1 <> RMap.fromList kvs2))
(OMap.toList (OMap.fromList kvs1 <> OMap.fromList kvs2))
& cover 10
(ks1 `Set.disjoint` ks2)
"ks1 `Set.disjoint` ks2"
& cover 10
(not (ks1 `Set.disjoint` ks2))
"not (ks1 `Set.disjoint` ks2)"
where
ks1 = Set.fromList (fst <$> kvs1)
ks2 = Set.fromList (fst <$> kvs2)
--------------------------------------------------------------------------------
-- Times
--------------------------------------------------------------------------------
prop_stimes_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> [(k, v)]
-> NonNegative Int
-> Property
prop_stimes_toList kvs (NonNegative n) =
(===)
(RMap.toList (stimes n (RMap.fromList kvs)))
(OMap.toList (stimes n (OMap.fromList kvs)))
& cover 1
(n == 0)
"n == 0"
& cover 1
(n == 1)
"n == 1"
& cover 10
(n >= 2)
"n >= 2"
--------------------------------------------------------------------------------
-- Delete
--------------------------------------------------------------------------------
prop_delete_lookup
:: forall k v. (Ord k, Eq v, Show v)
=> [(k, v)]
-> k
-> Property
prop_delete_lookup kvs k =
(===)
(RMap.lookup k (RMap.delete k (RMap.fromList kvs)))
(OMap.lookup k (OMap.delete k (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
prop_delete_member
:: forall k v. (Ord k, Eq v)
=> [(k, v)]
-> k
-> Property
prop_delete_member kvs k =
(===)
(RMap.member k (RMap.delete k (RMap.fromList kvs)))
(OMap.member k (OMap.delete k (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
prop_delete_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> [(k, v)]
-> k
-> Property
prop_delete_toList kvs k =
(===)
(RMap.toList (RMap.delete k (RMap.fromList kvs)))
(OMap.toList (OMap.delete k (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
--------------------------------------------------------------------------------
-- Insert
--------------------------------------------------------------------------------
prop_insert_lookup
:: forall k v. (Ord k, Eq v, Show v)
=> [(k, v)]
-> k
-> v
-> Property
prop_insert_lookup kvs k v =
(===)
(RMap.lookup k (RMap.insert k v (RMap.fromList kvs)))
(OMap.lookup k (OMap.insert k v (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
prop_insert_member
:: forall k v. (Ord k, Eq v)
=> [(k, v)]
-> k
-> v
-> Property
prop_insert_member kvs k v =
(===)
(RMap.member k (RMap.insert k v (RMap.fromList kvs)))
(OMap.member k (OMap.insert k v (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
prop_insert_toList
:: forall k v. (Ord k, Show k, Eq v, Show v)
=> [(k, v)]
-> k
-> v
-> Property
prop_insert_toList kvs k v =
(===)
(RMap.toList (RMap.insert k v (RMap.fromList kvs)))
(OMap.toList (OMap.insert k v (OMap.fromList kvs)))
& cover 10
(filter ((== k) . fst) kvs == [])
"filter ((== k) . fst) kvs == []"
& cover 10
(filter ((== k) . fst) kvs /= [])
"filter ((== k) . fst) kvs /= []"
--------------------------------------------------------------------------------
-- Map
--------------------------------------------------------------------------------
prop_map
:: (Ord k, Show k, Eq v2, Show v2)
=> [(k, v1)]
-> Fun v1 v2
-> Property
prop_map kvs (applyFun -> f) =
(===)
(RMap.toList (RMap.map f (RMap.fromList kvs)))
(OMap.toList (OMap.map f (OMap.fromList kvs)))
prop_map_mempty
:: forall k v1 v2. (Ord k, Show k, Eq v2, Monoid v2, Show v2)
=> [(k, v1)]
-> Property
prop_map_mempty kvs =
(===)
(RMap.toList (RMap.map (const (mempty @v2)) (RMap.fromList kvs)))
(OMap.toList (OMap.map (const (mempty @v2)) (OMap.fromList kvs)))
--------------------------------------------------------------------------------
-- Arbitrary instances
--------------------------------------------------------------------------------
instance (Arbitrary k, Ord k, Arbitrary v) =>
Arbitrary (RMap.Map k v)
where
arbitrary = RMap.fromList <$> listOf ((,) <$> arbitrary <*> arbitrary)
shrink = shrinkMapBy RMap.fromList RMap.toList shrink