module Data.Map.List (AssocList(..)) where
import Data.Monoid
import qualified Data.Maybe as Maybe
import qualified Data.List as List
import Prelude hiding (sum,concat,lookup,map,filter,foldr,foldr1,foldl,null,reverse,(++),minimum,maximum,all,elem,concatMap,head)
import Data.Collections
import Data.Typeable
import Data.Ord (comparing)
newtype AssocList s k v = AssocList s
#include "Typeable.h"
INSTANCE_TYPEABLE3(AssocList,theTc,"Data.Map.List.AssocList")
instance (Eq c, Eq k, Eq v, Foldable c (k,v)) => Eq (AssocList c k v) where
(AssocList l1) == (AssocList l2) = l1 == l2 ||
(size l1 == size l2 && all (`elem` l1) l2)
instance Show l => Show (AssocList l k v) where
show (AssocList l) = "AssocList " >< show l
instance Sequence c (k,v) => Foldable (AssocList c k v) (k,v) where
foldr f z (AssocList l) = foldr f z l
null (AssocList l) = null l
instance (Ord k, Sequence c (k,v)) => Collection (AssocList c k v) (k,v) where
filter f (AssocList l) = AssocList $ filter f l
instance (Ord k, Sequence c (k,v)) => Unfoldable (AssocList c k v) (k,v) where
empty = AssocList empty
insert (k,v) m = insertWith const k v m
instance (Ord k, Sequence c (k,v)) => Indexed (AssocList c k v) k v where
index k c = Maybe.fromJust $ lookup k c
adjust f k c = alter (fmap f) k c
inDomain = member
instance (Ord k, Sequence c (k,v)) => Monoid (AssocList c k v) where
mempty = empty
mappend = union
instance (Ord k, Sequence c (k,v), Monoid (AssocList c k v)) => Map (AssocList c k v) k v where
isSubmapBy f c1 c2 = all (\(k,v) -> case lookup k c2 of
Nothing -> False
Just v' -> f v v') c1
c1 `isSubset` c2 = all (`member` c2) (KeysView c1)
lookup k (AssocList l) = maybe (fail "Key not found") (return . snd) (find ((k ==) . fst) l)
intersectionWith f (AssocList m1) m2
= AssocList $ fromList
[(k,f x y) | (k,x) <- toList m1,
y <- Maybe.maybeToList $ lookup k m2]
unionWith f (AssocList m1) (AssocList m2) = AssocList $ fromList $ List.map unionOne $
List.groupBy ((==) `on` fst) $ List.sortBy (comparing fst) $ toList (m1 >< m2)
where unionOne list = (fst (head list), foldr1 f (List.map snd list))
differenceWith f (AssocList m1) m2 = AssocList $ fromList $ Maybe.catMaybes
[newEl k x (lookup k m2) | (k,x) <- toList m1]
where newEl k x Nothing = Just (k,x)
newEl k x (Just y) = fmap (\x->(k,x)) (f x y)
alter f k m@(AssocList l) = AssocList $ foldr construct
(if member k m then empty else maybe empty (\x -> singleton (k,x)) (f Nothing)) l
where construct :: (k,v) -> c -> c
construct a@(k',x) l
| k'== k = case f (Just x) of
Nothing -> l
Just x -> (k', x) <| l
| otherwise = a <| l
mapWithKey f (AssocList l) = AssocList (smap l)
where smap = foldr (\(k,x) s -> (k,f k x) <| s) mempty
on :: (b -> b -> c) -> (a -> b) -> (a -> a -> c)
on op f x y = op (f x) (f y)