Implementation of Conal's TMap and Map from his Denotational Design paper

Map.hs

{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}

module Map where

import Data.Functor.Compose
import Data.Monoid
import Prelude hiding (lookup)

newtype TMap k v = TMap (k -> v)

constant :: v -> TMap k v
constant v = TMap $ const v

update :: Eq k => k -> v -> TMap k v -> TMap k v
update k v (TMap m) = TMap $ \k' -> if k == k' then v else m k'

sample :: Eq k => TMap k v -> k -> v
sample (TMap m) k = m k

unionWith :: (a -> b -> c) -> TMap k a -> TMap k b -> TMap k c
unionWith f (TMap ma) (TMap mb) = TMap $ \k -> f (ma k) (mb k)

instance Monoid v => Monoid (TMap k v) where
    mempty = TMap mempty
    mappend (TMap l) (TMap r) = TMap $ mappend l r

instance Functor (TMap k) where
    fmap f (TMap m) = TMap $ \k -> f (m k)

deriving instance Functor First

type Map k = Compose (TMap k) First

empty :: Map k v
empty = Compose $ constant (First Nothing)

insert :: Eq k => k -> v -> Map k v -> Map k v
insert k v (Compose m) = Compose $ update k (First $ Just v) m

lookup :: Eq k => Map k v -> k -> Maybe v
lookup (Compose m) = getFirst . sample m