While discussing Data.Map and Data.Set, I'd like to raise again a point I mentioned previously with respect to Data.FiniteMap: http://www.haskell.org/pipermail/libraries/2004-November/002670.html I since created a private copy of Data.Map with the functionality I desire [1]. At the time, concern was expressed that consistency would require a lot of new monadic functions to be defined. Is there any easy way the module interface could be revised to allow this kind of added functionality to be created externally to the module? #g -- [1] Monadic union for Data.Map: [[ {-------------------------------------------------------------------- Monadic union --------------------------------------------------------------------} -- | /O(n+m)/. Monadic version of union with a combining function. -- The implementation uses the efficient /hedge-union/ algorithm. -- -- The combining 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 -- | /O(n+m)/. Monadic version of @unionWithKey@. -- The implementation uses the efficient /hedge-union/ algorithm. -- -- See @unionWithM@ for further details. -- 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 = hedgeUnionWithKeyML flipf (const LT) (const GT) t2 t1 where flipf k x y = f k y x -- 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"])] -- 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 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"])] fmt1 = unionWithM comb fm1 fm2 == fm12 fmt2 = unionWithM comb fm1 fm3 == fm13 fmt3 = unionWithM comb fm2 fm3 == fm23 -- Test function uses state to accumulate combined keys combk :: k -> [a] -> [a] -> State.State [k] [a] combk k ov nv = State.State (\s -> (ov++nv,s++[k])) fmk12 = ( fromList [(1,["a","b","c"]),(2,["b","c"]),(3,["d"]),(4,["e"])] , [1] ) fmk13 = (fromList [(1,["a","d","e"]),(2,["b","c","c","d"]),(3,["d"]),(4,["f"])] ,[1,2] ) fmk23 = (fromList [(1,["b","c","d","e"]),(2,["c","d"]),(4,["e","f"])] ,[1,4]) fmt4 = State.runState (unionWithKeyM combk fm1 fm2) [] == fmk12 fmt5 = State.runState (unionWithKeyM combk fm1 fm3) [] == fmk13 fmt6 = State.runState (unionWithKeyM combk fm2 fm3) [] == fmk23 fmtall = and [fmt1,fmt2,fmt3,fmt4,fmt5,fmt6] ]] ------------ Graham Klyne For email: http://www.ninebynine.org/#Contact