diff --git a/src/internal/Data/MonoidMap/Internal.hs b/src/internal/Data/MonoidMap/Internal.hs index 5aa3b40..702690b 100644 --- a/src/internal/Data/MonoidMap/Internal.hs +++ b/src/internal/Data/MonoidMap/Internal.hs @@ -23,6 +23,7 @@ module Data.MonoidMap.Internal , fromList , fromListWith , fromMap + , fromSet , singleton -- ** Deconstruction @@ -479,6 +480,26 @@ fromListWith f = fromMap :: MonoidNull v => Map k v -> MonoidMap k v fromMap = MonoidMap . Map.mapMaybe maybeNonNull +-- | \(O(n)\). Constructs a 'MonoidMap' from a 'Set' and a function from +-- keys to values. +-- +-- Satisfies the following property for all possible keys __@k@__: +-- +-- @ +-- 'get' k ('fromSet' f ks) '==' +-- if 'Set'.'Set.member' k ks +-- then f k +-- else 'mempty' +-- @ +-- +-- This function performs canonicalisation of 'C.null' values, and has a time +-- complexity that is linear in the 'Set.size' of the set. +-- +-- @since 0.0.2.0 +-- +fromSet :: MonoidNull v => (k -> v) -> Set k -> MonoidMap k v +fromSet f = fromMap . Map.fromSet f + -- | \(O(1)\). Constructs a 'MonoidMap' from a single key-value pair. -- -- Satisfies the following property: diff --git a/src/public/Data/MonoidMap.hs b/src/public/Data/MonoidMap.hs index b3cb420..6bf910f 100644 --- a/src/public/Data/MonoidMap.hs +++ b/src/public/Data/MonoidMap.hs @@ -22,6 +22,7 @@ module Data.MonoidMap , fromList , fromListWith , fromMap + , fromSet , singleton -- ** Deconstruction diff --git a/src/test/Data/MonoidMap/ConversionSpec.hs b/src/test/Data/MonoidMap/ConversionSpec.hs index 88a176a..0b12f6d 100644 --- a/src/test/Data/MonoidMap/ConversionSpec.hs +++ b/src/test/Data/MonoidMap/ConversionSpec.hs @@ -22,18 +22,22 @@ import Data.MonoidMap ( MonoidMap, nonNullCount ) import Data.Proxy ( Proxy (..) ) +import Data.Set + ( Set ) import Test.Common ( Key, Test, TestType (TestType), makeSpec, property, testTypesMonoidNull ) import Test.Hspec ( Spec, describe, it ) import Test.QuickCheck - ( Fun (..), Property, applyFun2, cover, (===) ) + ( Fun (..), Property, applyFun, applyFun2, cover, (===) ) import qualified Data.Foldable as F import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map +import qualified Data.Monoid.Null as Null import qualified Data.MonoidMap as MonoidMap +import qualified Data.Set as Set spec :: Spec spec = describe "Conversions" $ do @@ -71,6 +75,11 @@ specFor = makeSpec $ do prop_toMap_fromMap @k @v & property + describe "Conversion from sets" $ do + it "prop_fromSet_get" $ + prop_fromSet_get + @k @v & property + -------------------------------------------------------------------------------- -- Conversion to and from lists -------------------------------------------------------------------------------- @@ -186,3 +195,26 @@ prop_toMap_fromMap :: Test k v => MonoidMap k v -> Property prop_toMap_fromMap m = MonoidMap.fromMap (MonoidMap.toMap m) === m + +-------------------------------------------------------------------------------- +-- Conversion from sets +-------------------------------------------------------------------------------- + +prop_fromSet_get + :: Test k v => Fun k v -> Set k -> k -> Property +prop_fromSet_get (applyFun -> f) ks k = + MonoidMap.get k (MonoidMap.fromSet f ks) + === + (if Set.member k ks then f k else mempty) + & cover 0.2 + (Set.member k ks && Null.null (f k)) + "Set.member k ks && Null.null (f k)" + & cover 8.0 + (Set.member k ks && not (Null.null (f k))) + "Set.member k ks && not (Null.null (f k))" + & cover 0.2 + (not (Set.member k ks) && Null.null (f k)) + "not (Set.member k ks) && Null.null (f k)" + & cover 8.0 + (not (Set.member k ks) && not (Null.null (f k))) + "not (Set.member k ks) && not (Null.null (f k))" diff --git a/src/test/Data/MonoidMap/ValiditySpec.hs b/src/test/Data/MonoidMap/ValiditySpec.hs index 394cca3..50fe592 100644 --- a/src/test/Data/MonoidMap/ValiditySpec.hs +++ b/src/test/Data/MonoidMap/ValiditySpec.hs @@ -40,6 +40,8 @@ import Data.MonoidMap ( MonoidMap ) import Data.MonoidMap.SliceSpec ( Slice (..) ) +import Data.Set + ( Set ) import Test.Common ( Key , Test @@ -128,6 +130,9 @@ specValidMonoidNull = makeSpec $ do it "propValid_fromMap" $ propValid_fromMap @k @v & property + it "propValid_fromSet" $ + propValid_fromSet + @k @v & property it "propValid_singleton" $ propValid_singleton @k @v & property @@ -347,8 +352,16 @@ propValid_fromMap propValid_fromMap m = propValid (MonoidMap.fromMap m) & cover 2 - (Map.filter (Null.null) m /= mempty) - "Map.filter (Null.null) m /= mempty" + (Map.filter Null.null m /= mempty) + "Map.filter Null.null m /= mempty" + +propValid_fromSet + :: Test k v => Fun k v -> Set k -> Property +propValid_fromSet (applyFun -> f) ks = + propValid (MonoidMap.fromSet f ks) + & cover 2 + (Map.filter Null.null (Map.fromSet f ks) /= mempty) + "Map.filter Null.null (Map.fromSet f ks) /= mempty" propValid_singleton :: Test k v => k -> v -> Property