MapMonad.hs

MapMonad.hs

import Data.Map (Map)
import qualified Data.Map as Map

instance (Ord k, Monoid k) => Applicative (Map k) where
    pure = Map.singleton mempty
    f <*> x = Map.fromList [(mappend fk xk, f Map.! fk $ x Map.! xk) | fk <- Map.keys f, xk <- Map.keys x]

instance (Ord k, Monoid k) => Monad (Map k) where
    return = pure
    m >>= f = Map.fromList $ do
        mk <- Map.keys m
        let childMap = f (m Map.! mk)
        nk <- Map.keys childMap
        return (mappend mk nk, childMap Map.! nk)