Proposed addition to Data.FiniteMap

[Graham Klyne]

At 13:06 09/11/04 +0000, Simon Marlow wrote:
>On 09 November 2004 12:45, Graham Klyne wrote:
>
> > 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.
>
>Data.FiniteMap will shortly be deprecated in favour of DData.Map (which
>will be renamed to Data.Map when it is imported).  Perhaps you'd like to
>reformulate the proposal using Data.Map instead?

OK, the proposed addition is below.  I haven't fully tested the monad 
threading order.
(Hmm.. using a state monad to collect a list of keys might be a way to do 
that.)

Deprecation notwithstanding, given that FiniteMap is the current library 
module, and that it would be nice if my code works out-of-the-box with the 
next public release of the libraries, would there be any objection to also 
adding my original proposal to the current FiniteMap module?

#g
--

Proposed addition:
[[
{--------------------------------------------------------------------
   Monadic union
--------------------------------------------------------------------}

-- | Monadic version of union with a combining function.
--
--   The combiner function returns a monadic value, which is threaded though
--   the combined elements in key order, yielding a Map 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.
--
unionWithM :: (Ord k, Monad m) =>
     (a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
unionWithM f m1 m2
   = unionWithKeyM (\k x y -> f x y) m1 m2

-- | Monadic version of unionWithKey.
--
--   (See unionWithM)
--
unionWithKeyM :: (Ord k, Monad m) =>
     (k -> a -> a -> m a) -> Map k a -> Map k a -> m (Map k a)
unionWithKeyM f Tip t2  = return t2
unionWithKeyM f t1 Tip  = return t1
unionWithKeyM f t1 t2
   -- hedge-union is more efficient on (bigset `union` smallset)
   | size t1 >= size t2  = hedgeUnionWithKeyML f (const LT) (const GT) t1 t2
   | otherwise           = hedgeUnionWithKeyMR f (const LT) (const GT) t2 t1

-- Left version of monadic hedgeUnionWithKey
-- (Monad is threaded left-to-right in tree)
hedgeUnionWithKeyML :: (Ord k, Monad m) =>
     (k -> a -> a -> m a) -> (k -> Ordering) -> (k -> Ordering) -> Map k a 
-> Map k a
     -> m (Map k a)
hedgeUnionWithKeyML f cmplo cmphi t1 Tip
   = return t1
hedgeUnionWithKeyML f cmplo cmphi Tip (Bin _ kx x l r)
   = return $ join kx x (filterGt cmplo l) (filterLt cmphi r)
hedgeUnionWithKeyML f cmplo cmphi (Bin _ kx x l r) t2
   = do { newl <- hedgeUnionWithKeyML f cmplo cmpkx l lt
        ; newx <- case found of
                     Nothing -> return x
                     Just y  -> f kx x y
        ; newr <- hedgeUnionWithKeyML f cmpkx cmphi r gt
        ; return $ join kx newx newl newr
        }
   where
     cmpkx k     = compare kx k
     lt          = trim cmplo cmpkx t2
     (found,gt)  = trimLookupLo kx cmphi t2

-- Right version of monadic hedgeUnionWithKey
-- (Monad is threaded Right-to-Left in tree)
hedgeUnionWithKeyMR :: (Ord k, Monad m) =>
     (k -> a -> a -> m a) -> (k -> Ordering) -> (k -> Ordering) -> Map k a 
-> Map k a
     -> m (Map k a)
hedgeUnionWithKeyMR f cmplo cmphi t1 Tip
   = return t1
hedgeUnionWithKeyMR f cmplo cmphi Tip (Bin _ kx x l r)
   = return $ join kx x (filterGt cmplo l) (filterLt cmphi r)
hedgeUnionWithKeyMR f cmplo cmphi (Bin _ kx x l r) t2
   = do { newr <- hedgeUnionWithKeyMR f cmpkx cmphi r gt
        ; newx <- case found of
                     Nothing -> return x
                     Just y  -> f kx y x
        ; newl <- hedgeUnionWithKeyMR f cmplo cmpkx l lt
        ; return $ join kx newx newl newr
        }
   where
     cmpkx k     = compare kx k
     lt          = trim cmplo cmpkx t2
     (found,gt)  = trimLookupLo kx cmphi t2

-- And some test cases:
fm1 = fromList [(1,["a"]),(2,["b","c"]),(3,["d"])]
fm2 = fromList [(1,["b","c"]),(4,["e"])]
fm3 = fromList [(1,["d","e"]),(2,["c","d"]),(4,["f"])]
fm12 = Just $ fromList [(1,["a","b","c"]),(2,["b","c"]),(3,["d"]),(4,["e"])]
fm13 = Nothing
fm23 = Just $ fromList [(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 (List.intersect ovs nvs) = Just (ovs++nvs)
              | otherwise                = Nothing
fmt1 = unionWithM comb fm1 fm2 == fm12
fmt2 = unionWithM comb fm1 fm3 == fm13
fmt3 = unionWithM comb fm2 fm3 == fm23
fmtall = and [fmt1,fmt2,fmt3]
]]



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