Difference between revisions of "The Monad.Reader/Discuss Issue11/FingerTreeIMap"

From HaskellWiki
Jump to: navigation, search
m
(Deleting page that hasn't been updated for over 10 years)
Line 1: Line 1:
--[[User:Dfplace|Dfplace]] 16:19, 12 September 2008 (UTC)
 
 
<haskell>
 
{-# 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
 
</haskell>
 

Revision as of 14:34, 6 February 2021