Add function fromSet to MonoidMap. (#224)

Author: jonathanknowles

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:

src/public/Data/MonoidMap.hs

@@ -22,6 +22,7 @@ module Data.MonoidMap
     , fromList
     , fromListWith
     , fromMap
+    , fromSet
     , singleton
 
     -- ** Deconstruction

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))"

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