add few properties about filtering 'TokenMap'

lib/core/src/Cardano/Wallet/Primitive/Types/TokenMap/Gen.hs

@@ -1,8 +1,12 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+
 module Cardano.Wallet.Primitive.Types.TokenMap.Gen
     ( genAssetIdSmallRange
     , genTokenMapSmallRange
     , shrinkAssetIdSmallRange
     , shrinkTokenMapSmallRange
+    , AssetIdF (..)
     ) where
 
 import Prelude
@@ -14,13 +18,29 @@ import Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
     , genTokenPolicyIdSmallRange
     , shrinkTokenNameSmallRange
     , shrinkTokenPolicyIdSmallRange
+    , tokenNamesMediumRange
+    , tokenPolicies
     )
 import Cardano.Wallet.Primitive.Types.TokenQuantity.Gen
     ( genTokenQuantitySmall, shrinkTokenQuantitySmall )
 import Control.Monad
     ( replicateM )
+import Data.List
+    ( elemIndex )
+import Data.Maybe
+    ( fromMaybe )
+import GHC.Generics
+    ( Generic )
 import Test.QuickCheck
-    ( Gen, choose, oneof, shrinkList )
+    ( CoArbitrary (..)
+    , Function (..)
+    , Gen
+    , choose
+    , functionMap
+    , oneof
+    , shrinkList
+    , variant
+    )
 import Test.QuickCheck.Extra
     ( shrinkInterleaved )
 
@@ -66,3 +86,19 @@ shrinkTokenMapSmallRange
     shrinkAssetQuantity (a, q) = shrinkInterleaved
         (a, shrinkAssetIdSmallRange)
         (q, shrinkTokenQuantitySmall)
+
+--------------------------------------------------------------------------------
+-- Filtering functions
+--------------------------------------------------------------------------------
+
+newtype AssetIdF = AssetIdF AssetId
+    deriving (Generic, Eq, Show, Read)
+
+instance Function AssetIdF where
+    function = functionMap show read
+
+instance CoArbitrary AssetIdF where
+    coarbitrary (AssetIdF AssetId{tokenName, tokenPolicyId}) genB = do
+        let n = fromMaybe 0 (elemIndex tokenName tokenNamesMediumRange)
+        let m = fromMaybe 0 (elemIndex tokenPolicyId tokenPolicies)
+        variant (n+m) genB

lib/core/src/Cardano/Wallet/Primitive/Types/TokenPolicy/Gen.hs

@@ -1,7 +1,10 @@
 module Cardano.Wallet.Primitive.Types.TokenPolicy.Gen
     ( genTokenNameSmallRange
+    , tokenNamesSmallRange
     , genTokenNameMediumRange
+    , tokenNamesMediumRange
     , genTokenPolicyIdSmallRange
+    , tokenPolicies
     , shrinkTokenNameSmallRange
     , shrinkTokenNameMediumRange
     , shrinkTokenPolicyIdSmallRange

lib/core/test/unit/Cardano/Wallet/Primitive/Types/TokenMapSpec.hs

@@ -16,7 +16,8 @@ import Algebra.PartialOrd
 import Cardano.Wallet.Primitive.Types.TokenMap
     ( AssetId (..), Flat (..), Nested (..), TokenMap )
 import Cardano.Wallet.Primitive.Types.TokenMap.Gen
-    ( genAssetIdSmallRange
+    ( AssetIdF (..)
+    , genAssetIdSmallRange
     , genTokenMapSmallRange
     , shrinkAssetIdSmallRange
     , shrinkTokenMapSmallRange
@@ -68,7 +69,16 @@ import Test.Hspec
 import Test.Hspec.Core.QuickCheck
     ( modifyMaxSuccess )
 import Test.QuickCheck
-    ( Arbitrary (..), Property, checkCoverage, cover, property, (===), (==>) )
+    ( Arbitrary (..)
+    , Fun
+    , Property
+    , applyFun
+    , checkCoverage
+    , cover
+    , property
+    , (===)
+    , (==>)
+    )
 import Test.QuickCheck.Classes
     ( eqLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws )
 import Test.Utils.Laws
@@ -84,9 +94,11 @@ import qualified Data.Aeson.Types as Aeson
 import qualified Data.Foldable as F
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
 import qualified Data.Text as T
 import qualified Test.Utils.Roundtrip as Roundtrip
 
+
 spec :: Spec
 spec =
     describe "Token map properties" $
@@ -141,6 +153,15 @@ spec =
         it "prop_toNestedList_fromNestedList" $
             property prop_toNestedList_fromNestedList
 
+    parallel $ describe "Filtering" $ do
+
+        it "prop_filter_conjoin" $
+            property prop_filter_conjoin
+        it "prop_filter_partition" $
+            property prop_filter_partition
+        it "prop_filter_twice" $
+            property prop_filter_twice
+
     parallel $ describe "Arithmetic" $ do
 
         it "prop_add_commutative" $
@@ -302,6 +323,38 @@ prop_toNestedList_fromNestedList :: TokenMap -> Property
 prop_toNestedList_fromNestedList b =
     TokenMap.fromNestedList (TokenMap.toNestedList b) === b
 
+--------------------------------------------------------------------------------
+-- Filtering properties
+--------------------------------------------------------------------------------
+
+-- | Verify that all 'AssetId' on the resulting filtered map do validate the
+-- predicate.
+prop_filter_conjoin :: Fun AssetIdF Bool -> TokenMap -> Property
+prop_filter_conjoin f b =
+    let
+        as = TokenMap.getAssets $ TokenMap.filter (applyFun f . AssetIdF) b
+    in
+        Set.foldr ((&&) . applyFun f . AssetIdF) True as === True
+
+-- | Verify that we can partition the token map using the predicate, and recover
+-- the original map by computing the union of both partitions.
+prop_filter_partition :: Fun AssetIdF Bool -> TokenMap -> Property
+prop_filter_partition f b =
+    let
+        l = TokenMap.filter (applyFun f . AssetIdF) b
+        r = TokenMap.filter (not . applyFun f . AssetIdF) b
+    in
+        (l <> r) === b
+
+-- | Verify that filtering twice has the same effect as filtering once.
+prop_filter_twice :: Fun AssetIdF Bool -> TokenMap -> Property
+prop_filter_twice f b =
+    let
+        once  = TokenMap.filter (applyFun f . AssetIdF) b
+        twice = TokenMap.filter (applyFun f . AssetIdF) once
+    in
+        once === twice
+
 --------------------------------------------------------------------------------
 -- Arithmetic properties
 --------------------------------------------------------------------------------