Trie 2

gistfile1.hs

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

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

data Trie m k v = Trie (Maybe v) (m k (Trie m k v))

class FiniteMap m k where
    empty' :: m k v
    look' :: k -> m k v -> Maybe v
    bind' :: k -> v -> m k v -> m k v

empty :: FiniteMap m k => Trie m k v
empty = Trie Nothing empty'

look :: (FiniteMap m k, Ord k) => [k] -> Trie m k v -> Maybe v
look [] (Trie b _) = b
look (k:ks) (Trie _ m) = look' k m >>= look ks

bind :: (FiniteMap m k, Ord k) => [k] -> v -> Trie m k v -> Trie m k v
bind [] x (Trie _ m) = Trie (Just x) m
bind (k:ks) x (Trie b m) = Trie b (bind' k t' m)
  where
    t = fromMaybe empty $ look' k m
    t' = bind ks x t

instance FiniteMap Map Char where
    empty' = M.empty
    look' = M.lookup
    bind' = M.insert