The Monad.Reader/Discuss Issue11/FingerTreeIMap
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
--Dfplace 16:19, 12 September 2008 (UTC)
{-# OPTIONS_GHC -fglasgow-exts -fallow-undecidable-instances #-}
module IMap where
import Data.FingerTree
import Data.List hiding (insert,delete,lookup)
import Prelude hiding (lookup)
import Data.Monoid
data Elem a b = Elem a b
data Key k v = NoKey | Key k v
instance Eq k => Eq (Key k v) where
(Key j _) == (Key k _) = j == k
NoKey == NoKey = True
NoKey == (Key _ _) = False
(Key _ _) == NoKey = False
instance Ord k => Ord (Key k v) where
compare (Key j _) (Key k _) = compare j k
compare NoKey NoKey = EQ
compare (Key _ _) NoKey = GT
compare NoKey (Key _ _ ) = LT
instance Monoid v => Monoid (Key a v) where
mempty = NoKey
k `mappend` NoKey = k
NoKey `mappend` k = k
(Key _ x) `mappend` (Key k y) = Key k (x `mappend` y)
data IMap a b = IMap (FingerTree (Key a b) (Elem a b))
instance (Monoid b) => Measured (Key a b) (Elem a b) where
measure (Elem x y) = Key x y
insert :: (Ord k, Monoid v) => k -> v -> IMap k v -> IMap k v
insert k v (IMap xs) = insert' $ viewl r
where
(l,r) = split (>= Key k undefined) xs
new = IMap ( l >< (Elem k v <| r))
insert' ((Elem y _) :< r')
| k == y = IMap ( l >< (Elem k v <| r'))
| otherwise = new
insert' EmptyL = new
delete :: (Ord k, Monoid v) => k -> IMap k v -> IMap k v
delete x (IMap xs) = IMap (l >< r')
where
(l,r) = split (>= Key x undefined) xs
(_,r') = split (> Key x undefined) r
lookup :: (Monad m, Ord t, Monoid v) => t -> IMap t v -> m v
lookup x (IMap xs) = lookup' $
viewl . snd $
split (>= Key x undefined) xs
where
lookup' ((Elem y v) :< _)
| y == x = return v
| otherwise = fail "IMap.lookup failed"
lookup' EmptyL = fail "IMap.lookup failed"
getValue :: (Monoid v) => IMap k v -> v
getValue (IMap xs) = let (Key _ v) = measure xs in v