Proposed addition to Data.FiniteMap

Graham Klyne gk at ninebynine.org
Tue Nov 9 07:44:36 EST 2004


I'd like to propose an addition to the FiniteMap module in the form of a 
monadic version of plusFM_C.  The proposed implementation is pretty much a 
copy of the existing implementation within a do block.

[[
-- | Monadic version of plusFM_C.
--
--   The combiner function returns a monadic value, which is threaded though
--   the combined elements in key order, yielding a FiniteMap that is bound
--   to the same monadic type.  The intended use for this is with a Maybe
--   monad, allowing result returned to be Nothing if any of the attempted
--   combinations of key values return Nothing.  Could also be usefully used
--   with an error or state monad.
plusFM_CM :: ( Ord key, Monad m ) =>
     (elt -> elt -> m elt) -> FiniteMap key elt -> FiniteMap key elt
     -> m (FiniteMap key elt)
plusFM_CM combiner EmptyFM fm2 = return fm2
plusFM_CM combiner fm1 EmptyFM = return fm1
plusFM_CM combiner fm1 (Branch split_key elt2 _ left right)
   = do { new_l   <- plusFM_CM combiner (splitLT fm1 split_key) left
        ; new_elt <- case lookupFM fm1 split_key of
                        Nothing   -> return elt2
                        Just elt1 -> combiner elt1 elt2
        ; new_r   <- plusFM_CM combiner (splitGT fm1 split_key) right
        ; return $ mkVBalBranch split_key new_elt new_l new_r
        }

-- And some test cases:
fm1 = listToFM [(1,["a"]),(2,["b","c"]),(3,["d"])]
fm2 = listToFM [(1,["b","c"]),(4,["e"])]
fm3 = listToFM [(1,["d","e"]),(2,["c","d"]),(4,["f"])]
fm12 = Just $ listToFM [(1,["a","b","c"]),(2,["b","c"]),(3,["d"]),(4,["e"])]
fm13 = Nothing
fm23 = Just $ listToFM [(1,["b","c","d","e"]),(2,["c","d"]),(4,["e","f"])]
-- Test function returns Nothing if list values have a member in common:
comb ovs nvs | null (intersect ovs nvs) = Just (ovs++nvs)
              | otherwise                = Nothing
fmt1 = plusFM_CM comb fm1 fm2 == fm12
fmt2 = plusFM_CM comb fm1 fm3 == fm13
fmt3 = plusFM_CM comb fm2 fm3 == fm23
fmtall = and [fmt1,fmt2,fmt3]
]]


------------
Graham Klyne
For email:
http://www.ninebynine.org/#Contact



More information about the Libraries mailing list