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