packages feed

list-tries (empty) → 0.0

raw patch · 34 files changed

+7610/−0 lines, 34 filesdep +basedep +containersdep +dlistsetup-changed

Dependencies added: base, containers, dlist

Files

+ Data/ListTrie/Base.hs view
@@ -0,0 +1,841 @@+-- File created: 2008-11-13 21:13:55++{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies+           , FlexibleContexts #-}++module Data.ListTrie.Base+   ( Trie(..)+   , null, size, size', member, notMember, lookup, lookupWithDefault+   , isSubmapOfBy, isProperSubmapOfBy+   , empty, singleton+   , insert, insert', insertWith, insertWith'+   , delete, adjust, adjust', updateLookup, alter, alter'+   , unionWith, unionWithKey, unionWith', unionWithKey'+   , unionsWith, unionsWithKey, unionsWith', unionsWithKey'+   , differenceWith, differenceWithKey+   , intersectionWith,  intersectionWithKey+   , intersectionWith', intersectionWithKey'+   , filterWithKey, partitionWithKey+   , split, splitLookup+   , mapKeysWith, mapInKeysWith, mapInKeysWith'+   , foldrWithKey,  foldrAscWithKey,  foldrDescWithKey+   , foldlWithKey,  foldlAscWithKey,  foldlDescWithKey+   , foldlWithKey', foldlAscWithKey', foldlDescWithKey'+   , toList, toAscList, toDescList+   , fromList, fromListWith, fromListWith', fromListWithKey, fromListWithKey'+   , findMin, findMax, deleteMin, deleteMax, minView, maxView+   , findPredecessor, findSuccessor+   , addPrefix, splitPrefix, deletePrefix, children+   , showTrieWith+   ) where++import Control.Applicative (Applicative(..), (<$>))+import Control.Arrow       ((***), first)+import qualified Data.DList as DL+import Data.DList          (DList)+import Data.Foldable       (foldr, foldl')+import Data.List           (partition)+import Data.Maybe          (fromJust)+import Prelude hiding      (lookup, filter, foldr, null)+import qualified Prelude++import qualified Data.ListTrie.Base.Map.Internal as Map+import Data.ListTrie.Base.Classes+   ( Boolable(..)+   , Unwrappable(..)+   , Unionable(..), Differentiable(..), Intersectable(..)+   , Alt(..)+   , fmap', (<$!>)+   )+import Data.ListTrie.Base.Map (Map, OrdMap)+import Data.ListTrie.Util     ((.:), both)++class (Map map k, Functor st, Unwrappable st)+   => Trie trie st map k | trie -> st where++   mkTrie :: st a -> CMap trie map k a -> trie map k a+   tParts :: trie map k a -> (st a, CMap trie map k a)++type CMap trie map k v = map k (trie map k v)++hasValue, noValue :: Boolable b => b -> Bool+hasValue = toBool+noValue  = not . hasValue++tVal :: Trie trie st map k => trie map k a -> st a+tVal = fst . tParts++tMap :: Trie trie st map k => trie map k a -> CMap trie map k a+tMap = snd . tParts++mapVal :: Trie trie st map k => trie map k a+                             -> (st a -> st a)+                             -> trie map k a+mapVal tr f = mkTrie (f . tVal $ tr) (tMap tr)++mapMap :: (Trie trie st map k1, Trie trie st map k2)+       => trie map k1 a+       -> (CMap trie map k1 a -> CMap trie map k2 a)+       -> trie map k2 a+mapMap tr f = mkTrie (tVal tr) (f . tMap $ tr)++onVals :: Trie trie st map k => (st a -> st b -> st c)+                             -> trie map k a+                             -> trie map k b+                             -> st c+onVals f a b = f (tVal a) (tVal b)++onMaps :: Trie trie st map k => (  CMap trie map k a+                                -> CMap trie map k b+                                -> CMap trie map k c+                                )+                             -> trie map k a+                             -> trie map k b+                             -> CMap trie map k c+onMaps f a b = f (tMap a) (tMap b)++-----------------------++-- * Construction++-- O(1)+empty :: (Alt st a, Trie trie st map k) => trie map k a+empty = mkTrie altEmpty Map.empty++-- O(s)+singleton :: (Alt st a, Trie trie st map k) => [k] -> a -> trie map k a+singleton xs v = addPrefix xs $ mkTrie (pure v) Map.empty++-- O(min(m,s))+insert :: (Alt st a, Trie trie st map k)+       => [k] -> a -> trie map k a -> trie map k a+insert = insertWith const++-- O(min(m,s))+insert' :: (Alt st a, Boolable (st a), Trie trie st map k)+        => [k] -> a -> trie map k a -> trie map k a+insert' = insertWith' const++-- O(min(m,s))+insertWith :: (Alt st a, Trie trie st map k)+           => (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+insertWith = genericInsertWith (<$>)++-- O(min(m,s))+insertWith' :: (Alt st a, Boolable (st a), Trie trie st map k)+            => (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+insertWith' = (seq <*>) .: genericInsertWith (<$!>)++genericInsertWith :: (Alt st a, Trie trie st map k)+                  => ((a -> a) -> st a -> st a)+                  -> (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+genericInsertWith (<$$>) f []     new tr =+   mapVal tr $ \old -> (f new <$$> old) <|> pure new++genericInsertWith (<$$>) f (x:xs) val tr = mapMap tr $ \m ->+   Map.insertWith (\_ old -> genericInsertWith (<$$>) f xs val old)+                  x (singleton xs val) m++-- O(min(m,s))+delete :: (Alt st a, Boolable (st a), Trie trie st map k)+       => [k] -> trie map k a -> trie map k a+delete = alter (const altEmpty)++-- O(min(m,s))+adjust :: Trie trie st map k+       => (a -> a) -> [k] -> trie map k a -> trie map k a+adjust = genericAdjust fmap++-- O(min(m,s))+adjust' :: (Alt st a, Boolable (st a), Trie trie st map k)+        => (a -> a) -> [k] -> trie map k a -> trie map k a+adjust' = genericAdjust fmap'++genericAdjust :: Trie trie st map k+              => ((a -> a) -> st a -> st a)+              -> (a -> a) -> [k] -> trie map k a -> trie map k a+genericAdjust myFmap f []     tr = mapVal tr (myFmap f)+genericAdjust myFmap f (x:xs) tr =+   mapMap tr $ \m -> Map.adjust (genericAdjust myFmap f xs) x m++-- O(min(m,s))+updateLookup :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (a -> st a) -> [k] -> trie map k a -> (st a, trie map k a)+updateLookup f [] tr =+   let (v,m) = tParts tr+       v'    = if hasValue v then f (unwrap v) else v+    in (v, mkTrie v' m)++updateLookup f (x:xs) orig =+   let m   = tMap orig+    in case Map.lookup x m of+            Nothing -> (altEmpty, orig)+            Just tr ->+               let (ret, upd) = updateLookup f xs tr+                in ( ret+                   , mkTrie (tVal orig) $ if null upd+                                             then Map.delete             x m+                                             else Map.adjust (const upd) x m+                   )++-- O(min(m,s))+--+-- Lazy in exactly one case: the key is the prefix of another key in the trie.+-- Otherwise we have to test whether the function removed a key or not, lest+-- the trie fall into an invalid state.+alter :: (Alt st a, Boolable (st a), Trie trie st map k)+      => (st a -> st a) -> [k] -> trie map k a -> trie map k a+alter = genericAlter (flip const)++-- O(min(m,s))+alter' :: (Alt st a, Boolable (st a), Trie trie st map k)+       => (st a -> st a) -> [k] -> trie map k a -> trie map k a+alter' = genericAlter seq++genericAlter :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (st a -> trie map k a -> trie map k a)+             -> (st a -> st a) -> [k] -> trie map k a -> trie map k a+genericAlter seeq f []     tr =+   let (v,m) = tParts tr+       v'    = f v+    in v' `seeq` mkTrie v' m++genericAlter seeq f (x:xs) tr = mapMap tr $ \m ->+   Map.alter (\mold -> case mold of+                            Nothing ->+                               let v = f altEmpty+                                in if hasValue v+                                      then Just (singleton xs (unwrap v))+                                      else Nothing+                            Just old ->+                               let new = genericAlter seeq f xs old+                                in if null new then Nothing else Just new)+              x m++-- * Querying++-- O(1)+--+-- Test the strict field last for maximal laziness+null :: (Boolable (st a), Trie trie st map k) => trie map k a -> Bool+null tr = Map.null (tMap tr) && (noValue.tVal $ tr)++-- O(n m)+size :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n+size  tr = foldr  ((+) . size)  (if hasValue (tVal tr) then 1 else 0) (tMap tr)++-- O(n m)+size' :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n+size' tr = foldl' (flip $ (+) . size')+                  (if hasValue (tVal tr) then 1 else 0)+                  (tMap tr)++-- O(min(m,s))+member :: (Alt st a, Boolable (st a), Trie trie st map k)+       => [k] -> trie map k a -> Bool+member = hasValue .: lookup++-- O(min(m,s))+notMember :: (Alt st a, Boolable (st a), Trie trie st map k)+          => [k] -> trie map k a -> Bool+notMember = not .: member++-- O(min(m,s))+lookup :: (Alt st a, Trie trie st map k) => [k] -> trie map k a -> st a+lookup []     tr = tVal tr+lookup (x:xs) tr = maybe altEmpty (lookup xs) (Map.lookup x (tMap tr))++-- O(min(m,s))+lookupWithDefault :: (Alt st a, Trie trie st map k)+                  => a -> [k] -> trie map k a -> a+lookupWithDefault def k tr = unwrap $ lookup k tr <|> pure def++-- O(min(n1 m1,n2 m2))+isSubmapOfBy :: (Boolable (st a), Boolable (st b), Trie trie st map k)+             => (a -> b -> Bool)+             -> trie map k a+             -> trie map k b+             -> Bool+isSubmapOfBy f tr1 tr2 =+   let (v1,m1) = tParts tr1+       (v2,m2) = tParts tr2+       hv1     = hasValue v1+       hv2     = hasValue v2+    in and [ not (hv1 && not hv2)+           , (not hv1 && not hv2) || f (unwrap v1) (unwrap v2)+           , Map.isSubmapOfBy (isSubmapOfBy f) m1 m2+           ]++-- O(min(n1 m1,n2 m2))+isProperSubmapOfBy :: (Boolable (st a), Boolable (st b), Trie trie st map k)+                   => (a -> b -> Bool)+                   -> trie map k a+                   -> trie map k b+                   -> Bool+isProperSubmapOfBy = go False+ where+   go proper f tr1 tr2 =+      let (v1,m1) = tParts tr1+          (v2,m2) = tParts tr2+          hv1     = hasValue v1+          hv2     = hasValue v2+          -- This seems suboptimal but I can't think of anything better+          proper' = or [ proper+                       , noValue v1 && hasValue v2+                       , not (Map.null $ Map.difference m2 m1)+                       ]+       in and [ not (hv1 && not hv2)+              , (not hv1 && not hv2) || f (unwrap v1) (unwrap v2)+              , if Map.null m1+                   then proper'+                   else Map.isSubmapOfBy (go proper' f) m1 m2+              ]+++-- * Combination++-- O(min(n1 m1,n2 m2))+unionWith :: (Unionable st a, Trie trie st map k)+          => (a -> a -> a) -> trie map k a -> trie map k a -> trie map k a+unionWith f = genericUnionWith (unionVals f) (flip const)++-- O(min(n1 m1,n2 m2))+unionWith' :: (Unionable st a, Trie trie st map k)+          => (a -> a -> a) -> trie map k a -> trie map k a -> trie map k a+unionWith' f = genericUnionWith (unionVals' f) seq++genericUnionWith :: Trie trie st map k+                 => (st a -> st a -> st a)+                 -> (st a -> trie map k a -> trie map k a)+                 -> trie map k a+                 -> trie map k a+                 -> trie map k a+genericUnionWith valUnion seeq tr1 tr2 =+   let v = onVals valUnion tr1 tr2+    in v `seeq` (+          mkTrie v $+             onMaps (Map.unionWith (genericUnionWith valUnion seeq))+                    tr1 tr2)++-- O(min(n1 m1,n2 m2))+unionWithKey :: (Unionable st a, Trie trie st map k) => ([k] -> a -> a -> a)+                                                     -> trie map k a+                                                     -> trie map k a+                                                     -> trie map k a+unionWithKey = genericUnionWithKey unionVals (flip const)++-- O(min(n1 m1,n2 m2))+unionWithKey' :: (Unionable st a, Trie trie st map k) => ([k] -> a -> a -> a)+                                                      -> trie map k a+                                                      -> trie map k a+                                                      -> trie map k a+unionWithKey' = genericUnionWithKey unionVals' seq++genericUnionWithKey :: Trie trie st map k+                    => ((a -> a -> a) -> st a -> st a -> st a)+                    -> (st a -> trie map k a -> trie map k a)+                    -> ([k] -> a -> a -> a)+                    -> trie map k a+                    -> trie map k a+                    -> trie map k a+genericUnionWithKey = go DL.empty+ where+   go k valUnion seeq f tr1 tr2 =+      let v = onVals (valUnion (f $ DL.toList k)) tr1 tr2+       in v `seeq` (+             mkTrie v $+                onMaps (Map.unionWithKey $+                           \x -> go (k `DL.snoc` x) valUnion seeq f)+                       tr1 tr2)++-- O(sum(n))+unionsWith :: (Alt st a, Unionable st a, Trie trie st map k)+           => (a -> a -> a) -> [trie map k a] -> trie map k a+unionsWith f = foldl' (unionWith f) empty++-- O(sum(n))+unionsWith' :: (Alt st a, Unionable st a, Trie trie st map k)+            => (a -> a -> a) -> [trie map k a] -> trie map k a+unionsWith' f = foldl' (unionWith' f) empty++-- O(sum(n))+unionsWithKey :: (Alt st a, Unionable st a, Trie trie st map k)+              => ([k] -> a -> a -> a) -> [trie map k a] -> trie map k a+unionsWithKey j = foldl' (unionWithKey j) empty++-- O(sum(n))+unionsWithKey' :: (Alt st a, Unionable st a, Trie trie st map k)+               => ([k] -> a -> a -> a) -> [trie map k a] -> trie map k a+unionsWithKey' j = foldl' (unionWithKey' j) empty++-- O(min(n1 m1,n2 m2))+differenceWith :: (Boolable (st a), Differentiable st a b, Trie trie st map k)+               => (a -> b -> Maybe a)+               -> trie map k a+               -> trie map k b+               -> trie map k a+differenceWith f tr1 tr2 =+   let v = onVals (differenceVals f) tr1 tr2++       -- This would be lazy only in the case where the differing keys were at+       -- []. (And even then most operations on the trie would force the+       -- value.) For consistency with other keys and Patricia, just seq it for+       -- that case as well.+    in v `seq` mkTrie v $ onMaps (Map.differenceWith (g f)) tr1 tr2+ where+   g f' t1 t2 = let t' = differenceWith f' t1 t2+                 in if null t' then Nothing else Just t'++-- O(min(n1 m1,n2 m2))+differenceWithKey :: ( Boolable (st a), Differentiable st a b+                     , Trie trie st map k+                     )+                  => ([k] -> a -> b -> Maybe a)+                  -> trie map k a+                  -> trie map k b+                  -> trie map k a+differenceWithKey = go DL.empty+ where+   go k f tr1 tr2 =+      let v = onVals (differenceVals (f $ DL.toList k)) tr1 tr2++          -- see comment in differenceWith for seq explanation+       in v `seq` mkTrie v $ onMaps (Map.differenceWithKey (g k f)) tr1 tr2++   g k f x t1 t2 = let t' = go (k `DL.snoc` x) f t1 t2+                         in if null t' then Nothing else Just t'++-- O(min(n1 m1,n2 m2))+intersectionWith :: ( Boolable (st c), Intersectable st a b c+                     , Trie trie st map k+                     )+                 => (a -> b -> c)+                 -> trie map k a+                 -> trie map k b+                 -> trie map k c+intersectionWith f = genericIntersectionWith (intersectionVals f) (flip const)++-- O(min(n1 m1,n2 m2))+intersectionWith' :: ( Boolable (st c), Intersectable st a b c+                     , Trie trie st map k+                     )+                  => (a -> b -> c)+                  -> trie map k a+                  -> trie map k b+                  -> trie map k c+intersectionWith' f = genericIntersectionWith (intersectionVals' f) seq++genericIntersectionWith :: (Boolable (st c), Trie trie st map k)+                        => (st a -> st b -> st c)+                        -> (st c -> trie map k c -> trie map k c)+                        -> trie map k a+                        -> trie map k b+                        -> trie map k c+genericIntersectionWith valIntersection seeq tr1 tr2 =+   tr seeq+      (onVals valIntersection tr1 tr2)+      (onMaps (Map.filter (not.null) .:+                  Map.intersectionWith+                     (genericIntersectionWith valIntersection seeq))+              tr1 tr2)+ where+   tr seeq' v m =+      v `seeq'` (mkTrie v $+                    case Map.singletonView m of+                         Just (_, child) | null child -> tMap child+                         _                            -> m)++-- O(min(n1 m1,n2 m2))+intersectionWithKey :: ( Boolable (st c), Intersectable st a b c+                       , Trie trie st map k+                       )+                    => ([k] -> a -> b -> c)+                    -> trie map k a+                    -> trie map k b+                    -> trie map k c+intersectionWithKey = genericIntersectionWithKey intersectionVals (flip const)++-- O(min(n1 m1,n2 m2))+intersectionWithKey' :: ( Boolable (st c), Intersectable st a b c+                        , Trie trie st map k+                        )+                     => ([k] -> a -> b -> c)+                     -> trie map k a+                     -> trie map k b+                     -> trie map k c+intersectionWithKey' = genericIntersectionWithKey intersectionVals' seq++genericIntersectionWithKey :: (Boolable (st c), Trie trie st map k)+                           => ((a -> b -> c) -> st a -> st b -> st c)+                           -> (st c -> trie map k c -> trie map k c)+                           -> ([k] -> a -> b -> c)+                           -> trie map k a+                           -> trie map k b+                           -> trie map k c+genericIntersectionWithKey = go DL.empty+ where+   go k valIntersection seeq f tr1 tr2 =+      tr seeq+         (onVals (valIntersection (f $ DL.toList k)) tr1 tr2)+         (onMaps (Map.filter (not.null) .:+                     Map.intersectionWithKey+                        (\x -> go (k `DL.snoc` x) valIntersection seeq f))+                 tr1 tr2)++   tr seeq v m =+      v `seeq` (mkTrie v $+                   case Map.singletonView m of+                        Just (_, child) | null child -> tMap child+                        _                            -> m)++-- * Filtering++-- O(n m)+filterWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+              => ([k] -> a -> Bool) -> trie map k a -> trie map k a+filterWithKey p = fromList . Prelude.filter (uncurry p) . toList++-- O(n m)+partitionWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+                 => ([k] -> a -> Bool)+                 -> trie map k a+                 -> (trie map k a, trie map k a)+partitionWithKey p = both fromList . partition (uncurry p) . toList++-- * Mapping++-- O(n m)+mapKeysWith :: (Boolable (st a), Trie trie st map k1, Trie trie st map k2)+            => ([([k2],a)] -> trie map k2 a)+            -> ([k1] -> [k2])+            -> trie map k1 a+            -> trie map k2 a+mapKeysWith fromlist f = fromlist . map (first f) . toList++-- O(n m)+mapInKeysWith :: (Unionable st a, Trie trie st map k1, Trie trie st map k2)+              => (a -> a -> a)+              -> (k1 -> k2)+              -> trie map k1 a+              -> trie map k2 a+mapInKeysWith = genericMapInKeysWith unionWith++-- O(n m)+mapInKeysWith' :: (Unionable st a, Trie trie st map k1, Trie trie st map k2)+               => (a -> a -> a)+               -> (k1 -> k2)+               -> trie map k1 a+               -> trie map k2 a+mapInKeysWith' = genericMapInKeysWith unionWith'++genericMapInKeysWith :: ( Unionable st a+                        , Trie trie st map k1, Trie trie st map k2+                        )+                     => (f -> trie map k2 a -> trie map k2 a -> trie map k2 a)+                     -> f+                     -> (k1 -> k2)+                     -> trie map k1 a+                     -> trie map k2 a+genericMapInKeysWith unionW j f tr =+   mapMap tr $+      Map.fromListWith (unionW j) .+         map (f *** genericMapInKeysWith unionW j f) .+      Map.toList++-- * Folding++-- O(n m)+foldrWithKey :: (Boolable (st a), Trie trie st map k)+             => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrWithKey f x = foldr (uncurry f) x . toList++-- O(n m)+foldrAscWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrAscWithKey f x = foldr (uncurry f) x . toAscList++-- O(n m)+foldrDescWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                 => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrDescWithKey f x = foldr (uncurry f) x . toDescList++-- O(n m)+foldlWithKey :: (Boolable (st a), Trie trie st map k)+             => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlWithKey f x = foldl (flip $ uncurry f) x . toList++-- O(n m)+foldlAscWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlAscWithKey f x = foldl (flip $ uncurry f) x . toAscList++-- O(n m)+foldlDescWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                 => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlDescWithKey f x = foldl (flip $ uncurry f) x . toDescList++-- O(n m)+foldlWithKey' :: (Boolable (st a), Trie trie st map k)+              => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlWithKey' f x = foldl' (flip $ uncurry f) x . toList++-- O(n m)+foldlAscWithKey' :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                 => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlAscWithKey' f x = foldl' (flip $ uncurry f) x . toAscList++-- O(n m)+foldlDescWithKey' :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                  => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlDescWithKey' f x = foldl' (flip $ uncurry f) x . toDescList++-- * Conversion between lists++-- O(n m)+toList :: (Boolable (st a), Trie trie st map k) => trie map k a -> [([k],a)]+toList = genericToList Map.toList DL.cons++-- O(n m)+toAscList :: (Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> [([k],a)]+toAscList = genericToList Map.toAscList DL.cons++-- O(n m)+toDescList :: (Boolable (st a), Trie trie st map k, OrdMap map k)+           => trie map k a -> [([k],a)]+toDescList = genericToList (reverse . Map.toAscList) (flip DL.snoc)++genericToList :: (Boolable (st a), Trie trie st map k)+              => (CMap trie map k a -> [(k, trie map k a)])+              -> (([k],a) -> DList ([k],a) -> DList ([k],a))+              -> trie map k a+              -> [([k],a)]+genericToList f_ g_ = DL.toList . go DL.empty f_ g_+ where+   go xs tolist add tr =+      let (v,m) = tParts tr+          xs'   =+             DL.concat .+             map (\(x,t) -> go (xs `DL.snoc` x) tolist add t) .+             tolist $ m+       in if hasValue v+             then add (DL.toList xs, unwrap v) xs'+             else                              xs'++-- O(n m)+fromList :: (Alt st a, Trie trie st map k) => [([k],a)] -> trie map k a+fromList = fromListWith const++-- O(n m)+fromListWith :: (Alt st a, Trie trie st map k)+             => (a -> a -> a) -> [([k],a)] -> trie map k a+fromListWith f = foldl' (flip . uncurry $ insertWith f) empty++-- O(n m)+fromListWith' :: (Alt st a, Boolable (st a), Trie trie st map k)+              => (a -> a -> a) -> [([k],a)] -> trie map k a+fromListWith' f = foldl' (flip . uncurry $ insertWith' f) empty++-- O(n m)+fromListWithKey :: (Alt st a, Trie trie st map k)+                => ([k] -> a -> a -> a) -> [([k],a)] -> trie map k a+fromListWithKey f = foldl' (\tr (k,v) -> insertWith (f k) k v tr) empty++-- O(n m)+fromListWithKey' :: (Alt st a, Boolable (st a), Trie trie st map k)+                 => ([k] -> a -> a -> a) -> [([k],a)] -> trie map k a+fromListWithKey' f = foldl' (\tr (k,v) -> insertWith' (f k) k v tr) empty++-- * Min/max++-- O(m)+minView :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> (Maybe ([k], a), trie map k a)+minView = minMaxView (hasValue . tVal) (fst . Map.minViewWithKey)++-- O(m)+maxView :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> (Maybe ([k], a), trie map k a)+maxView = minMaxView (Map.null . tMap) (fst . Map.maxViewWithKey)++minMaxView :: (Alt st a, Boolable (st a), Trie trie st map k)+           => (trie map k a -> Bool)+           -> (CMap trie map k a -> Maybe (k, trie map k a))+           -> trie map k a+           -> (Maybe ([k], a), trie map k a)+minMaxView _ _ tr_ | null tr_ = (Nothing, tr_)+minMaxView f g tr_ = first Just (go f g tr_)+ where+   go isWanted mapView tr =+      let (v,m) = tParts tr+       in if isWanted tr+             then (([], unwrap v), mkTrie altEmpty m)+             else let (k,      tr')  = fromJust (mapView m)+                      (minMax, tr'') = go isWanted mapView tr'+                   in ( first (k:) minMax+                      , mkTrie v $ if null tr''+                                      then Map.delete              k m+                                      else Map.adjust (const tr'') k m+                      )++-- O(m)+findMin :: (Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> Maybe ([k], a)+findMin = findMinMax (hasValue . tVal) (fst . Map.minViewWithKey)++-- O(m)+findMax :: (Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> Maybe ([k], a)+findMax = findMinMax (Map.null . tMap) (fst . Map.maxViewWithKey)++findMinMax :: (Boolable (st a), Trie trie st map k)+           => (trie map k a -> Bool)+           -> (CMap trie map k a -> Maybe (k, trie map k a))+           -> trie map k a+           -> Maybe ([k], a)+findMinMax _ _ tr_ | null tr_ = Nothing+findMinMax f g tr_ = Just (go f g DL.empty tr_)+ where+   go isWanted mapView xs tr =+      if isWanted tr+         then (DL.toList xs, unwrap (tVal tr))+         else let (k, tr') = fromJust . mapView . tMap $ tr+               in go isWanted mapView (xs `DL.snoc` k) tr'++-- O(m)+deleteMin :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> trie map k a+deleteMin = snd . minView++-- O(m)+deleteMax :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> trie map k a+deleteMax = snd . maxView++-- O(min(m,s))+split :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+      => [k] -> trie map k a -> (trie map k a, trie map k a)+split xs tr = let (l,_,g) = splitLookup xs tr in (l,g)++-- O(min(m,s))+splitLookup :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+            => [k]+            -> trie map k a+            -> (trie map k a, st a, trie map k a)+splitLookup []     tr = (empty, tVal tr, mkTrie altEmpty (tMap tr))+splitLookup (x:xs) tr =+   let (v,m) = tParts tr+       (ml, subTr, mg) = Map.splitLookup x m+    in case subTr of+            Nothing  -> (mkTrie v ml, altEmpty, mkTrie altEmpty mg)+            Just tr' ->+               let (tl, v', tg) = splitLookup xs tr'+                   ml' = if null tl then ml else Map.insert x tl ml+                   mg' = if null tg then mg else Map.insert x tg mg+                in (mkTrie v ml', v', mkTrie altEmpty mg')++-- O(m)+findPredecessor :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => [k] -> trie map k a -> Maybe ([k], a)+findPredecessor _   tr | null tr = Nothing+findPredecessor xs_ tr_          = go xs_ tr_+ where+   go [] _ = Nothing++   -- We need to try the trie at x and then the trie at the predecessor of x:+   -- e.g. if looking for "foo", we need to try any 'f' branch to see if it has+   -- "fob" first, before grabbing the next-best option of the maximum of the+   -- 'b' branch, say "bar".+   --+   -- If there's no branch less than 'f' we try the current position as a last+   -- resort.+   go (x:xs) tr =+      let (v,m) = tParts tr+          predecessor = Map.findPredecessor x m+       in fmap (first (x:)) (Map.lookup x m >>= go xs)+          <|>+          case predecessor of+               Nothing         ->+                  if hasValue v+                     then Just ([], unwrap v)+                     else Nothing+               Just (best,btr) -> fmap (first (best:)) (findMax btr)++-- O(m)+findSuccessor :: (Boolable (st a), Trie trie st map k, OrdMap map k)+              => [k] -> trie map k a -> Maybe ([k], a)+findSuccessor _   tr | null tr = Nothing+findSuccessor xs_ tr_          = go xs_ tr_ + where+   go [] tr = do (k,t) <- fst . Map.minViewWithKey . tMap $ tr+                 fmap (first (k:)) (findMin t)++   go (x:xs) tr =+      let m = tMap tr+          successor = Map.findSuccessor x m+       in fmap (first (x:)) (Map.lookup x m >>= go xs)+          <|>+          (successor >>= \(best,btr) -> fmap (first (best:)) (findMin btr))++-- * Trie-only operations++-- O(s)+addPrefix :: (Alt st a, Trie trie st map k)+          => [k] -> trie map k a -> trie map k a+addPrefix []     = id+addPrefix (x:xs) = mkTrie altEmpty . Map.singleton x . addPrefix xs++-- O(m)+deletePrefix :: (Alt st a, Trie trie st map k)+             => [k] -> trie map k a -> trie map k a+deletePrefix []     tr = tr+deletePrefix (x:xs) tr =+   case Map.lookup x (tMap tr) of+        Nothing  -> empty+        Just tr' -> deletePrefix xs tr'++-- O(m)+splitPrefix :: (Alt st a, Trie trie st map k)+            => trie map k a -> ([k], st a, trie map k a)+splitPrefix = go DL.empty+ where+   go xs tr =+      case Map.singletonView (tMap tr) of+           Just (x,tr') -> go (xs `DL.snoc` x) tr'+           Nothing      -> let (v,m) = tParts tr+                            in (DL.toList xs, v, mkTrie altEmpty m)++-- O(m)+children :: (Boolable (st a), Trie trie st map k)+         => trie map k a -> [(k, trie map k a)]+children tr = let (v,m) = tParts tr+               in if hasValue v+                     then Map.toList m+                     else case Map.singletonView m of+                               Just (_, tr') -> children tr'+                               Nothing       -> Map.toList m++-- * Visualization++-- O(n m)+showTrieWith :: (Show k, Trie trie st map k)+             => (st a -> ShowS) -> trie map k a -> ShowS+showTrieWith = go 0+ where+   go indent f tr =+      let (v,m) = tParts tr+          sv    = f v+          lv    = length (sv [])+       in sv . showChar ' '+        . (foldr (.) id . zipWith (flip ($)) (False : repeat True) $+              map (\(k,t) -> \b -> let sk = shows k+                                       lk = length (sk [])+                                       i  = indent + lv + 1+                                    in (if b+                                           then showChar '\n'+                                              . showString (replicate i ' ')+                                           else id)+                                     . showString "-> "+                                     . sk . showChar ' '+                                     . go (i + lk + 4) f t)+                  (Map.toList m))
+ Data/ListTrie/Base/Classes.hs view
@@ -0,0 +1,100 @@+-- File created: 2008-12-27 20:53:49++-- Various type classes to make both (Maybe a) and (Identity Bool) work+-- wherever we need them.++{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies+           , FlexibleInstances #-}++module Data.ListTrie.Base.Classes where++import qualified Control.Applicative as A+import Control.Applicative (Applicative(..))+import Control.Monad       (liftM2)+import Data.Maybe          (fromJust, isJust)++-- Funky instances for this type are marked with **FUNKY**+newtype Identity a = Id a++class Unwrappable  w where unwrap  :: w a -> a+class Boolable     b where toBool  :: b -> Bool++instance Unwrappable  Maybe    where unwrap = fromJust+instance Boolable    (Maybe a) where toBool = isJust++instance Unwrappable Identity       where unwrap (Id a) = a+instance Boolable   (Identity Bool) where toBool = unwrap++class Unionable v a where+   unionVals         :: (a -> a -> a)       -> v a -> v a -> v a+   unionVals'        :: (a -> a -> a)       -> v a -> v a -> v a+class Differentiable v a b where+   differenceVals    :: (a -> b -> Maybe a) -> v a -> v b -> v a+class Intersectable v a b c where+   intersectionVals  :: (a -> b -> c)       -> v a -> v b -> v c+   intersectionVals' :: (a -> b -> c)       -> v a -> v b -> v c++instance Unionable    Maybe a  where+   unionVals f (Just a) (Just b) = Just (f a b)+   unionVals _ Nothing  mb       = mb+   unionVals _ ma       _        = ma++   unionVals' f (Just a) (Just b) = Just $! f a b+   unionVals' _ Nothing  mb       = mb+   unionVals' _ ma       _        = ma++instance Differentiable Maybe a b where+   differenceVals f (Just a) (Just b) = f a b+   differenceVals _ ma       _        = ma++instance Intersectable Maybe a b c where+   intersectionVals = liftM2++   intersectionVals' f (Just a) (Just b) = Just $! f a b+   intersectionVals' _ _        _        = Nothing++-- The other option with the following three would have been to just call f+-- (and, in the case of Differentiable, fromJust) and trust that it's correct.+-- I think this way is safer. Bottoms are passed to Base.unionWith etc.++-- **FUNKY**+instance Unionable Identity Bool where+   unionVals  _ (Id a) (Id b) = Id$ a || b+   unionVals' = error "Data.ListTrie.Base.Classes.unionVals' :: internal error"++-- **FUNKY**+instance Differentiable Identity Bool Bool where+   differenceVals _ (Id a) (Id b) = Id$ a && not b++-- **FUNKY**+instance Intersectable Identity Bool Bool Bool where+   intersectionVals _ (Id a) (Id b) = Id$ a && b+   intersectionVals' =+      error "Data.ListTrie.Base.Classes.intersectionVals' :: internal error"++class Applicative a => Alt a x where+   altEmpty :: a x+   (<|>) :: a x -> a x -> a x++instance Functor Identity where+   fmap f (Id a) = Id (f a)++instance Applicative Identity where+   pure = Id+   Id f <*> Id a = Id (f a)++instance Alt Maybe a where+   altEmpty = A.empty+   (<|>) = (A.<|>)++instance Alt Identity Bool where+   altEmpty = Id False+   Id a <|> Id b = Id (a || b)++fmap', (<$!>) :: (Boolable (f a), Unwrappable f, Alt f b)+              => (a -> b) -> f a -> f b+fmap' f ax = if toBool ax+                then pure $! f (unwrap ax)+                else altEmpty++(<$!>) = fmap'
+ Data/ListTrie/Base/Map.hs view
@@ -0,0 +1,522 @@+-- File created: 2008-11-07 17:30:16++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances #-}++module Data.ListTrie.Base.Map+   ( Map(..), OrdMap(..)+   , AList, WrappedIntMap+   ) where++import Control.Applicative (pure, (<*>))+import Control.Arrow       ((***), first, second)+import Control.Monad       (liftM, liftM2)+import Data.Foldable       (Foldable(..))+import Data.Function       (on)+import Data.List           ( foldl1'+                           , mapAccumL, nubBy, partition+                           , sort, sortBy+                           )+import Data.Ord            (comparing)+import Data.Traversable    (Traversable(..), mapAccumR)+import qualified Data.IntMap as IM+import qualified Data.Map    as M++import Prelude hiding ( foldl,foldl1,foldr,foldr1+                      , mapM,sequence+                      , null,lookup,filter -- for Haddock+                      )+import qualified Prelude++import Data.ListTrie.Util (both, (.:))++#ifdef MIN_VERSION_containers -- from Cabal+# if !(MIN_VERSION_containers(0,3,0))+# define TOO_OLD_CONTAINERS+# endif+#else+#define TOO_OLD_CONTAINERS+#endif++-- | Minimal complete implementation:+--+-- * 'eqCmp'+--+-- * 'null'+--+-- * 'lookup'+--+-- * 'alter'+--+-- * 'unionWithKey', 'differenceWithKey', 'intersectionWithKey'+--+-- * 'toList'+--+-- * 'empty' or 'fromList' or 'fromListWith'+--+-- * 'isSubmapOfBy'+--+-- For decent performance, supplying at least 'mapAccumWithKey' and 'filter' as+-- well is probably a good idea.+class Foldable (m k) => Map m k where+   -- | Like an 'Eq' instance over k, but should compare on the same type as+   -- @m@ does. In most cases this can be defined just as @const (==)@.+   eqCmp :: m k a -> k -> k -> Bool++   empty     ::                     m k a+   singleton ::           k -> a -> m k a+   -- | Precondition: the two keys differ+   doubleton :: k -> a -> k -> a -> m k a++   null   ::      m k a -> Bool+   lookup :: k -> m k a -> Maybe a++   -- | Strictness can be whatever is more optimal for the map type, shouldn't+   -- matter+   insertWith :: (a -> a -> a) -> k -> a -> m k a -> m k a+   insert     ::                  k -> a -> m k a -> m k a++   update :: (a -> Maybe a) -> k -> m k a -> m k a+   adjust :: (a -> a)       -> k -> m k a -> m k a+   delete ::                   k -> m k a -> m k a++   alter :: (Maybe a -> Maybe a) -> k -> m k a -> m k a++   unionWith           ::      (a -> a -> a)       -> m k a -> m k a -> m k a+   differenceWith      ::      (a -> b -> Maybe a) -> m k a -> m k b -> m k a+   intersectionWith    ::      (a -> b -> c)       -> m k a -> m k b -> m k c+   unionWithKey        :: (k -> a -> a -> a)       -> m k a -> m k a -> m k a+   differenceWithKey   :: (k -> a -> b -> Maybe a) -> m k a -> m k b -> m k a+   intersectionWithKey :: (k -> a -> b -> c)       -> m k a -> m k b -> m k c++   map             ::      (a -> b) -> m k a -> m k b+   mapWithKey      :: (k -> a -> b) -> m k a -> m k b+   mapAccum        :: (a ->      b -> (a,c)) -> a -> m k b -> (a, m k c)+   mapAccumWithKey :: (a -> k -> b -> (a,c)) -> a -> m k b -> (a, m k c)++   filter :: (a -> Bool) -> m k a -> m k a++   toList       :: m k a -> [(k,a)]+   fromList     ::                  [(k,a)] -> m k a+   fromListWith :: (a -> a -> a) -> [(k,a)] -> m k a++   isSubmapOfBy :: (a -> b -> Bool) -> m k a -> m k b -> Bool++   singletonView :: m k a -> Maybe (k,a)++   empty         = fromList []+   singleton k v = insert k v empty+   doubleton k v = insert k v .: singleton++   insert           = insertWith const+   insertWith f k v = alter (\mold -> Just $ case mold of+                                                    Nothing  -> v+                                                    Just old -> f v old)+                            k++   adjust f = update (Just . f)+   delete   = update (const Nothing)+   update f = alter  (f =<<)++   unionWith        = unionWithKey        . const+   differenceWith   = differenceWithKey   . const+   intersectionWith = intersectionWithKey . const++   map                 = mapWithKey . const+   mapWithKey      f   = snd . mapAccumWithKey (\_ k v -> ((), f k v)) ()+   mapAccum        f   = mapAccumWithKey (const . f)+   mapAccumWithKey f z =+      second fromList .+         mapAccumL (\a (k,v) -> fmap ((,) k) (f a k v)) z .+      toList++   filter p = fromList . Prelude.filter (p . snd) . toList++   -- | Should be strict in the keys+   fromList       = fromListWith const+   fromListWith f = foldr (uncurry $ insertWith f) empty++   singletonView m =+      case toList m of+           [x] -> Just x+           _   -> Nothing++-- |  Minimal complete definition:+--+-- * 'ordCmp'+--+-- * 'toAscList' or 'toDescList'+--+-- * 'splitLookup'+--+-- For decent performance, supplying at least the following is probably a good+-- idea:+--+-- * 'minViewWithKey', 'maxViewWithKey'+--+-- * 'mapAccumAscWithKey', 'mapAccumDescWithKey'+class Map m k => OrdMap m k where+   -- | Like an Ord instance over k, but should compare on the same type as @m@+   -- does. In most cases this can be defined just as @const compare@.+   ordCmp :: m k a -> k -> k -> Ordering++   toAscList            :: m k a -> [(k,a)]+   toDescList           :: m k a -> [(k,a)]++   splitLookup :: k -> m k a -> (m k a, Maybe a, m k a)+   split       :: k -> m k a -> (m k a,          m k a)++   minViewWithKey :: m k a -> (Maybe (k,a), m k a)+   maxViewWithKey :: m k a -> (Maybe (k,a), m k a)++   findPredecessor :: k -> m k a -> Maybe (k,a)+   findSuccessor   :: k -> m k a -> Maybe (k,a)++   mapAccumAsc         :: (a ->      b -> (a,c)) -> a -> m k b -> (a, m k c)+   mapAccumAscWithKey  :: (a -> k -> b -> (a,c)) -> a -> m k b -> (a, m k c)+   mapAccumDesc        :: (a ->      b -> (a,c)) -> a -> m k b -> (a, m k c)+   mapAccumDescWithKey :: (a -> k -> b -> (a,c)) -> a -> m k b -> (a, m k c)++   toAscList  = reverse . toDescList+   toDescList = reverse . toAscList++   split m k = let (a,_,b) = splitLookup m k in (a,b)++   minViewWithKey m =+      case toAscList m of+           []     -> (Nothing, m)+           (x:xs) -> (Just x, fromList xs)++   maxViewWithKey m =+      case toDescList m of+           []     -> (Nothing, m)+           (x:xs) -> (Just x, fromList xs)++   findPredecessor m = fst . maxViewWithKey . fst . split m+   findSuccessor   m = fst . minViewWithKey . snd . split m++   mapAccumAsc  f = mapAccumAscWithKey  (const . f)+   mapAccumDesc f = mapAccumDescWithKey (const . f)+   mapAccumAscWithKey f z =+      second fromList .+         mapAccumL (\a (k,v) -> fmap ((,) k) (f a k v)) z .+      toAscList+   mapAccumDescWithKey f z =+      second fromList .+         mapAccumL (\a (k,v) -> fmap ((,) k) (f a k v)) z .+      toDescList++------------- Instances++newtype AList k v = AL [(k,v)]++-- AList has to be ordering-ignorant+instance (Eq k, Eq v) => Eq (AList k v) where+   AL []     == AL ys = Prelude.null ys+   AL (x:xs) == AL ys =+      let (my,ys') = deleteAndGetBy (==x) ys+       in case my of+               Nothing -> False+               Just _  -> AL xs == AL ys'++instance (Ord k, Ord v) => Ord (AList k v) where+   compare (AL xs) (AL ys) = compare (sort xs) (sort ys)++instance Functor (AList k)  where fmap f (AL xs) = AL (fmap (second f) xs)+instance Foldable (AList k) where+    fold        (AL xs) = fold        (Prelude.map snd xs)+    foldMap f   (AL xs) = foldMap f   (Prelude.map snd xs)+    foldl   f z (AL xs) = foldl   f z (Prelude.map snd xs)+    foldl1  f   (AL xs) = foldl1  f   (Prelude.map snd xs)+    foldr   f z (AL xs) = foldr   f z (Prelude.map snd xs)+    foldr1  f   (AL xs) = foldr1  f   (Prelude.map snd xs)++instance Traversable (AList k) where+   traverse f (AL xs) =+      fmap AL . traverse (liftM2 fmap ((,).fst) snd . second f) $ xs++instance Eq k => Map AList k where+   eqCmp = const (==)++   empty             = AL []+   singleton k v     = AL [(k,v)]+   doubleton a b p q = AL [(a,b),(p,q)]++   null     (AL xs) = Prelude.null xs+   lookup x (AL xs) = Prelude.lookup x xs++   alter f k (AL xs) =+      let (old, ys) = deleteAndGetBy ((== k).fst) xs+       in case f (fmap snd old) of+               Nothing -> AL ys+               Just v  -> AL $ (k,v) : ys++   delete k (AL xs) = AL$ deleteBy (\a (b,_) -> a == b) k xs++   unionWithKey f (AL xs) (AL ys) =+      AL . uncurry (++) $ updateFirstsBy (\(k,x) (_,y) -> Just (k, f k x y))+                                         ((==) `on` fst)+                                         xs ys++   differenceWithKey f (AL xs) (AL ys) =+      AL . fst $ updateFirstsBy (\(k,x) (_,y) -> fmap ((,) k) (f k x y))+                                (\x y -> fst x == fst y)+                                xs ys++   intersectionWithKey f_ (AL xs_) (AL ys_) = AL$ go f_ xs_ ys_+    where+      go _ [] _ = []+      go f ((k,x):xs) ys =+         let (my,ys') = deleteAndGetBy ((== k).fst) ys+          in case my of+                  Just (_,y) -> (k, f k x y) : go f xs ys'+                  Nothing    ->                go f xs ys++   mapWithKey f (AL xs) = AL $ Prelude.map (\(k,v) -> (k, f k v)) xs++   mapAccumWithKey f z (AL xs) =+      second AL $ mapAccumL (\a (k,v) -> let (a',v') = f a k v+                                          in (a', (k, v')))+                            z xs++   toList (AL xs) = xs+   fromList       = AL . nubBy ((==) `on` fst)+   fromListWith   = AL .: go+    where+      go _ []     = []+      go f (x:xs) =+         -- We add some extra strictness here to match the other map types+         -- (strict in key even for singletons) and because we don't need the+         -- laziness (strict in value)+         let (as,bs) = partition (((==) `on` fst) x) xs+             v       = foldl1' f . Prelude.map snd $ x:as+          in fst x `seq` v `seq` ((fst x, v) : go f bs)++   isSubmapOfBy f_ (AL xs_) (AL ys_) = go f_ xs_ ys_+    where+      go _ []         _  = True+      go f ((k,x):xs) ys =+         let (my,ys') = deleteAndGetBy ((== k).fst) ys+          in case my of+                  Just (_,y) -> f x y && go f xs ys'+                  Nothing    -> False++instance Ord k => OrdMap AList k where+   ordCmp = const compare++   toAscList  = sortBy (       comparing fst) . toList+   toDescList = sortBy (flip $ comparing fst) . toList++   splitLookup k (AL xs) =+      let (ls,gs)  = partition ((< k).fst) xs+          (mx,gs') = deleteAndGetBy ((== k).fst) gs+       in (AL ls, fmap snd mx, AL gs')++deleteAndGetBy :: (a -> Bool) -> [a] -> (Maybe a, [a])+deleteAndGetBy = go []+ where+   go ys _ []     = (Nothing, ys)+   go ys p (x:xs) =+      if p x+         then (Just x, xs ++ ys)+         else go (x:ys) p xs++-- This is from Data.List, just with a more general type signature...+deleteBy :: (a -> b -> Bool) -> a -> [b] -> [b]+deleteBy _  _ []     = []+deleteBy eq x (y:ys) = if x `eq` y then ys else y : deleteBy eq x ys++updateFirstsBy :: (a -> b -> Maybe a)+               -> (a -> b -> Bool)+               -> [a]+               -> [b]+               -> ([a],[b])+updateFirstsBy _ _  []     ys  = ([],ys)+updateFirstsBy f eq (x:xs) ys =+   let (my,ys') = deleteAndGetBy (eq x) ys+    in case my of+            Nothing -> first (x:) $ updateFirstsBy f eq xs ys+            Just y  ->+               case f x y of+                    Just z  -> first (z:) $ updateFirstsBy f eq xs ys'+                    Nothing ->              updateFirstsBy f eq xs ys'++instance Ord k => Map M.Map k where+   eqCmp = const (==)++   empty     = M.empty+   singleton = M.singleton++   null   = M.null+   lookup = M.lookup++   insertWith = M.insertWith'++   update = M.update+   adjust = M.adjust+   delete = M.delete++   alter  = M.alter++   unionWith           = M.unionWith+   differenceWith      = M.differenceWith+   intersectionWith    = M.intersectionWith+   unionWithKey        = M.unionWithKey+   differenceWithKey   = M.differenceWithKey+   intersectionWithKey = M.intersectionWithKey++   map             = M.map+   mapWithKey      = M.mapWithKey+   mapAccum        = M.mapAccum+   mapAccumWithKey = M.mapAccumWithKey++   filter = M.filter++   toList       = M.toList+   fromList     = M.fromList+   fromListWith = M.fromListWith++   isSubmapOfBy = M.isSubmapOfBy++   singletonView m =+      case M.minViewWithKey m of+           Just (a,others) | M.null others -> Just a+           _                               -> Nothing++instance Ord k => OrdMap M.Map k where+   ordCmp = const compare++   toAscList = M.toAscList++   splitLookup = M.splitLookup+   split       = M.split++   minViewWithKey m = maybe (Nothing, m) (first Just) (M.minViewWithKey m)+   maxViewWithKey m = maybe (Nothing, m) (first Just) (M.maxViewWithKey m)++   mapAccumAsc         = M.mapAccum+   mapAccumAscWithKey  = M.mapAccumWithKey+   mapAccumDesc        = mapAccumR+#ifdef TOO_OLD_CONTAINERS+   mapAccumDescWithKey f z =+      second M.fromList . mapAccumR (\a (k,v) -> second ((,) k) $ f a k v) z+                        . M.toAscList+#else+   mapAccumDescWithKey = M.mapAccumRWithKey+#endif++newtype WrappedIntMap k v = IMap (IM.IntMap v) deriving (Eq,Ord)++instance Functor (WrappedIntMap k) where fmap f (IMap m) = IMap (fmap f m)+instance Foldable (WrappedIntMap k) where+    fold        (IMap m) = fold        m+    foldMap f   (IMap m) = foldMap f   m+    foldl   f z (IMap m) = foldl   f z m+    foldl1  f   (IMap m) = foldl1  f   m+    foldr   f z (IMap m) = foldr   f z m+    foldr1  f   (IMap m) = foldr1  f   m++instance Traversable (WrappedIntMap k) where+#ifdef TOO_OLD_CONTAINERS+   traverse  = error "Data.ListTrie.Base.Map :: too old containers, no Traversable IntMap"+   sequenceA = error "Data.ListTrie.Base.Map :: too old containers, no Traversable IntMap"+   mapM      = error "Data.ListTrie.Base.Map :: too old containers, no Traversable IntMap"+   sequence  = error "Data.ListTrie.Base.Map :: too old containers, no Traversable IntMap"+#else+   traverse f (IMap m) = pure IMap <*> traverse f m+   sequenceA (IMap m) = pure IMap <*> sequenceA m+   mapM f (IMap m) = liftM IMap (mapM f m)+   sequence (IMap m) = liftM IMap (sequence m)+#endif++instance Enum k => Map WrappedIntMap k where+   eqCmp = const ((==) `on` fromEnum)++   empty       = IMap IM.empty+   singleton k = IMap . IM.singleton (fromEnum k)++   null     (IMap m) = IM.null m+   lookup k (IMap m) = IM.lookup (fromEnum k) m++   insertWith f k v (IMap m) = IMap$ IM.insertWith f (fromEnum k) v m++   update f k (IMap m) = IMap$ IM.update f (fromEnum k) m+   adjust f k (IMap m) = IMap$ IM.adjust f (fromEnum k) m+   delete   k (IMap m) = IMap$ IM.delete   (fromEnum k) m++   alter  f k (IMap m) = IMap$ IM.alter  f (fromEnum k) m++   unionWith        f (IMap x) (IMap y) = IMap$ IM.unionWith        f x y+   differenceWith   f (IMap x) (IMap y) = IMap$ IM.differenceWith   f x y++#ifdef TOO_OLD_CONTAINERS+   intersectionWith =+      error "Data.ListTrie.Base.Map :: too old containers, Data.IntMap.intersectionWith has restricted type"+#else+   intersectionWith f (IMap x) (IMap y) = IMap$ IM.intersectionWith f x y+#endif++   unionWithKey      f (IMap x) (IMap y) =+      IMap$ IM.unionWithKey (f . toEnum) x y+   differenceWithKey f (IMap x) (IMap y) =+      IMap$ IM.differenceWithKey (f . toEnum) x y++#ifdef TOO_OLD_CONTAINERS+   intersectionWithKey =+      error "Data.ListTrie.Base.Map :: too old containers, Data.IntMap.intersectionWithKey has restricted type"+#else+   intersectionWithKey f (IMap x) (IMap y) =+      IMap$ IM.intersectionWithKey (f . toEnum) x y+#endif++   map             f   (IMap x) = IMap$ IM.map f x+   mapWithKey      f   (IMap x) = IMap$ IM.mapWithKey (f . toEnum) x+   mapAccum        f z (IMap x) = second IMap$ IM.mapAccum f z x+   mapAccumWithKey f z (IMap x) =+      second IMap$ IM.mapAccumWithKey (\a -> f a . toEnum) z x++   filter p (IMap x) = IMap $ IM.filter p x++   toList (IMap m) = Prelude.map (first toEnum) . IM.toList $ m+   fromList        = IMap . IM.fromList       . Prelude.map (first fromEnum)+   fromListWith f  = IMap . IM.fromListWith f . Prelude.map (first fromEnum)++   isSubmapOfBy f (IMap x) (IMap y) = IM.isSubmapOfBy f x y++   singletonView (IMap m) =+      case IM.minViewWithKey m of+           Just (a,others) | IM.null others -> Just (first toEnum a)+           _                                -> Nothing++instance Enum k => OrdMap WrappedIntMap k where+   ordCmp = const (compare `on` fromEnum)++   toAscList (IMap m) = Prelude.map (first toEnum) . IM.toAscList $ m++   splitLookup k (IMap m) =+      (\(a,b,c) -> (IMap a, b, IMap c)) . IM.splitLookup (fromEnum k) $ m++   split k (IMap m) = both IMap . IM.split (fromEnum k) $ m++   minViewWithKey o@(IMap m) =+      maybe (Nothing, o) (Just . first toEnum *** IMap) (IM.minViewWithKey m)+   maxViewWithKey o@(IMap m) =+      maybe (Nothing, o) (Just . first toEnum *** IMap) (IM.maxViewWithKey m)++   mapAccumAsc         f z (IMap m) = second IMap $ IM.mapAccum f z m+   mapAccumAscWithKey  f z (IMap m) =+      second IMap $ IM.mapAccumWithKey (\a k -> f a (toEnum k)) z m++#ifdef TOO_OLD_CONTAINERS+   mapAccumDesc        f z (IMap m) =+      second (IMap . IM.fromList)+         . mapAccumR (\a (k,v) -> second ((,) k) $ f a v) z+         . IM.toAscList $ m+   mapAccumDescWithKey f z (IMap m) =+      second (IMap . IM.fromList)+         . mapAccumR (\a (k,v) -> second ((,) k) $ f a (toEnum k) v) z+         . IM.toAscList $ m+#else+   mapAccumDesc        f z (IMap m) = second IMap $ mapAccumR f z m+   mapAccumDescWithKey f z (IMap m) =+      second IMap $ IM.mapAccumRWithKey (\a k -> f a (toEnum k)) z m+#endif
+ Data/ListTrie/Base/Map/Internal.hs view
@@ -0,0 +1,12 @@+-- File created: 2009-03-06 12:40:42++-- Base.Map plus stuff we don't want to export+module Data.ListTrie.Base.Map.Internal+   (module Data.ListTrie.Base.Map, difference) where++import Data.ListTrie.Base.Map++-- Moved this outside Map because it's an odd one out: union and intersection+-- aren't needed+difference :: Map m k => m k a -> m k b -> m k a+difference = differenceWith (\_ _ -> Nothing)
+ Data/ListTrie/Map.hs view
@@ -0,0 +1,1033 @@+-- File created: 2008-11-11 11:24:30++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances+           , FlexibleContexts, UndecidableInstances #-}++#include "exports.h"++-- | The base implementation of a trie representing a map with list keys,+-- generalized over any type of map from element values to tries.+--+-- Worst-case complexities are given in terms of @n@, @m@, and @k@. @n@ refers+-- to the number of keys in the map and @m@ to their maximum length. @k@ refers+-- to the length of a key given to the function, not any property of the map.+--+-- In addition, the trie's branching factor plays a part in almost every+-- operation, but the complexity depends on the underlying 'Map'. Thus, for+-- instance, 'member' is actually @O(m f(b))@ where @f(b)@ is the complexity of+-- a lookup operation on the 'Map' used. This complexity depends on the+-- underlying operation, which is not part of the specification of the visible+-- function. Thus it could change whilst affecting the complexity only for+-- certain Map types: hence this \"b factor\" is not shown explicitly.+--+-- Disclaimer: the complexities have not been proven.+--+-- Strict versions of functions are provided for those who want to be certain+-- that their 'TrieMap' doesn't contain values consisting of unevaluated+-- thunks. Note, however, that they do not evaluate the whole trie strictly,+-- only the values. And only to one level of depth: for instance, 'alter'' does+-- not 'seq' the value within the 'Maybe', only the 'Maybe' itself. The user+-- should add the strictness in such cases himself, if he so wishes.+--+-- Many functions come in both ordinary and @WithKey@ forms, where the former+-- takes a function of type @a -> b@ and the latter of type @[k] -> a -> b@,+-- where @[k]@ is the key associated with the value @a@. For most of these+-- functions, there is additional overhead involved in keeping track of the+-- key: don't use the latter form of the function unless you need it.+module Data.ListTrie.Map (MAP_EXPORTS) where++import Control.Applicative ((<*>),(<$>))+import Control.Arrow       ((***), second)+import qualified Data.DList as DL+import Data.Either         (partitionEithers)+import Data.Function       (on)+import qualified Data.Foldable as F+import qualified Data.Maybe as Maybe+import Data.Monoid         (Monoid(..))+import Data.Traversable    (Traversable(traverse))+import Prelude hiding      (filter, foldl, foldr, lookup, map, null)+import qualified Prelude++#if __GLASGOW_HASKELL__+import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))+#endif++import qualified Data.ListTrie.Base     as Base+import qualified Data.ListTrie.Base.Map as Map+import Data.ListTrie.Base.Classes (fmap')+import Data.ListTrie.Base.Map     (Map, OrdMap)++#include "docs.h"++-- Invariant: any (Tr Nothing _) has a Just descendant.+--+-- | The data structure itself: a map from keys of type @[k]@ to values of type+-- @v@ implemented as a trie, using @map@ to map keys of type @k@ to sub-tries.+--+-- Regarding the instances:+--+-- - The @Trie@ class is internal, ignore it.+--+-- - The 'Eq' constraint for the 'Ord' instance is misleading: it is needed+--   only because 'Eq' is a superclass of 'Ord'.+--+-- - The 'Foldable' and 'Traversable' instances allow folding over and+--   traversing only the values, not the keys.+--+-- - The 'Monoid' instance defines 'mappend' as 'union' and 'mempty' as+--   'empty'.+data TrieMap map k v = Tr (Maybe v) !(CMap map k v)++type CMap map k v = map k (TrieMap map k v)++instance Map map k => Base.Trie TrieMap Maybe map k where+   mkTrie = Tr+   tParts (Tr v m) = (v,m)++-- Don't use CMap in these instances since Haddock won't expand it+instance (Eq (map k (TrieMap map k a)), Eq a) => Eq (TrieMap map k a) where+   Tr v1 m1 == Tr v2 m2 = v1 == v2 && m1 == m2++-- Eq constraint only needed because of superclassness... sigh+instance (Eq (map k (TrieMap map k a)), OrdMap map k, Ord k, Ord a)+      => Ord (TrieMap map k a)+ where+   compare = compare `on` toAscList++instance Map map k => Monoid (TrieMap map k a) where+   mempty  = empty+   mappend = union+   mconcat = unions++instance Map map k => Functor (TrieMap map k) where+   fmap = map++instance Map map k => F.Foldable (TrieMap map k) where+   foldl = foldl . flip+   foldr = foldr++instance (Map map k, Traversable (map k)) => Traversable (TrieMap map k) where+   traverse f (Tr v m) = Tr <$> traverse f v <*> traverse (traverse f) m++instance (Map map k, Show k, Show a) => Show (TrieMap map k a) where+   showsPrec p s = showParen (p > 10) $+      showString "fromList " . shows (toList s)++instance (Map map k, Read k, Read a) => Read (TrieMap map k a) where+#if __GLASGOW_HASKELL__+   readPrec = parens $ prec 10 $ do+      Ident "fromList" <- lexP+      fmap fromList readPrec+#else+   readsPrec p = readParen (p > 10) $ \r -> do+      ("fromList", list) <- lex r+      (xs, rest) <- readsPrec (p+1) list+      [(fromList xs, rest)]+#endif++-- * Construction++-- | @O(1)@. The empty map.+empty :: Map map k => TrieMap map k a+empty = Base.empty++-- | @O(s)@. The singleton map containing only the given key-value pair.+singleton :: Map map k => [k] -> a -> TrieMap map k a+singleton = Base.singleton++-- * Modification++-- | @O(min(m,s))@. Inserts the key-value pair into the map. If the key is+-- already a member of the map, the given value replaces the old one.+insert :: Map map k => [k] -> a -> TrieMap map k a -> TrieMap map k a+insert = Base.insert++-- | @O(min(m,s))@. Inserts the key-value pair into the map. If the key is+-- already a member of the map, the given value replaces the old one.+insert' :: Map map k => [k] -> a -> TrieMap map k a -> TrieMap map k a+insert' = Base.insert'++-- | @O(min(m,s))@. Inserts the key-value pair into the map. If the key is+-- already a member of the map, the old value is replaced by @f givenValue+-- oldValue@ where @f@ is the given function.+insertWith :: Map map k+           => (a -> a -> a) -> [k] -> a -> TrieMap map k a -> TrieMap map k a+insertWith = Base.insertWith++-- | @O(min(m,s))@. Like 'insertWith', but the new value is reduced to weak+-- head normal form before being placed into the map, whether it is the given+-- value or a result of the combining function.+insertWith' :: Map map k+            => (a -> a -> a) -> [k] -> a -> TrieMap map k a -> TrieMap map k a+insertWith' = Base.insertWith'++-- | @O(min(m,s))@. Removes the key from the map along with its associated+-- value. If the key is not a member of the map, the map is unchanged.+delete :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+delete = Base.delete++-- | @O(min(m,s))@. Adjusts the value at the given key by calling the given+-- function on it. If the key is not a member of the map, the map is unchanged.+adjust :: Map map k => (a -> a) -> [k] -> TrieMap map k a -> TrieMap map k a+adjust = Base.adjust++-- | @O(min(m,s))@. Like 'adjust', but the function is applied strictly.+adjust' :: Map map k => (a -> a) -> [k] -> TrieMap map k a -> TrieMap map k a+adjust' = Base.adjust'++-- | @O(min(m,s))@. Updates the value at the given key: if the given+-- function returns 'Nothing', the value and its associated key are removed; if+-- 'Just'@ a@is returned, the old value is replaced with @a@. If the key is+-- not a member of the map, the map is unchanged.+update :: Map map k+       => (a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+update f k = snd . updateLookup f k++-- | @O(min(m,s))@. Like 'update', but also returns 'Just' the original value,+-- or 'Nothing' if the key is not a member of the map.+updateLookup :: Map map k => (a -> Maybe a)+                          -> [k]+                          -> TrieMap map k a+                          -> (Maybe a, TrieMap map k a)+updateLookup = Base.updateLookup++-- | @O(min(m,s))@. The most general modification function, allowing you to+-- modify the value at the given key, whether or not it is a member of the map.+-- In short: the given function is passed 'Just' the value at the key if it is+-- present, or 'Nothing' otherwise; if the function returns 'Just' a value, the+-- new value is inserted into the map, otherwise the old value is removed. More+-- precisely, for @alter f k m@:+--+-- If @k@ is a member of @m@, @f (@'Just'@ oldValue)@ is called. Now:+--+-- - If @f@ returned 'Just'@ newValue@, @oldValue@ is replaced with @newValue@.+--+-- - If @f@ returned 'Nothing', @k@ and @oldValue@ are removed from the map.+--+-- If, instead, @k@ is not a member of @m@, @f @'Nothing' is called, and:+--+-- - If @f@ returned 'Just'@ value@, @value@ is inserted into the map, at @k@.+--+-- - If @f@ returned 'Nothing', the map is unchanged.+--+-- The function is applied lazily only if the given key is a prefix of another+-- key in the map.+alter :: Map map k+      => (Maybe a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+alter = Base.alter++-- | @O(min(m,s))@. Like 'alter', but the function is always applied strictly.+alter' :: Map map k+       => (Maybe a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+alter' = Base.alter'++-- * Querying++-- | @O(1)@. 'True' iff the map is empty.+null :: Map map k => TrieMap map k a -> Bool+null = Base.null++-- | @O(n m)@. The number of elements in the map. The value is built up lazily,+-- allowing for delivery of partial results without traversing the whole map.+size :: (Map map k, Num n) => TrieMap map k a -> n+size = Base.size++-- | @O(n m)@. The number of elements in the map. The value is built strictly:+-- no value is returned until the map has been fully traversed.+size' :: (Map map k, Num n) => TrieMap map k a -> n+size' = Base.size'++-- | @O(min(m,s))@. 'True' iff the given key is associated with a value in the+-- map.+member :: Map map k => [k] -> TrieMap map k a -> Bool+member = Base.member++-- | @O(min(m,s))@. 'False' iff the given key is associated with a value in the+-- map.+notMember :: Map map k => [k] -> TrieMap map k a -> Bool+notMember = Base.notMember++-- | @O(min(m,s))@. 'Just' the value in the map associated with the given key,+-- or 'Nothing' if the key is not a member of the map.+lookup :: Map map k => [k] -> TrieMap map k a -> Maybe a+lookup = Base.lookup++-- | @O(min(m,s))@. Like 'lookup', but returns the given value when the key is+-- not a member of the map.+lookupWithDefault :: Map map k => a -> [k] -> TrieMap map k a -> a+lookupWithDefault = Base.lookupWithDefault++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first map is a submap of the second,+-- i.e. all keys that are members of the first map are also members of the+-- second map, and their associated values are the same.+--+-- > isSubmapOf = isSubmapOfBy (==)+isSubmapOf :: (Map map k, Eq a) => TrieMap map k a -> TrieMap map k a -> Bool+isSubmapOf = isSubmapOfBy (==)++-- | @O(min(n1 m1,n2 m2))@. Like 'isSubmapOf', but one can specify the equality+-- relation applied to the values.+--+-- 'True' iff all keys that are members of the first map are also members of+-- the second map, and the given function @f@ returns 'True' for all @f+-- firstMapValue secondMapValue@ where @firstMapValue@ and @secondMapValue@ are+-- associated with the same key.+isSubmapOfBy :: Map map k+             => (a -> b -> Bool) -> TrieMap map k a -> TrieMap map k b -> Bool+isSubmapOfBy = Base.isSubmapOfBy++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first map is a proper submap of the+-- second, i.e. all keys that are members of the first map are also members of+-- the second map, and their associated values are the same, but the maps are+-- not equal. That is, at least one key was a member of the second map but not+-- the first.+--+-- > isProperSubmapOf = isProperSubmapOfBy (==)+isProperSubmapOf :: (Map map k, Eq a)+                 => TrieMap map k a -> TrieMap map k a -> Bool+isProperSubmapOf = isProperSubmapOfBy (==)++-- | @O(min(n1 m1,n2 m2))@. Like 'isProperSubmapOf', but one can specify the+-- equality relation applied to the values.+--+-- 'True' iff all keys that are members of the first map are also members of+-- the second map, and the given function @f@ returns 'True' for all @f+-- firstMapValue secondMapValue@ where @firstMapValue@ and @secondMapValue@ are+-- associated with the same key, and at least one key in the second map is not+-- a member of the first.+isProperSubmapOfBy :: Map map k => (a -> b -> Bool)+                                -> TrieMap map k a+                                -> TrieMap map k b+                                -> Bool+isProperSubmapOfBy = Base.isProperSubmapOfBy++-- * Combination++defaultUnion :: a -> a -> a+defaultUnion = const++-- | @O(min(n1 m1,n2 m2))@. The union of the two maps: the map which contains+-- all keys that are members of either map. This union is left-biased: if a key+-- is a member of both maps, the value from the first map is chosen.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > union = unionWith const+union :: Map map k => TrieMap map k a -> TrieMap map k a -> TrieMap map k a+union = unionWith defaultUnion++-- | @O(min(n1 m1,n2 m2))@. Like 'union', but the combining function ('const') is+-- applied strictly.+--+-- > union' = unionWith' const+union' :: Map map k => TrieMap map k a -> TrieMap map k a -> TrieMap map k a+union' = unionWith' defaultUnion++-- | @O(min(n1 m1,n2 m2))@. Like 'union', but the given function is used to+-- determine the new value if a key is a member of both given maps. For a+-- function @f@, the new value is @f firstMapValue secondMapValue@.+unionWith :: Map map k => (a -> a -> a)+                       -> TrieMap map k a+                       -> TrieMap map k a+                       -> TrieMap map k a+unionWith = Base.unionWith++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWith', but the combining function is+-- applied strictly.+unionWith' :: Map map k => (a -> a -> a)+                        -> TrieMap map k a+                        -> TrieMap map k a+                        -> TrieMap map k a+unionWith' = Base.unionWith'++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWith', but in addition to the two+-- values, the key is passed to the combining function.+unionWithKey :: Map map k => ([k] -> a -> a -> a)+                          -> TrieMap map k a+                          -> TrieMap map k a+                          -> TrieMap map k a+unionWithKey = Base.unionWithKey++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWithKey', but the combining function is+-- applied strictly.+unionWithKey' :: Map map k => ([k] -> a -> a -> a)+                           -> TrieMap map k a+                           -> TrieMap map k a+                           -> TrieMap map k a+unionWithKey' = Base.unionWithKey'++-- | @O(sum(n))@. The union of all the maps: the map which contains all keys+-- that are members of any of the maps. If a key is a member of multiple maps,+-- the value that occurs in the earliest of the maps (according to the order of+-- the given list) is chosen.+--+-- The worst-case performance occurs when all the maps are identical.+--+-- > unions = unionsWith const+unions :: Map map k => [TrieMap map k a] -> TrieMap map k a+unions = unionsWith defaultUnion++-- | @O(sum(n))@. Like 'unions', but the combining function ('const') is+-- applied strictly.+--+-- > unions' = unionsWith' const+unions' :: Map map k => [TrieMap map k a] -> TrieMap map k a+unions' = unionsWith' defaultUnion++-- | @O(sum(n))@. Like 'unions', but the given function determines the final+-- value if a key is a member of more than one map. The function is applied as+-- a left fold over the values in the given list's order. For example:+--+-- > unionsWith (-) [fromList [("a",1)],fromList [("a",2)],fromList [("a",3)]]+-- >    == fromList [("a",(1-2)-3)]+-- >    == fromList [("a",-4)]+unionsWith :: Map map k+           => (a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWith = Base.unionsWith++-- | @O(sum(n))@. Like 'unionsWith', but the combining function is applied+-- strictly.+unionsWith' :: Map map k+            => (a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWith' = Base.unionsWith'++-- | @O(sum(n))@. Like 'unionsWith', but in addition to the two values under+-- consideration, the key is passed to the combining function.+unionsWithKey :: Map map k+              => ([k] -> a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWithKey = Base.unionsWithKey++-- | @O(sum(n))@. Like 'unionsWithKey', but the combining function is applied+-- strictly.+unionsWithKey' :: Map map k+               => ([k] -> a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWithKey' = Base.unionsWithKey'++-- | @O(min(n1 m1,n2 m2))@. The difference of the two maps: the map which+-- contains all keys that are members of the first map and not of the second.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > difference = differenceWith (\_ _ -> Nothing)+difference :: Map map k+           => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+difference = differenceWith (\_ _ -> Nothing)++-- | @O(min(n1 m1,n2 m2))@. Like 'difference', but the given function+-- determines what to do when a key is a member of both maps. If the function+-- returns 'Nothing', the key is removed; if it returns 'Just' a new value,+-- that value replaces the old one in the first map.+differenceWith :: Map map k => (a -> b -> Maybe a)+                            -> TrieMap map k a+                            -> TrieMap map k b+                            -> TrieMap map k a+differenceWith = Base.differenceWith++-- | @O(min(n1 m1,n2 m2))@. Like 'differenceWith', but in addition to the two+-- values, the key they are associated with is passed to the combining+-- function.+differenceWithKey :: Map map k => ([k] -> a -> b -> Maybe a)+                               -> TrieMap map k a+                               -> TrieMap map k b+                               -> TrieMap map k a+differenceWithKey = Base.differenceWithKey++-- | @O(min(n1 m1,n2 m2))@. The intersection of the two maps: the map which+-- contains all keys that are members of both maps.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > intersection = intersectionWith const+intersection :: Map map k+             => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+intersection = intersectionWith const++-- | @O(min(n1 m1,n2 m2))@. Like 'intersection', but the combining function is+-- applied strictly.+--+-- > intersection' = intersectionWith' const+intersection' :: Map map k+              => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+intersection' = intersectionWith' const++-- | @O(min(n1 m1,n2 m2))@. Like 'intersection', but the given function+-- determines the new values.+intersectionWith :: Map map k => (a -> b -> c)+                              -> TrieMap map k a+                              -> TrieMap map k b+                              -> TrieMap map k c+intersectionWith = Base.intersectionWith++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWith', but the combining function+-- is applied strictly.+intersectionWith' :: Map map k => (a -> b -> c)+                               -> TrieMap map k a+                               -> TrieMap map k b+                               -> TrieMap map k c+intersectionWith' = Base.intersectionWith'++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWith', but in addition to the two+-- values, the key they are associated with is passed to the combining+-- function.+intersectionWithKey :: Map map k => ([k] -> a -> b -> c)+                                 -> TrieMap map k a+                                 -> TrieMap map k b+                                 -> TrieMap map k c+intersectionWithKey = Base.intersectionWithKey++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWithKey', but the combining+-- function is applied strictly.+intersectionWithKey' :: Map map k => ([k] -> a -> b -> c)+                                  -> TrieMap map k a+                                  -> TrieMap map k b+                                  -> TrieMap map k c+intersectionWithKey' = Base.intersectionWithKey'++-- * Filtering++-- | @O(n m)@. Apply the given function to the elements in the map, discarding+-- those for which the function returns 'False'.+filter :: Map map k => (a -> Bool) -> TrieMap map k a -> TrieMap map k a+filter = filterWithKey . const++-- | @O(n m)@. Like 'filter', but the key associated with the element is also+-- passed to the given predicate.+filterWithKey :: Map map k+              => ([k] -> a -> Bool) -> TrieMap map k a -> TrieMap map k a+filterWithKey = Base.filterWithKey++-- | @O(n m)@. A pair of maps: the first element contains those values for+-- which the given predicate returns 'True', and the second contains those for+-- which it was 'False'.+partition :: Map map k => (a -> Bool)+                       -> TrieMap map k a+                       -> (TrieMap map k a, TrieMap map k a)+partition = partitionWithKey . const++-- | @O(n m)@. Like 'partition', but the key associated with the element is+-- also passed to the given predicate.+partitionWithKey :: Map map k => ([k] -> a -> Bool)+                              -> TrieMap map k a+                              -> (TrieMap map k a, TrieMap map k a)+partitionWithKey = Base.partitionWithKey++-- | @O(n m)@. Apply the given function to the elements in the map, preserving+-- only the 'Just' results.+mapMaybe :: Map map k+         => (a -> Maybe b) -> TrieMap map k a -> TrieMap map k b+mapMaybe = mapMaybeWithKey . const++-- | @O(n m)@. Like 'mapMaybe', but the key associated with the element is also+-- passed to the given function.+mapMaybeWithKey :: Map map k+                => ([k] -> a -> Maybe b) -> TrieMap map k a -> TrieMap map k b+mapMaybeWithKey f =+   fromList . Maybe.mapMaybe (\(k,v) -> fmap ((,) k) (f k v)) . toList++-- | @O(n m)@. Apply the given function to the elements in the map, separating+-- the 'Left' results from the 'Right'. The first element of the pair contains+-- the former results, and the second the latter.+mapEither :: Map map k => (a -> Either b c)+                       -> TrieMap map k a+                       -> (TrieMap map k b, TrieMap map k c)+mapEither = mapEitherWithKey . const++-- | @O(n m)@. Like 'mapEither', but the key associated with the element is+-- also passed to the given function.+mapEitherWithKey :: Map map k => ([k] -> a -> Either b c)+                              -> TrieMap map k a+                              -> (TrieMap map k b, TrieMap map k c)+mapEitherWithKey f =+   (fromList *** fromList) . partitionEithers .+   Prelude.map (\(k,v) -> either (Left . (,) k) (Right . (,) k) (f k v)) .+   toList++-- * Mapping++-- | @O(n m)@. Apply the given function to all the elements in the map.+map :: Map map k => (a -> b) -> TrieMap map k a -> TrieMap map k b+map = genericMap fmap++-- | @O(n m)@. Like 'map', but apply the function strictly.+map' :: Map map k => (a -> b) -> TrieMap map k a -> TrieMap map k b+map' = genericMap fmap'++genericMap :: Map map k => ((a -> b) -> Maybe a -> Maybe b)+                        -> (a -> b) -> TrieMap map k a -> TrieMap map k b+genericMap myFmap f (Tr v m) = Tr (myFmap f v)+                                  (Map.map (genericMap myFmap f) m)++-- | @O(n m)@. Like 'map', but also pass the key associated with the element to+-- the given function.+mapWithKey :: Map map k+           => ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+mapWithKey = genericMapWithKey fmap++-- | @O(n m)@. Like 'mapWithKey', but apply the function strictly.+mapWithKey' :: Map map k+            => ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+mapWithKey' = genericMapWithKey fmap'++genericMapWithKey :: Map map k+                  => ((a -> b) -> Maybe a -> Maybe b)+                  -> ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+genericMapWithKey = go DL.empty+ where+   go k myFmap f (Tr v m) =+      Tr (myFmap (f $ DL.toList k) v)+         (Map.mapWithKey (\x -> go (k `DL.snoc` x) myFmap f) m)++-- | @O(n m)@. Apply the given function to all the keys in a map.+--+-- > mapKeys = mapKeysWith const+mapKeys :: (Map map k1, Map map k2)+        => ([k1] -> [k2]) -> TrieMap map k1 a -> TrieMap map k2 a+mapKeys = mapKeysWith const++-- | @O(n m)@. Like 'mapKeys', but use the first given function to combine+-- elements if the second function gives two keys the same value.+mapKeysWith :: (Map map k1, Map map k2) => (a -> a -> a)+                                        -> ([k1] -> [k2])+                                        -> TrieMap map k1 a+                                        -> TrieMap map k2 a+mapKeysWith = Base.mapKeysWith . fromListWith++-- | @O(n m)@. Apply the given function to the contents of all the keys in the+-- map.+--+-- > mapInKeys = mapInKeysWith const+mapInKeys :: (Map map k1, Map map k2)+          => (k1 -> k2) -> TrieMap map k1 a -> TrieMap map k2 a+mapInKeys = mapInKeysWith defaultUnion++-- | @O(n m)@. Like 'mapInKeys', but combine identical keys strictly.+--+-- > mapInKeys' = mapInKeysWith' const+mapInKeys' :: (Map map k1, Map map k2)+           => (k1 -> k2) -> TrieMap map k1 a -> TrieMap map k2 a+mapInKeys' = mapInKeysWith' defaultUnion++-- | @O(n m)@. Like 'mapInKeys', but use the first given function to combine+-- elements if the second function gives two keys the same value.+mapInKeysWith :: (Map map k1, Map map k2) => (a -> a -> a)+                                          -> (k1 -> k2)+                                          -> TrieMap map k1 a+                                          -> TrieMap map k2 a+mapInKeysWith = Base.mapInKeysWith++-- | @O(n m)@. Like 'mapInKeysWith', but apply the combining function strictly.+mapInKeysWith' :: (Map map k1, Map map k2) => (a -> a -> a)+                                           -> (k1 -> k2)+                                           -> TrieMap map k1 a+                                           -> TrieMap map k2 a+mapInKeysWith' = Base.mapInKeysWith'++-- | @O(n m)@. Like "Data.List".@mapAccumL@ on the 'toList' representation.+--+-- Essentially a combination of 'map' and 'foldl': the given+-- function is applied to each element of the map, resulting in a new value for+-- the accumulator and a replacement element for the map.+mapAccum :: Map map k => (acc -> a -> (acc, b))+                      -> acc+                      -> TrieMap map k a+                      -> (acc, TrieMap map k b)+mapAccum = genericMapAccum Map.mapAccum (flip const)++-- | @O(n m)@. Like 'mapAccum', but the function is applied strictly.+mapAccum' :: Map map k => (acc -> a -> (acc, b))+                       -> acc+                       -> TrieMap map k a+                       -> (acc, TrieMap map k b)+mapAccum' = genericMapAccum Map.mapAccum seq++-- | @O(n m)@. Like 'mapAccum', but the function receives the key in addition+-- to the value associated with it.+mapAccumWithKey :: Map map k => (acc -> [k] -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumWithKey = genericMapAccumWithKey Map.mapAccumWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumWithKey', but the function is applied strictly.+mapAccumWithKey' :: Map map k => (acc -> [k] -> a -> (acc, b))+                              -> acc+                              -> TrieMap map k a+                              -> (acc, TrieMap map k b)+mapAccumWithKey' = genericMapAccumWithKey Map.mapAccumWithKey seq++-- | @O(n m)@. Like 'mapAccum', but in ascending order, as though operating on+-- the 'toAscList' representation.+mapAccumAsc :: OrdMap map k => (acc -> a -> (acc, b))+                            -> acc+                            -> TrieMap map k a+                            -> (acc, TrieMap map k b)+mapAccumAsc = genericMapAccum Map.mapAccumAsc (flip const)++-- | @O(n m)@. Like 'mapAccumAsc', but the function is applied strictly.+mapAccumAsc' :: OrdMap map k => (acc -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumAsc' = genericMapAccum Map.mapAccumAsc seq++-- | @O(n m)@. Like 'mapAccumAsc', but the function receives the key in+-- addition to the value associated with it.+mapAccumAscWithKey :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                   -> acc+                                   -> TrieMap map k a+                                   -> (acc, TrieMap map k b)+mapAccumAscWithKey = genericMapAccumWithKey Map.mapAccumAscWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumAscWithKey', but the function is applied strictly.+mapAccumAscWithKey' :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                    -> acc+                                    -> TrieMap map k a+                                    -> (acc, TrieMap map k b)+mapAccumAscWithKey' = genericMapAccumWithKey Map.mapAccumAscWithKey seq++-- | @O(n m)@. Like 'mapAccum', but in descending order, as though operating on+-- the 'toDescList' representation.+mapAccumDesc :: OrdMap map k => (acc -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumDesc = genericMapAccum Map.mapAccumDesc (flip const)++-- | @O(n m)@. Like 'mapAccumDesc', but the function is applied strictly.+mapAccumDesc' :: OrdMap map k => (acc -> a -> (acc, b))+                              -> acc+                              -> TrieMap map k a+                              -> (acc, TrieMap map k b)+mapAccumDesc' = genericMapAccum Map.mapAccumDesc seq++-- | @O(n m)@. Like 'mapAccumDesc', but the function receives the key in+-- addition to the value associated with it.+mapAccumDescWithKey :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                    -> acc+                                    -> TrieMap map k a+                                    -> (acc, TrieMap map k b)+mapAccumDescWithKey =+   genericMapAccumWithKey Map.mapAccumDescWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumDescWithKey', but the function is applied+-- strictly.+mapAccumDescWithKey' :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                     -> acc+                                     -> TrieMap map k a+                                     -> (acc, TrieMap map k b)+mapAccumDescWithKey' = genericMapAccumWithKey Map.mapAccumDescWithKey seq++genericMapAccum :: Map map k+                => (  (acc -> TrieMap map k a -> (acc, TrieMap map k b))+                   -> acc+                   -> CMap map k a+                   -> (acc, CMap map k b)+                   )+                -> (b -> (acc, Maybe b) -> (acc, Maybe b))+                -> (acc -> a -> (acc, b))+                -> acc+                -> TrieMap map k a+                -> (acc, TrieMap map k b)+genericMapAccum subMapAccum seeq f acc (Tr mv m) =+   let (acc', mv') =+          case mv of+               Nothing -> (acc, Nothing)+               Just v  ->+                  let (acc'', v') = f acc v+                   in v' `seeq` (acc'', Just v')+    in second (Tr mv') $+          subMapAccum (genericMapAccum subMapAccum seeq f) acc' m++genericMapAccumWithKey :: Map map k+                       => (  (  acc+                             -> k+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+                             )+                          -> acc+                          -> CMap map k a+                          -> (acc, CMap map k b)+                          )+                       -> (b -> (acc, Maybe b) -> (acc, Maybe b))+                       -> (acc -> [k] -> a -> (acc, b))+                       -> acc+                       -> TrieMap map k a+                       -> (acc, TrieMap map k b)+genericMapAccumWithKey = go DL.empty+ where+   go k subMapAccum seeq f acc (Tr mv m) =+      let (acc', mv') =+             case mv of+                  Nothing -> (acc, Nothing)+                  Just v  ->+                     let (acc'', v') = f acc (DL.toList k) v+                      in v' `seeq` (acc'', Just v')+       in second (Tr mv') $+             subMapAccum (\a x -> go (k `DL.snoc` x) subMapAccum seeq f a)+                         acc' m++-- * Folding++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation,+-- folding only over the elements.+foldr :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldr = foldrWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation,+-- folding over both the keys and the elements.+foldrWithKey :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrWithKey = Base.foldrWithKey++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation.+foldrAsc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldrAsc = foldrAscWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation,+-- folding over both the keys and the elements.+foldrAscWithKey :: OrdMap map k+                => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrAscWithKey = Base.foldrAscWithKey++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation.+foldrDesc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldrDesc = foldrDescWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation,+-- folding over both the keys and the elements.+foldrDescWithKey :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrDescWithKey = Base.foldrDescWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toList representation.+foldl :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldl = foldlWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toList representation,+-- folding over both the keys and the elements.+foldlWithKey :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlWithKey = Base.foldlWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toAscList representation.+foldlAsc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlAsc = foldlAscWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toAscList representation,+-- folding over both the keys and the elements.+foldlAscWithKey :: OrdMap map k+                => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlAscWithKey = Base.foldlAscWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toDescList representation.+foldlDesc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlDesc = foldlDescWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toDescList representation,+-- folding over both the keys and the elements.+foldlDescWithKey :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlDescWithKey = Base.foldlDescWithKey++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation.+foldl' :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldl' = foldlWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation,+-- folding over both the keys and the elements.+foldlWithKey' :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlWithKey' = Base.foldlWithKey'++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation.+foldlAsc' :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlAsc' = foldlAscWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation,+-- folding over both the keys and the elements.+foldlAscWithKey' :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlAscWithKey' = Base.foldlAscWithKey'++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation.+foldlDesc' :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlDesc' = foldlDescWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation, folding over both the keys and the elements.+foldlDescWithKey' :: OrdMap map k+                  => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlDescWithKey' = Base.foldlDescWithKey'++-- * Conversion between lists++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in undefined order.+toList :: Map map k => TrieMap map k a -> [([k],a)]+toList = Base.toList++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in ascending order.+toAscList :: OrdMap map k => TrieMap map k a -> [([k],a)]+toAscList = Base.toAscList++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in descending order.+toDescList :: OrdMap map k => TrieMap map k a -> [([k],a)]+toDescList = Base.toDescList++-- | @O(n m)@. Creates a map from a list of key-value pairs. If a key occurs+-- more than once, the value from the last pair (according to the list's order)+-- is the one which ends up in the map.+--+-- > fromList = fromListWith const+fromList :: Map map k => [([k],a)] -> TrieMap map k a+fromList = Base.fromList++-- | @O(n m)@. Like 'fromList', but the given function is used to determine the+-- final value if a key occurs more than once. The function is applied as+-- though it were flipped and then applied as a left fold over the values in+-- the given list's order. Or, equivalently (except as far as performance is+-- concerned), as though the function were applied as a right fold over the+-- values in the reverse of the given list's order. For example:+--+-- > fromListWith (-) [("a",1),("a",2),("a",3),("a",4)]+-- >    == fromList [("a",4-(3-(2-1)))]+-- >    == fromList [("a",2)]+fromListWith :: Map map k => (a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWith = Base.fromListWith++-- | @O(n m)@. Like 'fromListWith', but the combining function is applied+-- strictly.+fromListWith' :: Map map k => (a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWith' = Base.fromListWith'++-- | @O(n m)@. Like 'fromListWith', but the key, in addition to the values to+-- be combined, is passed to the combining function.+fromListWithKey :: Map map k+                => ([k] -> a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWithKey = Base.fromListWithKey++-- | @O(n m)@. Like 'fromListWithKey', but the combining function is applied+-- strictly.+fromListWithKey' :: Map map k+                 => ([k] -> a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWithKey' = Base.fromListWithKey'++-- * Ordering ops++-- | @O(m)@. Removes and returns the minimal key in the map, along with the+-- value associated with it. If the map is empty, 'Nothing' and the original+-- map are returned.+minView :: OrdMap map k => TrieMap map k a -> (Maybe ([k], a), TrieMap map k a)+minView = Base.minView++-- | @O(m)@. Removes and returns the maximal key in the map, along with the+-- value associated with it. If the map is empty, 'Nothing' and the original+-- map are returned.+maxView :: OrdMap map k => TrieMap map k a -> (Maybe ([k], a), TrieMap map k a)+maxView = Base.maxView++-- | @O(m)@. Like 'fst' composed with 'minView'. 'Just' the minimal key in the+-- map and its associated value, or 'Nothing' if the map is empty.+findMin :: OrdMap map k => TrieMap map k a -> Maybe ([k], a)+findMin = Base.findMin++-- | @O(m)@. Like 'fst' composed with 'maxView'. 'Just' the minimal key in the+-- map and its associated value, or 'Nothing' if the map is empty.+findMax :: OrdMap map k => TrieMap map k a -> Maybe ([k], a)+findMax = Base.findMax++-- | @O(m)@. Like 'snd' composed with 'minView'. The map without its minimal+-- key, or the unchanged original map if it was empty.+deleteMin :: OrdMap map k => TrieMap map k a -> TrieMap map k a+deleteMin = Base.deleteMin++-- | @O(m)@. Like 'snd' composed with 'maxView'. The map without its maximal+-- key, or the unchanged original map if it was empty.+deleteMax :: OrdMap map k => TrieMap map k a -> TrieMap map k a+deleteMax = Base.deleteMax++-- | @O(min(m,s))@. Splits the map in two about the given key. The first+-- element of the resulting pair is a map containing the keys lesser than the+-- given key; the second contains those keys that are greater.+split :: OrdMap map k+      => [k] -> TrieMap map k a -> (TrieMap map k a, TrieMap map k a)+split = Base.split++-- | @O(min(m,s))@. Like 'split', but also returns the value associated with+-- the given key, if any.+splitLookup :: OrdMap map k => [k]+                            -> TrieMap map k a+                            -> (TrieMap map k a, Maybe a, TrieMap map k a)+splitLookup = Base.splitLookup++-- | @O(m)@. 'Just' the key of the map which precedes the given key in order,+-- along with its associated value, or 'Nothing' if the map is empty.+findPredecessor :: OrdMap map k => [k] -> TrieMap map k a -> Maybe ([k], a)+findPredecessor = Base.findPredecessor++-- | @O(m)@. 'Just' the key of the map which succeeds the given key in order,+-- along with its associated value, or 'Nothing' if the map is empty.+findSuccessor :: OrdMap map k => [k] -> TrieMap map k a -> Maybe ([k], a)+findSuccessor = Base.findSuccessor++-- * Trie-only operations++-- | @O(s)@. Prepends the given key to all the keys of the map. For example:+--+-- > addPrefix "xa" (fromList [("a",1),("b",2)])+-- >    == fromList [("xaa",1),("xab",2)]+addPrefix :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+addPrefix = Base.addPrefix++-- | @O(m)@. The map which contains all keys of which the given key is a+-- prefix, with the prefix removed from each key. If the given key is not a+-- prefix of any key in the map, the map is returned unchanged. For example:+--+-- > deletePrefix "a" (fromList [("a",1),("ab",2),("ac",3)])+-- >    == fromList [("",1),("b",2),("c",3)]+--+-- This function can be used, for instance, to reduce potentially expensive I/O+-- operations: if you need to find the value in a map associated with a string,+-- but you only have a prefix of it and retrieving the rest is an expensive+-- operation, calling 'deletePrefix' with what you have might allow you to+-- avoid the operation: if the resulting map is empty, the entire string cannot+-- be a member of the map.+deletePrefix :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+deletePrefix = Base.deletePrefix++-- | @O(m)@. A triple containing the longest common prefix of all keys in the+-- map, the value associated with that prefix, if any, and the map with that+-- prefix removed from all the keys as well as the map itself. Examples:+--+-- > splitPrefix (fromList [("a",1),("b",2)])+-- >    == ("", Nothing, fromList [("a",1),("b",2)])+-- > splitPrefix (fromList [("a",1),("ab",2),("ac",3)])+-- >    == ("a", Just 1, fromList [("b",2),("c",3)])+splitPrefix :: Map map k => TrieMap map k a -> ([k], Maybe a, TrieMap map k a)+splitPrefix = Base.splitPrefix++-- | @O(m)@. The children of the longest common prefix in the trie as maps,+-- associated with their distinguishing key value. If the map contains less+-- than two keys, this function will return the empty list. Examples;+--+-- > children (fromList [("a",1),("abc",2),("abcd",3)])+-- >    == [('b',fromList [("c",2),("cd",3)])]+-- > children (fromList [("b",1),("c",2)])+-- >    == [('b',fromList [("",1)]),('c',fromList [("",2)])]+children :: Map map k => TrieMap map k a -> [(k, TrieMap map k a)]+children = Base.children++-- * Visualization++-- | @O(n m)@. Displays the map's internal structure in an undefined way. That+-- is to say, no program should depend on the function's results.+showTrie :: (Show k, Show a, Map map k) => TrieMap map k a -> ShowS+showTrie = Base.showTrieWith $ \mv -> case mv of+                                           Nothing -> showChar ' '+                                           Just v  -> showsPrec 11 v++-- | @O(n m)@. Like 'showTrie', but uses the given function to display the+-- elements of the map. Still undefined.+showTrieWith :: (Show k, Map map k)+             => (Maybe a -> ShowS) -> TrieMap map k a -> ShowS+showTrieWith = Base.showTrieWith
+ Data/ListTrie/Map/Enum.hs view
@@ -0,0 +1,15 @@+-- File created: 2009-01-06 13:47:08++-- | A map from lists of enumerable elements to arbitrary values, based on a+-- trie.+--+-- Note that those operations which require an ordering, such as 'toAscList',+-- do not compare the elements themselves, but rather their Int representation+-- after 'fromEnum'.+module Data.ListTrie.Map.Enum (TrieMap, module Data.ListTrie.Map) where++import Data.ListTrie.Base.Map   (WrappedIntMap)+import Data.ListTrie.Map hiding (TrieMap)+import qualified Data.ListTrie.Map as Base++type TrieMap = Base.TrieMap WrappedIntMap
+ Data/ListTrie/Map/Eq.hs view
@@ -0,0 +1,11 @@+-- File created: 2009-01-06 13:26:25++-- | A map from lists of elements that can be compared for equality to+-- arbitrary values, based on a trie.+module Data.ListTrie.Map.Eq (TrieMap, module Data.ListTrie.Map) where++import Data.ListTrie.Base.Map   (AList)+import Data.ListTrie.Map hiding (TrieMap)+import qualified Data.ListTrie.Map as Base++type TrieMap = Base.TrieMap AList
+ Data/ListTrie/Map/Ord.hs view
@@ -0,0 +1,11 @@+-- File created: 2009-01-06 13:18:32++-- | A map from lists of elements that can be totally ordered to arbitrary+-- values, based on a trie.+module Data.ListTrie.Map.Ord (TrieMap, module Data.ListTrie.Map) where++import Data.Map                 (Map)+import Data.ListTrie.Map hiding (TrieMap)+import qualified Data.ListTrie.Map as Base++type TrieMap = Base.TrieMap Map
+ Data/ListTrie/Patricia/Base.hs view
@@ -0,0 +1,1401 @@+-- File created: 2008-12-28 17:20:14++{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies+           , FlexibleContexts, ScopedTypeVariables #-}++module Data.ListTrie.Patricia.Base+   ( Trie(..)+   , null, size, size', member, notMember, lookup, lookupWithDefault+   , isSubmapOfBy, isProperSubmapOfBy+   , empty, singleton+   , insert, insert', insertWith, insertWith'+   , delete, adjust, adjust', updateLookup, alter, alter'+   , unionWith, unionWithKey, unionWith', unionWithKey'+   , unionsWith, unionsWithKey, unionsWith', unionsWithKey'+   , differenceWith, differenceWithKey+   , intersectionWith,  intersectionWithKey+   , intersectionWith', intersectionWithKey'+   , filterWithKey, partitionWithKey+   , split, splitLookup+   , mapKeysWith, mapInKeysWith, mapInKeysWith'+   , foldrWithKey,  foldrAscWithKey,  foldrDescWithKey+   , foldlWithKey,  foldlAscWithKey,  foldlDescWithKey+   , foldlWithKey', foldlAscWithKey', foldlDescWithKey'+   , toList, toAscList, toDescList+   , fromList, fromListWith, fromListWith', fromListWithKey, fromListWithKey'+   , findMin, findMax, deleteMin, deleteMax, minView, maxView+   , findPredecessor, findSuccessor+   , addPrefix, splitPrefix, deletePrefix, children+   , showTrieWith+   , eqComparePrefixes, ordComparePrefixes+   ) where++import Control.Applicative (Applicative(..), (<$>))+import Control.Arrow       ((***), first)+import Control.Exception   (assert)+import qualified Data.DList as DL+import Data.DList          (DList)+import Data.Foldable       (foldr, foldl')+import Data.List           (foldl1', partition)+import Data.Maybe          (fromJust, isJust)+import Prelude hiding      (lookup, filter, foldr, null)+import qualified Prelude++import qualified Data.ListTrie.Base.Map.Internal as Map+import Data.ListTrie.Base.Classes+   ( Boolable(..)+   , Unwrappable(..)+   , Unionable(..), Differentiable(..), Intersectable(..)+   , Alt(..)+   , fmap', (<$!>)+   )+import Data.ListTrie.Base.Map (Map, OrdMap)+import Data.ListTrie.Util     ((.:), both)++class (Map map k, Functor st, Unwrappable st)+   => Trie trie st map k | trie -> st where++   mkTrie :: st a -> [k] -> CMap trie map k a -> trie map k a+   tParts :: trie map k a -> (st a, [k], CMap trie map k a)++type CMap trie map k v = map k (trie map k v)++hasValue, noValue :: Boolable b => b -> Bool+hasValue = toBool+noValue  = not . hasValue++tVal :: Trie trie st map k => trie map k a -> st a+tVal = (\(a,_,_) -> a) . tParts++tMap :: Trie trie st map k => trie map k a -> CMap trie map k a+tMap = (\(_,_,c) -> c) . tParts++-----------------------++-- * Construction++-- O(1)+empty :: (Alt st a, Trie trie st map k) => trie map k a+empty = mkTrie altEmpty [] Map.empty++-- O(1)+singleton :: (Alt st a, Trie trie st map k) => [k] -> a -> trie map k a+singleton k v = mkTrie (pure v) k Map.empty++-- O(min(m,s))+insert :: (Alt st a, Boolable (st a), Trie trie st map k)+       => [k] -> a -> trie map k a -> trie map k a+insert = insertWith const++-- O(min(m,s))+insert' :: (Alt st a, Boolable (st a), Trie trie st map k)+        => [k] -> a -> trie map k a -> trie map k a+insert' = insertWith' const++-- O(min(m,s))+insertWith :: (Alt st a, Boolable (st a), Trie trie st map k)+           => (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+insertWith = genericInsertWith (<$>)++-- O(min(m,s))+insertWith' :: (Alt st a, Boolable (st a), Trie trie st map k)+            => (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+insertWith' = (seq <*>) .: genericInsertWith (<$!>)++genericInsertWith :: (Alt st a, Boolable (st a), Trie trie st map k)+                  => ((a -> a) -> st a -> st a)+                  -> (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a+genericInsertWith (<$$>) f k new tr =+   let (old,prefix,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) prefix k of+            Same -> mkTrie ((f new <$$> old) <|> pure new) prefix m++            PostFix (Left (p:pr)) -> mkTrie (pure new) k+                                            (Map.singleton p (mkTrie old pr m))+            PostFix (Right (x:xs)) ->+               -- Minor optimization: instead of tryCompress we just check for+               -- the case of an empty trie+               if null tr+                  then singleton k new+                  else mkTrie old prefix $+                          Map.insertWith+                             (\_ oldt ->+                                genericInsertWith (<$$>) f xs new oldt)+                             x (singleton xs new) m++            DifferedAt pr' (p:pr) (x:xs) ->+               mkTrie altEmpty pr' $ Map.doubleton x (singleton xs new)+                                                   p (mkTrie old pr m)++            _ -> error+                    "Data.ListTrie.Patricia.Base.insertWith :: internal error"++-- O(min(m,s))+delete :: (Alt st a, Boolable (st a), Trie trie st map k)+       => [k] -> trie map k a -> trie map k a+delete = alter (const altEmpty)++-- O(min(m,s))+adjust :: Trie trie st map k+       => (a -> a) -> [k] -> trie map k a -> trie map k a+adjust = genericAdjust fmap++-- O(min(m,s))+adjust' :: (Alt st a, Boolable (st a), Trie trie st map k)+        => (a -> a) -> [k] -> trie map k a -> trie map k a+adjust' = genericAdjust fmap'++genericAdjust :: Trie trie st map k+              => ((a -> a) -> st a -> st a)+              -> (a -> a) -> [k] -> trie map k a -> trie map k a+genericAdjust myFmap f k tr =+   let (v,prefix,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) prefix k of+            Same                   -> mkTrie (myFmap f v) prefix m+            PostFix (Right (x:xs)) ->+               mkTrie v prefix $ Map.adjust (genericAdjust myFmap f xs) x m+            _                      -> tr++-- O(min(m,s))+updateLookup :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (a -> st a) -> [k] -> trie map k a -> (st a, trie map k a)+updateLookup f k tr =+   let (v,prefix,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) prefix k of+            Same                   -> let v' = if hasValue v+                                                  then f (unwrap v)+                                                  else v+                                       in (v, safeMkTrie v' prefix m)+            PostFix (Right (x:xs)) ->+               case Map.lookup x m of+                    Nothing  -> (altEmpty, tr)+                    Just tr' ->+                       let (ret, upd) = updateLookup f xs tr'+                        in ( ret+                           , safeMkTrie v prefix $+                                if null upd+                                   then Map.delete x m+                                   else Map.adjust (const upd) x m+                           )+            _ -> (altEmpty, tr)++-- O(min(m,s))+--+-- This can be lazy in exactly one case: the key is a prefix of more than one+-- key in the trie. In that case, we know that the resulting trie continues to+-- contain those children.+--+-- In all other cases we have to check whether the function removed a key or+-- not, in order to be able to keep the trie in an internally valid state.++-- (I.e. we need to try to compress it.)+alter :: (Alt st a, Boolable (st a), Trie trie st map k)+      => (st a -> st a) -> [k] -> trie map k a -> trie map k a+alter = genericAlter (flip const)++-- O(min(m,s))+alter' :: (Alt st a, Boolable (st a), Trie trie st map k)+       => (st a -> st a) -> [k] -> trie map k a -> trie map k a+alter' = genericAlter seq++genericAlter :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (st a -> trie map k a -> trie map k a)+             -> (st a -> st a) -> [k] -> trie map k a -> trie map k a+genericAlter seeq f k tr =+   let (v,prefix,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) prefix k of+            Same                   ->+               let v' = f v+                in -- We need to compress if the map was empty or a singleton+                   -- and the value was removed+                   if    (Map.null m || isJust (Map.singletonView m))+                      && not (hasValue v')+                      then tryCompress (mkTrie v' prefix m)+                      else v' `seeq` mkTrie v' prefix m++            PostFix (Right (x:xs)) ->+               mkTrie v prefix $+                  Map.alter+                     (\mt -> case mt of+                                 Nothing ->+                                    let v' = f altEmpty+                                     in if hasValue v'+                                           then Just (singleton xs (unwrap v'))+                                           else Nothing+                                 Just t ->+                                    let new = genericAlter seeq f xs t+                                     in if null new then Nothing else Just new)+                     x m++            PostFix (Left (p:ps)) ->+               let v' = f altEmpty+                in if hasValue v'+                      then mkTrie v' k $ Map.singleton p (mkTrie v ps m)+                      else tr++            DifferedAt pr (p:ps) (x:xs) ->+               let v' = f altEmpty+                in if hasValue v'+                      then mkTrie altEmpty pr $+                              Map.doubleton p (mkTrie v  ps m)+                                            x (mkTrie v' xs Map.empty)+                      else tr++            _ ->+               error+                  "Data.ListTrie.Patricia.Base.genericAlter :: internal error"++-- * Querying++-- O(1)+--+-- Test the strict field last for maximal laziness+null :: (Boolable (st a), Trie trie st map k) => trie map k a -> Bool+null tr = let (v,p,m) = tParts tr+           in Map.null m && noValue v && assert (Prelude.null p) True++-- O(n m)+size :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n+size  tr = foldr  ((+) . size)  (if hasValue (tVal tr) then 1 else 0) (tMap tr)++-- O(n m)+size' :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n+size' tr = foldl' (flip $ (+) . size')+                  (if hasValue (tVal tr) then 1 else 0)+                  (tMap tr)++-- O(min(m,s))+member :: (Alt st a, Boolable (st a), Trie trie st map k)+       => [k] -> trie map k a -> Bool+member = hasValue .: lookup++-- O(min(m,s))+notMember :: (Alt st a, Boolable (st a), Trie trie st map k)+          => [k] -> trie map k a -> Bool+notMember = not .: member++-- O(min(m,s))+lookup :: (Alt st a, Trie trie st map k) => [k] -> trie map k a -> st a+lookup k tr =+   let (v,prefix,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) prefix k of+            Same                   -> v+            PostFix (Right (x:xs)) -> maybe altEmpty (lookup xs)+                                            (Map.lookup x m)+            _                      -> altEmpty++-- O(min(m,s))+lookupWithDefault :: (Alt st a, Trie trie st map k)+                  => a -> [k] -> trie map k a -> a+lookupWithDefault def k tr = unwrap $ lookup k tr <|> pure def++-- O(min(n1 m1,n2 m2))+isSubmapOfBy :: (Boolable (st a), Boolable (st b), Trie trie st map k)+             => (a -> b -> Bool)+             -> trie map k a+             -> trie map k b+             -> Bool+isSubmapOfBy f_ trl trr =+   let (vl,prel,ml) = tParts trl+       (vr,prer,mr) = tParts trr+    in case comparePrefixes (Map.eqCmp ml) prel prer of+            DifferedAt _ _ _  -> False++            -- Special case here: if the left trie is empty we return True.+            PostFix (Right _) -> null trl+            PostFix (Left xs) -> go f_ mr vl ml xs+            Same              -> same f_ vl vr ml mr+ where+   go f mr vl ml (x:xs) =+      case Map.lookup x mr of+           Nothing -> False+           Just tr ->+              let (vr,pre,mr') = tParts tr+               in case comparePrefixes (Map.eqCmp mr) xs pre of+                     DifferedAt _ _ _  -> False+                     PostFix (Right _) -> False+                     PostFix (Left ys) -> go f mr' vl ml ys+                     Same              -> same f vl vr ml mr'++   go _ _ _ _ [] =+      error "Data.ListTrie.Patricia.Base.isSubmapOfBy :: internal error"++   same f vl vr ml mr =+      let hvl = hasValue vl+          hvr = hasValue vr+       in and [ not (hvl && not hvr)+              , (not hvl && not hvr) || f_ (unwrap vl) (unwrap vr)+              , Map.isSubmapOfBy (isSubmapOfBy f) ml mr+              ]++-- O(min(n1 m1,n2 m2))+isProperSubmapOfBy :: (Boolable (st a), Boolable (st b), Trie trie st map k)+                   => (a -> b -> Bool)+                   -> trie map k a+                   -> trie map k b+                   -> Bool+isProperSubmapOfBy = f False+ where+   f proper g trl trr =+      let (vl,prel,ml) = tParts trl+          (vr,prer,mr) = tParts trr+       in case comparePrefixes (Map.eqCmp ml) prel prer of+               DifferedAt _ _ _  -> False++              -- Special case, as in isSubsetOf.+              --+              -- Note that properness does not affect this: if we hit this+              -- case, we already know that the right trie is nonempty.+               PostFix (Right _) -> null trl+               PostFix (Left xs) -> go proper g mr vl ml xs+               Same              -> same proper g vl vr ml mr++   go proper g mr vl ml (x:xs) =+      case Map.lookup x mr of+           Nothing -> False+           Just tr ->+              let (vr,pre,mr') = tParts tr+               in case comparePrefixes (Map.eqCmp mr) xs pre of+                       DifferedAt _ _ _  -> False+                       PostFix (Right _) -> False+                       PostFix (Left ys) -> go proper g mr' vl ml ys+                       Same              -> same proper g vl vr ml mr'++   go _ _ _ _ _ [] =+      error "Data.ListTrie.Patricia.Base.isProperSubmapOfBy :: internal error"++   same proper g vl vr ml mr =+      let hvl = hasValue vl+          hvr = hasValue vr++          -- As the non-Patricia version, so does this seem suboptimal.+          proper' = or [ proper+                       , not hvl && hvr+                       , not (Map.null $ Map.difference mr ml)+                       ]++       in and [ not (hvl && not hvr)+              , (not hvl && not hvr) || g (unwrap vl) (unwrap vr)+              , if Map.null ml+                   then proper'+                   else Map.isSubmapOfBy (f proper' g) ml mr+              ]++-- * Combination++-- The *Key versions are mostly rewritten from the basic ones: they have an+-- additional O(m) cost from keeping track of the key, which is why the basic+-- ones can't just call them.++-- O(min(n1 m1,n2 m2))+unionWith :: (Alt st a, Boolable (st a), Unionable st a, Trie trie st map k)+          => (a -> a -> a) -> trie map k a -> trie map k a -> trie map k a+unionWith f = genericUnionWith (unionVals f) (flip const)++-- O(min(n1 m1,n2 m2))+unionWith' :: (Alt st a, Boolable (st a), Unionable st a, Trie trie st map k)+          => (a -> a -> a) -> trie map k a -> trie map k a -> trie map k a+unionWith' f = genericUnionWith (unionVals' f) seq++genericUnionWith :: (Alt st a, Boolable (st a), Trie trie st map k)+                 => (st a -> st a -> st a)+                 -> (st a -> trie map k a -> trie map k a)+                 -> trie map k a+                 -> trie map k a+                 -> trie map k a+genericUnionWith valUnion seeq tr1 tr2 =+   let (v1,pre1,m1) = tParts tr1+       (v2,pre2,m2) = tParts tr2+    in case comparePrefixes (Map.eqCmp m1) pre1 pre2 of+            Same ->+               let v = valUnion v1 v2++                   -- safeMkTrie not needed: if pre1 is not null then m1 or v+                   -- won't be and hence the union won't be.+                in v `seeq` (tryCompress.mkTrie v pre1 $+                                            mapUnion valUnion seeq m1 m2)++            PostFix remainder ->+               -- As above, mkTrie is fine+               --+               -- The flip is important to retain left-biasedness+               tryCompress $+                  either+                     (mkTrie v2 pre2 . mapUnion (flip valUnion) seeq m2 .+                        decompress m1 v1)+                     (mkTrie v1 pre1 . mapUnion       valUnion  seeq m1 .+                        decompress m2 v2)+                     remainder++            DifferedAt pr (x:xs) (y:ys) ->+               -- As above, mkTrie is fine+               mkTrie altEmpty pr $ Map.doubleton x (mkTrie v1 xs m1)+                                                  y (mkTrie v2 ys m2)++            _ -> can'tHappen+ where+   mapUnion = Map.unionWith .: genericUnionWith++   decompress m v (x:xs) = Map.singleton x (mkTrie v xs m)+   decompress _ _ []     = can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.unionWith :: internal error"++-- O(min(n1 m1,n2 m2))+unionWithKey :: (Alt st a, Boolable (st a), Unionable st a, Trie trie st map k)+             => ([k] -> a -> a -> a)+             -> trie map k a+             -> trie map k a+             -> trie map k a+unionWithKey = genericUnionWithKey unionVals (flip const)++-- O(min(n1 m1,n2 m2))+unionWithKey' :: ( Alt st a, Boolable (st a), Unionable st a+                 , Trie trie st map k+                 )+              => ([k] -> a -> a -> a)+              -> trie map k a+              -> trie map k a+              -> trie map k a+unionWithKey' = genericUnionWithKey unionVals' seq++genericUnionWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+                    => ((a -> a -> a) -> st a -> st a -> st a)+                    -> (st a -> trie map k a -> trie map k a)+                    -> ([k] -> a -> a -> a)+                    -> trie map k a+                    -> trie map k a+                    -> trie map k a+genericUnionWithKey = go DL.empty+ where+   go k valUnion seeq j tr1 tr2 =+      let (v1,pre1,m1) = tParts tr1+          (v2,pre2,m2) = tParts tr2+       in case comparePrefixes (Map.eqCmp m1) pre1 pre2 of+               Same ->+                  let k' = DL.toList $ k `DL.append` DL.fromList pre1+                      v  = valUnion (j k') v1 v2+                   in v `seeq`+                         (tryCompress.mkTrie v pre1 $+                            mapUnion valUnion seeq j k pre1 m1 m2)++               PostFix remainder ->+                  tryCompress $+                     either+                        (mk v2 pre2 . mapUnion (flip.valUnion) seeq j k pre2 m2+                           . decompress m1 v1)+                        (mk v1 pre1 . mapUnion       valUnion  seeq j k pre1 m1+                           . decompress m2 v2)+                        remainder++               DifferedAt pr (x:xs) (y:ys) ->+                  mkTrie altEmpty pr $ Map.doubleton x (mkTrie v1 xs m1)+                                                     y (mkTrie v2 ys m2)++               _ -> can'tHappen++   mk = mkTrie++   mapUnion v s j k p =+      Map.unionWithKey $+         \x -> go (k `DL.append` DL.fromList p `DL.snoc` x) v s j++   decompress m v (x:xs) = Map.singleton x (mkTrie v xs m)+   decompress _ _ []     = can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.unionWithKey :: internal error"++-- O(sum(n))+unionsWith :: (Alt st a, Boolable (st a), Unionable st a, Trie trie st map k)+           => (a -> a -> a) -> [trie map k a] -> trie map k a+unionsWith j = foldl' (unionWith j) empty++-- O(sum(n))+unionsWith' :: (Alt st a, Boolable (st a), Unionable st a, Trie trie st map k)+            => (a -> a -> a) -> [trie map k a] -> trie map k a+unionsWith' j = foldl' (unionWith' j) empty++-- O(sum(n))+unionsWithKey :: ( Alt st a, Boolable (st a)+                 , Unionable st a, Trie trie st map k+                 )+              => ([k] -> a -> a -> a) -> [trie map k a] -> trie map k a+unionsWithKey j = foldl' (unionWithKey j) empty++-- O(sum(n))+unionsWithKey' :: ( Alt st a, Boolable (st a)+                  , Unionable st a, Trie trie st map k+                  )+               => ([k] -> a -> a -> a) -> [trie map k a] -> trie map k a+unionsWithKey' j = foldl' (unionWithKey' j) empty++-- O(min(n1 m1,n2 m2))+differenceWith :: (Boolable (st a), Differentiable st a b, Trie trie st map k)+               => (a -> b -> Maybe a)+               -> trie map k a+               -> trie map k b+               -> trie map k a+differenceWith j_ tr1 tr2 =+   let (v1,pre1,m1) = tParts tr1+       (v2,pre2,m2) = tParts tr2+    in case comparePrefixes (Map.eqCmp m1) pre1 pre2 of+            DifferedAt _ _ _   -> tr1+            Same               -> mk j_ v1 v2 pre1 m1 m2+            PostFix (Left  xs) -> goRight j_ tr1 m2  xs+            PostFix (Right xs) -> goLeft  j_ tr1 tr2 xs+ where+   mapDifference = Map.differenceWith . dw+   dw j a b =+      let c = differenceWith j a b+       in if null c then Nothing else Just c++   mk j v v' p m m' =+      let vd = differenceVals j v v'+       in tryCompress.mkTrie vd p $ mapDifference j m m'++   -- See the comment in 'intersection' for a longish example of the idea+   -- behind this, which is basically that if we see two prefixes like "foo"+   -- and "foobar", we traverse the "foo" trie looking for "bar". Then if we+   -- find "barbaz", we traverse the "foobar" trie looking for "baz", and so+   -- on.+   --+   -- We have two functions for the two tries because set difference is a+   -- noncommutative operation.+   goRight j left rightMap (x:xs) =+      let (v,pre,m) = tParts left+       in case Map.lookup x rightMap of+               Nothing     -> left+               Just right' ->+                  let (v',pre',m') = tParts right'+                   in case comparePrefixes (Map.eqCmp m) xs pre' of+                           DifferedAt _ _ _   -> left+                           Same               -> mk j v v' pre m m'+                           PostFix (Left  ys) -> goRight j left m'     ys+                           PostFix (Right ys) -> goLeft  j left right' ys++   goRight _ _ _ [] = can'tHappen++   goLeft j left right (x:xs) =+      tryCompress . mkTrie vl prel $ Map.update f x ml+    where+      (vl,prel,ml) = tParts left+      (vr,   _,mr) = tParts right++      f left' =+         let (v,pre,m) = tParts left'+          in case comparePrefixes (Map.eqCmp m) pre xs of+                  DifferedAt _ _ _   -> Just left'+                  Same               -> tryNull $ mk j v vr pre m mr+                  PostFix (Left  ys) -> tryNull $ goRight j left' mr    ys+                  PostFix (Right ys) -> tryNull $ goLeft  j left' right ys++      tryNull t = if null t then Nothing else Just t++   goLeft _ _ _ [] = can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.differenceWith :: internal error"++-- O(min(n1 m1,n2 m2))+differenceWithKey :: ( Boolable (st a), Differentiable st a b+                     , Trie trie st map k+                     )+                  => ([k] -> a -> b -> Maybe a)+                  -> trie map k a+                  -> trie map k b+                  -> trie map k a+differenceWithKey = go DL.empty+ where+   go k j_ tr1 tr2 =+      let (v1,pre1,m1) = tParts tr1+          (v2,pre2,m2) = tParts tr2+       in case comparePrefixes (Map.eqCmp m1) pre1 pre2 of+               DifferedAt _ _ _   -> tr1+               Same               -> mk j_ k v1 v2 pre1 m1 m2+               PostFix (Left  xs) -> goRight (key k pre2) j_ tr1 m2  xs+               PostFix (Right xs) -> goLeft  (key k pre1) j_ tr1 tr2 xs++   mapDifference k j =+      Map.differenceWithKey (\x -> dw (k `DL.snoc` x) j)++   key k p = k `DL.append` DL.fromList p++   dw k j a b =+      let c = go k j a b+       in if null c then Nothing else Just c++   mk j k v v' p m m' =+      let k' = k `DL.append` DL.fromList p+          vd = differenceVals (j $ DL.toList k') v v'+       in tryCompress.mkTrie vd p $ mapDifference k' j m m'++   goRight k j left rightMap (x:xs) =+      let (vl,_,ml) = tParts left+       in case Map.lookup x rightMap of+               Nothing    -> left+               Just right ->+                  let (vr,pre,mr) = tParts right+                      k'          = k `DL.snoc` x+                   in case comparePrefixes (Map.eqCmp ml) xs pre of+                           DifferedAt _ _ _   -> left+                           Same               -> mk j k' vl vr pre ml mr+                           PostFix (Left  ys) -> goRight (key k' pre)+                                                         j left mr    ys+                           PostFix (Right ys) -> goLeft  (key k' xs)+                                                         j left right ys++   goRight _ _ _ _ [] = can'tHappen++   goLeft k j left right (x:xs) =+      tryCompress . mkTrie vl prel $ Map.update f x ml+    where+      (vl,prel,ml) = tParts left+      (vr,   _,mr) = tParts right++      k' = k `DL.snoc` x++      f left' =+         let (v,pre,m) = tParts left'+          in case comparePrefixes (Map.eqCmp m) pre xs of+                  DifferedAt _ _ _   -> Just left'+                  Same               -> tryNull $ mk j k' v vr pre m mr+                  PostFix (Left  ys) -> tryNull $ goRight (key k' xs)+                                                          j left' mr    ys+                  PostFix (Right ys) -> tryNull $ goLeft  (key k' pre)+                                                          j left' right ys++      tryNull t = if null t then Nothing else Just t++   goLeft _ _ _ _ [] = can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.differenceWithKey :: internal error"++-- O(min(n1 m1,n2 m2))+intersectionWith :: ( Alt st c, Boolable (st c)+                    , Intersectable st a b c, Intersectable st b a c+                    , Trie trie st map k+                    )+                 => (a -> b -> c)+                 -> trie map k a+                 -> trie map k b+                 -> trie map k c+intersectionWith f = genericIntersectionWith (intersectionVals f) (flip const)++-- O(min(n1 m1,n2 m2))+intersectionWith' :: ( Alt st c, Boolable (st c)+                     , Intersectable st a b c, Intersectable st b a c+                     , Trie trie st map k+                     )+                  => (a -> b -> c)+                  -> trie map k a+                  -> trie map k b+                  -> trie map k c+intersectionWith' f = genericIntersectionWith (intersectionVals' f) seq++genericIntersectionWith :: forall a b c k map st trie.+                           ( Alt st c, Boolable (st c)+                           , Trie trie st map k+                           )+                        => (st a -> st b -> st c)+                        -> (st c -> trie map k c -> trie map k c)+                        -> trie map k a+                        -> trie map k b+                        -> trie map k c+genericIntersectionWith valIsect_ seeq_ trl trr =+   let (vl,prel,ml) = tParts trl+       (vr,prer,mr) = tParts trr+    in case comparePrefixes (Map.eqCmp ml) prel prer of+            DifferedAt _ _ _  -> empty+            Same              -> mk valIsect_ seeq_ vl vr prel ml mr+            PostFix remainder ->+               -- use the one with a longer prefix as the base for the+               -- intersection, and descend into the map of the one with a+               -- shorter prefix+               either (go       valIsect_  seeq_ mr vl ml (DL.fromList prel))+                      (go (flip valIsect_) seeq_ ml vr mr (DL.fromList prer))+                      remainder+ where+   mapIntersect valIsect seeq =+      Map.filter (not.null) .:+         Map.intersectionWith (genericIntersectionWith valIsect seeq)++   mk valIsect seeq v v' p m m' =+      let vi = valIsect v v'+       in vi `seeq` (tryCompress.mkTrie vi p $ mapIntersect valIsect seeq m m')++   -- Polymorphic recursion in 'go' (valIsect :: st a -> st b -> st c ---> st b+   -- -> st a -> st c) means that it has to be explicitly typed in order to+   -- compile.+   --+   -- The repeated "Trie trie st map k" constraint is for Hugs.++   -- Like goLeft and goRight in 'difference', but handles both cases (since+   -- this is a commutative operation).+   --+   -- Traverse the map given as the 1st argument, looking for anything that+   -- begins with the given key (x:xs).+   --+   -- If it's found, great: make an intersected trie out of the trie found in+   -- the map and the boolean, map, and prefix given.+   --+   -- If it's not found but might still be, there are two cases.+   --+   -- 1. Say we've got the following two TrieSets:+   --+   -- fromList ["car","cat"]+   -- fromList ["car","cot"]+   --+   -- i.e. (where <> is stuff we don't care about here)+   --+   -- Tr False "ca" (fromList [('r', Tr True ""  <>),<>])+   -- Tr False "c"  (fromList [('a', Tr True "r" <>),<>])+   --+   -- We came in here with (x:xs) = "a", the remainder of comparing "ca" and+   -- "c". We're looking for anything that begins with "ca" from the children+   -- of the "c".+   --+   -- We find the prefix pre' = "r", and comparePrefixes gives PostFix (Right+   -- "r"). So now we want anything beginning with "car" in the other trie. We+   -- switch to traversing the other trie, i.e. the other given map: the+   -- children of "ca".+   --+   -- 2. Say we have the following:+   --+   -- fromList ["cat"]+   -- fromList ["cat","cot","cap"]+   --+   -- i.e.+   --+   -- Tr True "cat" <>+   -- Tr False "c" (fromList [('a',Tr False "" (fromList [('t',<>)])),<>])+   --+   -- (x:xs) = "at" now, and we find pre' = "". We get PostFix (Left "t"). This+   -- means that we're staying in the same trie, just looking for "t" now+   -- instead of "at". So we jump into the m' map.+   --+   -- Note that the prefix and boolean don't change: we've already got "ca",+   -- and we'd still like "cat" so we keep the True from there.+   go :: (Alt st z, Boolable (st z), Trie trie st map k)+      => (st x -> st y -> st z)+      -> (st z -> trie map k z -> trie map k z)+      -> CMap trie map k y+      -> st x+      -> CMap trie map k x+      -> DList k+      -> [k]+      -> trie map k z+   go valIsect seeq ma v mb pre (x:xs) =+      case Map.lookup x ma of+           Nothing -> empty+           Just tr ->+              let (v',pre',m') = tParts tr+               in case comparePrefixes (Map.eqCmp ma) xs pre' of+                       DifferedAt _ _ _   -> empty+                       Same               ->+                          mk valIsect seeq v v' (DL.toList pre) mb m'+                       PostFix (Right ys) ->+                          let nextPre = pre `DL.append` DL.fromList ys+                           in go (flip valIsect) seeq mb v' m' nextPre ys+                       PostFix (Left  ys) ->+                              go       valIsect  seeq m' v  mb pre     ys++   go _ _ _ _ _ _ [] =+      error "Data.ListTrie.Patricia.Map.intersectionWith :: internal error"++-- O(min(n1 m1,n2 m2))+intersectionWithKey :: ( Alt st c, Boolable (st c)+                       , Intersectable st a b c, Intersectable st b a c+                       , Trie trie st map k+                       )+                    => ([k] -> a -> b -> c)+                    -> trie map k a+                    -> trie map k b+                    -> trie map k c+intersectionWithKey = genericIntersectionWithKey intersectionVals (flip const)++-- O(min(n1 m1,n2 m2))+intersectionWithKey' :: ( Alt st c, Boolable (st c)+                        , Intersectable st a b c, Intersectable st b a c+                        , Trie trie st map k+                        )+                     => ([k] -> a -> b -> c)+                     -> trie map k a+                     -> trie map k b+                     -> trie map k c+intersectionWithKey' = genericIntersectionWithKey intersectionVals' seq++genericIntersectionWithKey :: forall a b c k map st trie.+                              (Alt st c, Boolable (st c), Trie trie st map k)+                           => ((a -> b -> c) -> st a -> st b -> st c)+                           -> (st c -> trie map k c -> trie map k c)+                           -> ([k] -> a -> b -> c)+                           -> trie map k a+                           -> trie map k b+                           -> trie map k c+genericIntersectionWithKey = main DL.empty+ where+   main k valIsect seeq j trl trr =+      let (vl,prel,ml) = tParts trl+          (vr,prer,mr) = tParts trr+       in case comparePrefixes (Map.eqCmp ml) prel prer of+               DifferedAt _ _ _ -> empty+               Same             -> mk k valIsect seeq j vl vr prel ml mr+               PostFix remainder ->+                  let prel' = DL.fromList prel+                      prer' = DL.fromList prer+                   in either+                         (go k        valIsect  seeq       j  mr vl ml prel')+                         (go k (flipp valIsect) seeq (flip.j) ml vr mr prer')+                         remainder++   mk k valIsect seeq j v v' p m m' =+      let k' = k `DL.append` DL.fromList p+          vi = valIsect (j $ DL.toList k') v v'+       in vi `seeq` (tryCompress.mkTrie vi p $+                                    mapIntersect k' valIsect seeq j m m')++   mapIntersect k valIsect seeq j =+      Map.filter (not.null) .:+         Map.intersectionWithKey (\x -> main (k `DL.snoc` x) valIsect seeq j)++   flipp :: ((x -> y -> z) -> st x -> st y -> st z)+         -> ((y -> x -> z) -> st y -> st x -> st z)+   flipp f = flip . f . flip++   -- See intersectionWith: this explicit type is necessary+   go :: (Alt st z, Boolable (st z), Trie trie st map k)+      => DList k+      -> ((x -> y -> z) -> st x -> st y -> st z)+      -> (st z -> trie map k z -> trie map k z)+      -> ([k] -> x -> y -> z)+      -> CMap trie map k y+      -> st x+      -> CMap trie map k x+      -> DList k+      -> [k]+      -> trie map k z+   go k valIsect seeq j ma v mb pre (x:xs) =+      case Map.lookup x ma of+           Nothing -> empty+           Just tr ->+              let (v',pre',m') = tParts tr+               in case comparePrefixes (Map.eqCmp ma) xs pre' of+                       DifferedAt _ _ _   -> empty+                       Same               ->+                          mk k valIsect seeq j v v' (DL.toList pre) mb m'+                       PostFix (Right ys) ->+                          let nextPre = pre `DL.append` DL.fromList ys+                           in go k (flipp valIsect) seeq (flip.j)+                                 mb v' m' nextPre ys+                       PostFix (Left  ys) ->+                              go k        valIsect  seeq       j+                                 m' v  mb pre     ys++   go _ _ _ _ _ _ _ _ [] =+      error "Data.ListTrie.Patricia.Map.intersectionWithKey :: internal error"++-- * Filtering++-- O(n m)+filterWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+              => ([k] -> a -> Bool) -> trie map k a -> trie map k a+filterWithKey p = fromList . Prelude.filter (uncurry p) . toList++-- O(n m)+partitionWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+                 => ([k] -> a -> Bool)+                 -> trie map k a+                 -> (trie map k a, trie map k a)+partitionWithKey p = both fromList . partition (uncurry p) . toList++-- * Mapping++-- O(n m)+mapKeysWith :: (Boolable (st a), Trie trie st map k1, Trie trie st map k2)+            => ([([k2],a)] -> trie map k2 a)+            -> ([k1] -> [k2])+            -> trie map k1 a+            -> trie map k2 a+mapKeysWith fromlist f = fromlist . map (first f) . toList++-- O(n m)+mapInKeysWith :: ( Alt st a, Boolable (st a), Unionable st a+                 , Trie trie st map k1, Trie trie st map k2+                 )+              => (a -> a -> a)+              -> (k1 -> k2)+              -> trie map k1 a+              -> trie map k2 a+mapInKeysWith = genericMapInKeysWith (flip const) (const ()) unionWith++-- O(n m)+mapInKeysWith' :: ( Alt st a, Boolable (st a), Unionable st a+                  , Trie trie st map k1, Trie trie st map k2+                  )+               => (a -> a -> a)+               -> (k1 -> k2)+               -> trie map k1 a+               -> trie map k2 a+mapInKeysWith' =+   genericMapInKeysWith+      seq+      (\xs -> if Prelude.null xs then () else foldl1' seq xs `seq` ())+      unionWith'++genericMapInKeysWith :: ( Alt st a, Boolable (st a), Unionable st a+                        , Trie trie st map k1, Trie trie st map k2+                        )+                     => (() -> trie map k2 a -> trie map k2 a)+                     -> ([k2] -> ())+                     -> (f -> trie map k2 a -> trie map k2 a -> trie map k2 a)+                     -> f+                     -> (k1 -> k2)+                     -> trie map k1 a+                     -> trie map k2 a+genericMapInKeysWith seeq listSeq unionW j f tr =+   let (v,p,m) = tParts tr+       p'      = map f p+    in listSeq p' `seeq`+          (mkTrie v p' $+              Map.fromListWith (unionW j) .+                 map (f *** genericMapInKeysWith seeq listSeq unionW j f) .+              Map.toList $ m)++-- * Folding++-- O(n m)+foldrWithKey :: (Boolable (st a), Trie trie st map k)+            => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrWithKey f x = foldr (uncurry f) x . toList++-- O(n m)+foldrAscWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+               => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrAscWithKey f x = foldr (uncurry f) x . toAscList++-- O(n m)+foldrDescWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldrDescWithKey f x = foldr (uncurry f) x . toDescList++-- O(n m)+foldlWithKey :: (Boolable (st a), Trie trie st map k)+             => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlWithKey f x = foldl (flip $ uncurry f) x . toList++-- O(n m)+foldlAscWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlAscWithKey f x = foldl (flip $ uncurry f) x . toAscList++-- O(n m)+foldlDescWithKey :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                 => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlDescWithKey f x = foldl (flip $ uncurry f) x . toDescList++-- O(n m)+foldlWithKey' :: (Boolable (st a), Trie trie st map k)+            => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlWithKey' f x = foldl' (flip $ uncurry f) x . toList++-- O(n m)+foldlAscWithKey' :: (Boolable (st a), Trie trie st map k, OrdMap map k)+               => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlAscWithKey' f x = foldl' (flip $ uncurry f) x . toAscList++-- O(n m)+foldlDescWithKey' :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => ([k] -> a -> b -> b) -> b -> trie map k a -> b+foldlDescWithKey' f x = foldl' (flip $ uncurry f) x . toDescList++-- * Conversion between lists++-- O(n m)+toList :: (Boolable (st a), Trie trie st map k) => trie map k a -> [([k],a)]+toList = genericToList Map.toList DL.cons++-- O(n m)+toAscList :: (Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> [([k],a)]+toAscList = genericToList Map.toAscList DL.cons++-- O(n m)+toDescList :: (Boolable (st a), Trie trie st map k, OrdMap map k)+           => trie map k a -> [([k],a)]+toDescList = genericToList (reverse . Map.toAscList) (flip DL.snoc)++genericToList :: (Boolable (st a), Trie trie st map k)+              => (CMap trie map k a -> [(k, trie map k a)])+              -> (([k],a) -> DList ([k],a) -> DList ([k],a))+              -> trie map k a+              -> [([k],a)]+genericToList f_ g_ = DL.toList . go DL.empty f_ g_+ where+   go l tolist add tr =+      let (v,p,m) = tParts tr+          l'      = l `DL.append` DL.fromList p+          xs      =+             DL.concat .+             map (\(x,t) -> go (l' `DL.snoc` x) tolist add t) .+             tolist $ m+       in if hasValue v+             then add (DL.toList l', unwrap v) xs+             else                              xs++-- O(n m)+fromList :: (Alt st a, Boolable (st a), Trie trie st map k)+         => [([k],a)] -> trie map k a+fromList = fromListWith const++-- O(n m)+fromListWith :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (a -> a -> a) -> [([k],a)] -> trie map k a+fromListWith f = foldl' (flip . uncurry $ insertWith f) empty++-- O(n m)+fromListWith' :: (Alt st a, Boolable (st a), Trie trie st map k)+             => (a -> a -> a) -> [([k],a)] -> trie map k a+fromListWith' f = foldl' (flip . uncurry $ insertWith' f) empty++-- O(n m)+fromListWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)+                => ([k] -> a -> a -> a) -> [([k],a)] -> trie map k a+fromListWithKey f = foldl' (\tr (k,v) -> insertWith (f k) k v tr) empty++-- O(n m)+fromListWithKey' :: (Alt st a, Boolable (st a), Trie trie st map k)+                => ([k] -> a -> a -> a) -> [([k],a)] -> trie map k a+fromListWithKey' f = foldl' (\tr (k,v) -> insertWith' (f k) k v tr) empty++-- * Min/max++-- O(m)+minView :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> (Maybe ([k], a), trie map k a)+minView = minMaxView (hasValue.tVal) (fst . Map.minViewWithKey)++-- O(m)+maxView :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> (Maybe ([k], a), trie map k a)+maxView = minMaxView (Map.null.tMap) (fst . Map.maxViewWithKey)++minMaxView :: (Alt st a, Boolable (st a), Trie trie st map k)+           => (trie map k a -> Bool)+           -> (CMap trie map k a -> Maybe (k, trie map k a))+           -> trie map k a+           -> (Maybe ([k], a), trie map k a)+minMaxView _ _ tr_ | null tr_ = (Nothing, tr_)+minMaxView f g tr_ = first Just (go f g tr_)+ where+   go isWanted mapView tr =+      let (v,pre,m) = tParts tr+       in if isWanted tr+             then ((pre, unwrap v), safeMkTrie altEmpty pre m)++             else let (k,      tr')  = fromJust (mapView m)+                      (minMax, tr'') = go isWanted mapView tr'+                   in ( first (prepend pre k) minMax+                      , mkTrie v pre $ if null tr''+                                          then Map.delete              k m+                                          else Map.adjust (const tr'') k m+                      )++-- O(m)+findMin :: (Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> Maybe ([k], a)+findMin = findMinMax (hasValue . tVal) (fst . Map.minViewWithKey)++-- O(m)+findMax :: (Boolable (st a), Trie trie st map k, OrdMap map k)+        => trie map k a -> Maybe ([k], a)+findMax = findMinMax (Map.null . tMap) (fst . Map.maxViewWithKey)++findMinMax :: (Boolable (st a), Trie trie st map k)+           => (trie map k a -> Bool)+           -> (CMap trie map k a -> Maybe (k, trie map k a))+           -> trie map k a+           -> Maybe ([k], a)+findMinMax _ _ tr_ | null tr_ = Nothing+findMinMax f g tr_ = Just (go f g DL.empty tr_)+ where+   go isWanted mapView xs tr =+      let (v,pre,m) = tParts tr+          xs'       = xs `DL.append` DL.fromList pre+       in if isWanted tr+             then (DL.toList xs', unwrap v)+             else let (k, tr') = fromJust . mapView $ m+                   in go isWanted mapView (xs' `DL.snoc` k) tr'++-- O(m)+deleteMin :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> trie map k a+deleteMin = snd . minView++-- O(m)+deleteMax :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+          => trie map k a -> trie map k a+deleteMax = snd . maxView++-- O(min(m,s))+split :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+      => [k] -> trie map k a -> (trie map k a, trie map k a)+split xs tr = let (l,_,g) = splitLookup xs tr in (l,g)++-- O(min(m,s))+splitLookup :: (Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k)+            => [k]+            -> trie map k a+            -> (trie map k a, st a, trie map k a)+splitLookup xs tr =+   let (v,pre,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) pre xs of+            Same                     -> (empty, v, mk altEmpty pre m)+            DifferedAt _ (p:_) (x:_) ->+               case Map.ordCmp m p x of+                    LT -> (tr, altEmpty, empty)+                    GT -> (empty, altEmpty, tr)+                    EQ -> can'tHappen++            PostFix (Left  _)      -> (empty, altEmpty, tr)+            PostFix (Right (y:ys)) ->+               let (ml, maybeTr, mg) = Map.splitLookup y m+                in case maybeTr of+                        -- Prefix goes in left side of split since it's shorter+                        -- than the given key and thus lesser+                        Nothing  -> (mk v pre ml, altEmpty, mk altEmpty pre mg)+                        Just tr' ->+                           let (tl, v', tg) = splitLookup ys tr'+                               ml' = if null tl then ml else Map.insert y tl ml+                               mg' = if null tg then mg else Map.insert y tg mg+                            in (mk v pre ml', v', mk altEmpty pre mg')+            _ -> can'tHappen+ where+   mk v pre = tryCompress . mkTrie v pre+   can'tHappen =+      error "Data.ListTrie.Patricia.Base.splitLookup :: internal error"++-- O(m)+findPredecessor :: (Boolable (st a), Trie trie st map k, OrdMap map k)+                => [k] -> trie map k a -> Maybe ([k], a)+findPredecessor _   tr | null tr = Nothing+findPredecessor xs_ tr_          = go xs_ tr_+ where+   go xs tr =+      let (v,pre,m) = tParts tr+       in case comparePrefixes (Map.eqCmp m) pre xs of+               Same             -> Nothing+               PostFix (Left _) -> Nothing++               DifferedAt _ (p:_) (x:_) ->+                  case Map.ordCmp m p x of+                       LT -> findMax tr+                       GT -> Nothing+                       EQ -> can'tHappen++               -- See comment in non-Patricia version for explanation of+               -- algorithm+               PostFix (Right (y:ys)) ->+                  let predecessor = Map.findPredecessor y m+                   in (first (prepend pre y)<$>(Map.lookup y m >>= go ys))+                      <|>+                      case predecessor of+                           Nothing         ->+                              if hasValue v+                                 then Just (pre, unwrap v)+                                 else Nothing+                           Just (best,btr) ->+                              first (prepend pre best) <$> findMax btr+               _ -> can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.findPredecessor :: internal error"++-- O(m)+findSuccessor :: (Boolable (st a), Trie trie st map k, OrdMap map k)+              => [k] -> trie map k a -> Maybe ([k], a)+findSuccessor _   tr | null tr = Nothing+findSuccessor xs_ tr_          = go xs_ tr_+ where+   go xs tr =+      let (_,pre,m) = tParts tr+       in case comparePrefixes (Map.eqCmp m) pre xs of+               Same -> do (k,t) <- fst $ Map.minViewWithKey m+                          first (prepend pre k) <$> findMin t++               DifferedAt _ (p:_) (x:_) ->+                  case Map.ordCmp m p x of+                       LT -> Nothing+                       GT -> findMin tr+                       EQ -> can'tHappen++               PostFix (Left _)       -> findMin tr+               PostFix (Right (y:ys)) ->+                  let successor = Map.findSuccessor y m+                   in (first (prepend pre y)<$>(Map.lookup y m >>= go ys))+                      <|>+                      (successor >>= \(best,btr) ->+                         first (prepend pre best) <$> findMin btr)++               _ -> can'tHappen++   can'tHappen =+      error "Data.ListTrie.Patricia.Base.findSuccessor :: internal error"++-- * Trie-only operations++-- O(s)+addPrefix :: (Alt st a, Trie trie st map k)+          => [k] -> trie map k a -> trie map k a+addPrefix xs tr =+   let (v,pre,m) = tParts tr+    in mkTrie v (xs ++ pre) m++-- O(m)+deletePrefix :: (Alt st a, Boolable (st a), Trie trie st map k)+             => [k] -> trie map k a -> trie map k a+deletePrefix xs tr =+   let (v,pre,m) = tParts tr+    in case comparePrefixes (Map.eqCmp m) pre xs of+            Same                   -> tryCompress (mkTrie v [] m)+            PostFix (Left _)       -> tr+            DifferedAt _ _ _       -> empty+            PostFix (Right (y:ys)) ->+               case Map.lookup y m of+                    Nothing  -> empty+                    Just tr' -> deletePrefix ys tr'++            _ ->+               error+                  "Data.ListTrie.Patricia.Base.deletePrefix :: internal error"++-- O(1)+splitPrefix :: (Alt st a, Boolable (st a), Trie trie st map k)+            => trie map k a -> ([k], st a, trie map k a)+splitPrefix tr =+   let (v,pre,m) = tParts tr+    in (pre, v, tryCompress $ mkTrie altEmpty [] m)++-- O(1)+children :: Trie trie st map k => trie map k a -> [(k, trie map k a)]+children = Map.toList . tMap++-- * Visualization++-- O(n m)+showTrieWith :: (Show k, Trie trie st map k)+             => (st a -> ShowS) -> trie map k a -> ShowS+showTrieWith = go 0+ where+   go indent f tr =+      let (v,pre,m) = tParts tr+          spre      = shows pre+          lpre      = length (spre [])+          sv        = f v+          lv        = length (sv [])+       in spre . showChar ' '+        . sv . showChar ' '+        . (foldr (.) id . zipWith (flip ($)) (False : repeat True) $+              map (\(k,t) -> \b -> let sk = shows k+                                       lk = length (sk [])+                                       i  = indent + lpre + lv + 2+                                    in (if b+                                           then showChar '\n'+                                              . showString (replicate i ' ')+                                           else id)+                                     . showString "-> "+                                     . sk . showChar ' '+                                     . go (i + lk + 4) f t)+                  (Map.toList m))++-- helpers++-- mkTrie, but makes sure that empty tries don't have nonempty prefixes+-- intentionally strict in the value: gives update its semantics+safeMkTrie :: (Alt st a, Boolable (st a), Trie trie st map k)+           => st a -> [k] -> CMap trie map k a -> trie map k a+safeMkTrie v p m =+   if noValue v && Map.null m+      then empty+      else mkTrie v p m++prepend :: [a] -> a -> [a] -> [a]+prepend prefix key = (prefix++) . (key:)++data PrefixOrdering a+   = Same+   | PostFix (Either [a] [a])+   | DifferedAt [a] [a] [a]++-- Same                  If they're equal.+-- PostFix (Left  xs)    If the first argument was longer: xs is the remainder.+-- PostFix (Right xs)    Likewise, but for the second argument.+-- DifferedAt pre xs ys  Otherwise. pre is the part that was the same and+--                       xs and ys are the remainders for the first and second+--                       arguments respectively.+--+--                       all (pre `isPrefixOf`) [xs,ys] --> True.+comparePrefixes :: (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a+comparePrefixes = go []+ where+   go _ _ [] [] = Same+   go _ _ [] xs = PostFix (Right xs)+   go _ _ xs [] = PostFix (Left  xs)++   go samePart (===) xs@(a:as) ys@(b:bs) =+      if a === b+         then go (a:samePart) (===) as bs+         else DifferedAt (reverse samePart) xs ys++-- Exported for Eq/Ord instances+eqComparePrefixes :: (a -> a -> Bool) -> [a] -> [a] -> Bool+eqComparePrefixes eq xs ys = case comparePrefixes eq xs ys of+                                  Same -> True+                                  _    -> False++ordComparePrefixes :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering+ordComparePrefixes ord xs ys =+   case comparePrefixes (\x y -> ord x y == EQ) xs ys of+        Same                     -> EQ+        PostFix r                -> either (const GT) (const LT) r+        DifferedAt _ (x:_) (y:_) -> ord x y+        _                        ->+           error$ "Data.ListTrie.Patricia.Base.ordComparePrefixes :: " +++                  "internal error"++-- After modifying the trie, compress a trie node into the prefix if possible.+--+-- Doesn't recurse into children, only checks if this node and its child can be+-- joined into one. Does it repeatedly, though, until it can't compress any+-- more.+--+-- Note that this is a sledgehammer: for optimization, instead of using this in+-- every function, we could write a separate tryCompress for each function,+-- checking only for those cases that we know can arise. This has been done in+-- 'insert', at least, but not in many places.+tryCompress :: (Boolable (st a), Trie trie st map k)+            => trie map k a -> trie map k a+tryCompress tr =+   let (v,pre,m) = tParts tr+    in case Map.singletonView m of++          -- We can compress the trie if there is only one child+          Just (x, tr')+             -- If the parent is empty, we can collapse it into the child+             | noValue v -> tryCompress $ mkTrie v' (prepend pre x pre') subM++             -- If the parent is full and the child is empty and childless, the+             -- child is irrelevant+             | noValue v' && Map.null subM -> mkTrie v pre subM+           where+             (v',pre',subM) = tParts tr'++          -- If the trie is empty, make sure the prefix is as well.+          --+          -- This case can arise in 'intersectionWith', at least.+          Nothing | noValue v && Map.null m -> mkTrie v [] m++          -- Otherwise, leave it unchanged.+          _ -> tr
+ Data/ListTrie/Patricia/Map.hs view
@@ -0,0 +1,1051 @@+-- File created: 2008-11-12 14:16:48++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances+           , FlexibleContexts, UndecidableInstances #-}++#include "exports.h"++-- | The base implementation of a Patricia trie representing a map with list+-- keys, generalized over any type of map from element values to tries.+--+-- Worst-case complexities are given in terms of @n@, @m@, and @k@. @n@ refers+-- to the number of keys in the map and @m@ to their maximum length. @k@ refers+-- to the length of a key given to the function, not any property of the map.+--+-- In addition, the trie's branching factor plays a part in almost every+-- operation, but the complexity depends on the underlying 'Map'. Thus, for+-- instance, 'member' is actually @O(m f(b))@ where @f(b)@ is the complexity of+-- a lookup operation on the 'Map' used. This complexity depends on the+-- underlying operation, which is not part of the specification of the visible+-- function. Thus it could change whilst affecting the complexity only for+-- certain Map types: hence this \"b factor\" is not shown explicitly.+--+-- Disclaimer: the complexities have not been proven.+--+-- Strict versions of functions are provided for those who want to be certain+-- that their 'TrieMap' doesn't contain values consisting of unevaluated+-- thunks. Note, however, that they do not evaluate the whole trie strictly,+-- only the values. And only to one level of depth: for instance, 'alter'' does+-- not 'seq' the value within the 'Maybe', only the 'Maybe' itself. The user+-- should add the strictness in such cases himself, if he so wishes.+--+-- Many functions come in both ordinary and @WithKey@ forms, where the former+-- takes a function of type @a -> b@ and the latter of type @[k] -> a -> b@,+-- where @[k]@ is the key associated with the value @a@. For most of these+-- functions, there is additional overhead involved in keeping track of the+-- key: don't use the latter form of the function unless you need it.+module Data.ListTrie.Patricia.Map (MAP_EXPORTS) where++import Control.Applicative ((<*>),(<$>))+import Control.Arrow       ((***), second)+import qualified Data.DList as DL+import Data.Either         (partitionEithers)+import Data.Function       (on)+import qualified Data.Foldable as F+import qualified Data.Maybe as Maybe+import Data.Monoid         (Monoid(..))+import Data.Traversable    (Traversable(traverse))+import Prelude hiding      (filter, foldl, foldr, lookup, map, null)+import qualified Prelude++#if __GLASGOW_HASKELL__+import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))+#endif++import qualified Data.ListTrie.Base.Map      as Map+import qualified Data.ListTrie.Patricia.Base as Base+import Data.ListTrie.Base.Classes (fmap')+import Data.ListTrie.Base.Map     (Map, OrdMap)++#include "docs.h"++-- Invariant: any (Tr Nothing _ _) has at least two children, all of which are+-- Just or have a Just descendant.+--+-- In order to avoid a lot of special casing it has to be the case that there's+-- only one way to represent a given trie. The above property makes sure of+-- that, so that, for instance, 'fromList [("foo",1)]' can only be 'Tr (Just 1)+-- "foo" Map.empty', and not 'Tr Nothing "fo" (Map.fromList [('o',Tr (Just 1)+-- "" Map.empty)])'. Base.tryCompress is a function which takes care of this.+--+-- | The data structure itself: a map from keys of type @[k]@ to values of type+-- @v@ implemented as a trie, using @map@ to map keys of type @k@ to sub-tries.+--+-- Regarding the instances:+--+-- - The @Trie@ class is internal, ignore it.+--+-- - The 'Eq' constraint for the 'Ord' instance is misleading: it is needed+--   only because 'Eq' is a superclass of 'Ord'.+--+-- - The 'Foldable' and 'Traversable' instances allow folding over and+--   traversing only the values, not the keys.+--+-- - The 'Monoid' instance defines 'mappend' as 'union' and 'mempty' as+--   'empty'.+data TrieMap map k v = Tr (Maybe v) ![k] !(CMap map k v)++type CMap map k v = map k (TrieMap map k v)++instance Map map k => Base.Trie TrieMap Maybe map k where+   mkTrie = Tr+   tParts (Tr v p m) = (v,p,m)++-- Don't use CMap in these instances since Haddock won't expand it+instance (Map map k, Eq (map k (TrieMap map k a)), Eq a)+      => Eq (TrieMap map k a)+ where+   Tr v1 p1 m1 == Tr v2 p2 m2 =+      v1 == v2 && Base.eqComparePrefixes (Map.eqCmp m1) p1 p2+               && m1 == m2++-- Eq constraint only needed because of superclassness... sigh+instance (Eq (map k (TrieMap map k a)), OrdMap map k, Ord k, Ord a)+      => Ord (TrieMap map k a)+ where+   compare = compare `on` toAscList++instance Map map k => Monoid (TrieMap map k a) where+   mempty  = empty+   mappend = union+   mconcat = unions++instance Map map k => Functor (TrieMap map k) where+   fmap = map++instance Map map k => F.Foldable (TrieMap map k) where+   foldl = foldl . flip+   foldr = foldr++instance (Map map k, Traversable (map k)) => Traversable (TrieMap map k) where+   traverse f (Tr v p m) =+      flip Tr p <$> traverse f v <*> traverse (traverse f) m++instance (Map map k, Show k, Show a) => Show (TrieMap map k a) where+   showsPrec p s = showParen (p > 10) $+      showString "fromList " . shows (toList s)++instance (Map map k, Read k, Read a) => Read (TrieMap map k a) where+#if __GLASGOW_HASKELL__+   readPrec = parens $ prec 10 $ do+      Ident "fromList" <- lexP+      fmap fromList readPrec+#else+   readsPrec p = readParen (p > 10) $ \r -> do+      ("fromList", list) <- lex r+      (xs, rest) <- readsPrec (p+1) list+      [(fromList xs, rest)]+#endif++-- * Construction++-- | @O(1)@. The empty map.+empty :: Map map k => TrieMap map k a+empty = Base.empty++-- | @O(1)@. The singleton map containing only the given key-value pair.+singleton :: Map map k => [k] -> a -> TrieMap map k a+singleton = Base.singleton++-- * Modification++-- | @O(min(m,s))@. Inserts the key-value pair into the map. If the key is+-- already a member of the map, the given value replaces the old one.+--+-- > insert = insertWith const+insert :: Map map k => [k] -> a -> TrieMap map k a -> TrieMap map k a+insert = Base.insert++-- | @O(min(m,s))@. Like 'insert', but the new value is reduced to weak head+-- normal form before being placed into the map.+--+-- > insert' = insertWith' const+insert' :: Map map k => [k] -> a -> TrieMap map k a -> TrieMap map k a+insert' = Base.insert'++-- | @O(min(m,s))@. Inserts the key-value pair into the map. If the key is+-- already a member of the map, the old value is replaced by @f givenValue+-- oldValue@ where @f@ is the given function.+insertWith :: Map map k+           => (a -> a -> a) -> [k] -> a -> TrieMap map k a -> TrieMap map k a+insertWith = Base.insertWith++-- | @O(min(m,s))@. Like 'insertWith', but the new value is reduced to weak+-- head normal form before being placed into the map, whether it is the given+-- value or a result of the combining function.+insertWith' :: Map map k+            => (a -> a -> a) -> [k] -> a -> TrieMap map k a -> TrieMap map k a+insertWith' = Base.insertWith'++-- | @O(min(m,s))@. Removes the key from the map along with its associated+-- value. If the key is not a member of the map, the map is unchanged.+delete :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+delete = Base.delete++-- | @O(min(m,s))@. Adjusts the value at the given key by calling the given+-- function on it. If the key is not a member of the map, the map is unchanged.+adjust :: Map map k => (a -> a) -> [k] -> TrieMap map k a -> TrieMap map k a+adjust = Base.adjust++-- | @O(min(m,s))@. Like 'adjust', but the function is applied strictly.+adjust' :: Map map k => (a -> a) -> [k] -> TrieMap map k a -> TrieMap map k a+adjust' = Base.adjust'++-- | @O(min(m,s))@. Updates the value at the given key: if the given+-- function returns 'Nothing', the value and its associated key are removed; if+-- 'Just'@ a@is returned, the old value is replaced with @a@. If the key is+-- not a member of the map, the map is unchanged.+update :: Map map k+       => (a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+update f k = snd . updateLookup f k++-- | @O(min(m,s))@. Like 'update', but also returns 'Just' the original value,+-- or 'Nothing' if the key is not a member of the map.+updateLookup :: Map map k => (a -> Maybe a)+                          -> [k]+                          -> TrieMap map k a+                          -> (Maybe a, TrieMap map k a)+updateLookup = Base.updateLookup++-- | @O(min(m,s))@. The most general modification function, allowing you to+-- modify the value at the given key, whether or not it is a member of the map.+-- In short: the given function is passed 'Just' the value at the key if it is+-- present, or 'Nothing' otherwise; if the function returns 'Just' a value, the+-- new value is inserted into the map, otherwise the old value is removed. More+-- precisely, for @alter f k m@:+--+-- If @k@ is a member of @m@, @f (@'Just'@ oldValue)@ is called. Now:+--+-- - If @f@ returned 'Just'@ newValue@, @oldValue@ is replaced with @newValue@.+--+-- - If @f@ returned 'Nothing', @k@ and @oldValue@ are removed from the map.+--+-- If, instead, @k@ is not a member of @m@, @f @'Nothing' is called, and:+--+-- - If @f@ returned 'Just'@ value@, @value@ is inserted into the map, at @k@.+--+-- - If @f@ returned 'Nothing', the map is unchanged.+--+-- The function is applied lazily only if the given key is a prefix of more+-- than one key in the map.+alter :: Map map k+      => (Maybe a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+alter = Base.alter++-- | @O(min(m,s))@. Like 'alter', but the function is always applied strictly.+alter' :: Map map k+       => (Maybe a -> Maybe a) -> [k] -> TrieMap map k a -> TrieMap map k a+alter' = Base.alter'++-- * Querying++-- | @O(1)@. 'True' iff the map is empty.+null :: Map map k => TrieMap map k a -> Bool+null = Base.null++-- | @O(n m)@. The number of elements in the map. The value is built up lazily,+-- allowing for delivery of partial results without traversing the whole map.+size :: (Map map k, Num n) => TrieMap map k a -> n+size = Base.size++-- | @O(n m)@. The number of elements in the map. The value is built strictly:+-- no value is returned until the map has been fully traversed.+size' :: (Map map k, Num n) => TrieMap map k a -> n+size' = Base.size'++-- | @O(min(m,s))@. 'True' iff the given key is associated with a value in the+-- map.+member :: Map map k => [k] -> TrieMap map k a -> Bool+member = Base.member++-- | @O(min(m,s))@. 'False' iff the given key is associated with a value in the+-- map.+notMember :: Map map k => [k] -> TrieMap map k a -> Bool+notMember = Base.notMember++-- | @O(min(m,s))@. 'Just' the value in the map associated with the given key,+-- or 'Nothing' if the key is not a member of the map.+lookup :: Map map k => [k] -> TrieMap map k a -> Maybe a+lookup = Base.lookup++-- | @O(min(m,s))@. Like 'lookup', but returns the given value when the key is+-- not a member of the map.+lookupWithDefault :: Map map k => a -> [k] -> TrieMap map k a -> a+lookupWithDefault = Base.lookupWithDefault++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first map is a submap of the second,+-- i.e. all keys that are members of the first map are also members of the+-- second map, and their associated values are the same.+--+-- > isSubmapOf = isSubmapOfBy (==)+isSubmapOf :: (Map map k, Eq a) => TrieMap map k a -> TrieMap map k a -> Bool+isSubmapOf = isSubmapOfBy (==)++-- | @O(min(n1 m1,n2 m2))@. Like 'isSubmapOf', but one can specify the equality+-- relation applied to the values.+--+-- 'True' iff all keys that are members of the first map are also members of+-- the second map, and the given function @f@ returns 'True' for all @f+-- firstMapValue secondMapValue@ where @firstMapValue@ and @secondMapValue@ are+-- associated with the same key.+isSubmapOfBy :: Map map k+             => (a -> b -> Bool) -> TrieMap map k a -> TrieMap map k b -> Bool+isSubmapOfBy = Base.isSubmapOfBy++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first map is a proper submap of the+-- second, i.e. all keys that are members of the first map are also members of+-- the second map, and their associated values are the same, but the maps are+-- not equal. That is, at least one key was a member of the second map but not+-- the first.+--+-- > isProperSubmapOf = isProperSubmapOfBy (==)+isProperSubmapOf :: (Map map k, Eq a)+                 => TrieMap map k a -> TrieMap map k a -> Bool+isProperSubmapOf = isProperSubmapOfBy (==)++-- | @O(min(n1 m1,n2 m2))@. Like 'isProperSubmapOf', but one can specify the+-- equality relation applied to the values.+--+-- 'True' iff all keys that are members of the first map are also members of+-- the second map, and the given function @f@ returns 'True' for all @f+-- firstMapValue secondMapValue@ where @firstMapValue@ and @secondMapValue@ are+-- associated with the same key, and at least one key in the second map is not+-- a member of the first.+isProperSubmapOfBy :: Map map k => (a -> b -> Bool)+                                -> TrieMap map k a+                                -> TrieMap map k b+                                -> Bool+isProperSubmapOfBy = Base.isProperSubmapOfBy++-- * Combination++defaultUnion :: a -> a -> a+defaultUnion = const++-- | @O(min(n1 m1,n2 m2))@. The union of the two maps: the map which contains+-- all keys that are members of either map. This union is left-biased: if a key+-- is a member of both maps, the value from the first map is chosen.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > union = unionWith const+union :: Map map k => TrieMap map k a -> TrieMap map k a -> TrieMap map k a+union = unionWith defaultUnion++-- | @O(min(n1 m1,n2 m2))@. Like 'union', but the combining function ('const')+-- is applied strictly.+--+-- > union' = unionWith' const+union' :: Map map k => TrieMap map k a -> TrieMap map k a -> TrieMap map k a+union' = unionWith' defaultUnion++-- | @O(min(n1 m1,n2 m2))@. Like 'union', but the given function is used to+-- determine the new value if a key is a member of both given maps. For a+-- function @f@, the new value is @f firstMapValue secondMapValue@.+unionWith :: Map map k => (a -> a -> a)+                       -> TrieMap map k a+                       -> TrieMap map k a+                       -> TrieMap map k a+unionWith = Base.unionWith++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWith', but the combining function is+-- applied strictly.+unionWith' :: Map map k => (a -> a -> a)+                        -> TrieMap map k a+                        -> TrieMap map k a+                        -> TrieMap map k a+unionWith' = Base.unionWith'++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWith', but in addition to the two+-- values, the key is passed to the combining function.+unionWithKey :: Map map k => ([k] -> a -> a -> a)+                          -> TrieMap map k a+                          -> TrieMap map k a+                          -> TrieMap map k a+unionWithKey = Base.unionWithKey++-- | @O(min(n1 m1,n2 m2))@. Like 'unionWithKey', but the combining function is+-- applied strictly.+unionWithKey' :: Map map k => ([k] -> a -> a -> a)+                           -> TrieMap map k a+                           -> TrieMap map k a+                           -> TrieMap map k a+unionWithKey' = Base.unionWithKey'++-- | @O(sum(n))@. The union of all the maps: the map which contains all keys+-- that are members of any of the maps. If a key is a member of multiple maps,+-- the value that occurs in the earliest of the maps (according to the order of+-- the given list) is chosen.+--+-- The worst-case performance occurs when all the maps are identical.+--+-- > unions = unionsWith const+unions :: Map map k => [TrieMap map k a] -> TrieMap map k a+unions = unionsWith defaultUnion++-- | @O(sum(n))@. Like 'unions', but the combining function ('const') is+-- applied strictly.+--+-- > unions' = unionsWith' const+unions' :: Map map k => [TrieMap map k a] -> TrieMap map k a+unions' = unionsWith' defaultUnion++-- | @O(sum(n))@. Like 'unions', but the given function determines the final+-- value if a key is a member of more than one map. The function is applied as+-- a left fold over the values in the given list's order. For example:+--+-- > unionsWith (-) [fromList [("a",1)],fromList [("a",2)],fromList [("a",3)]]+-- >    == fromList [("a",(1-2)-3)]+-- >    == fromList [("a",-4)]+unionsWith :: Map map k+           => (a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWith = Base.unionsWith++-- | @O(sum(n))@. Like 'unionsWith', but the combining function is applied+-- strictly.+unionsWith' :: Map map k+            => (a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWith' = Base.unionsWith'++-- | @O(sum(n))@. Like 'unionsWith', but in addition to the two values under+-- consideration, the key is passed to the combining function.+unionsWithKey :: Map map k+              => ([k] -> a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWithKey = Base.unionsWithKey++-- | @O(sum(n))@. Like 'unionsWithKey', but the combining function is applied+-- strictly.+unionsWithKey' :: Map map k+               => ([k] -> a -> a -> a) -> [TrieMap map k a] ->  TrieMap map k a+unionsWithKey' = Base.unionsWithKey'++-- | @O(min(n1 m1,n2 m2))@. The difference of the two maps: the map which+-- contains all keys that are members of the first map and not of the second.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > difference = differenceWith (\_ _ -> Nothing)+difference :: Map map k+           => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+difference = differenceWith (\_ _ -> Nothing)++-- | @O(min(n1 m1,n2 m2))@. Like 'difference', but the given function+-- determines what to do when a key is a member of both maps. If the function+-- returns 'Nothing', the key is removed; if it returns 'Just' a new value,+-- that value replaces the old one in the first map.+differenceWith :: Map map k => (a -> b -> Maybe a)+                            -> TrieMap map k a+                            -> TrieMap map k b+                            -> TrieMap map k a+differenceWith = Base.differenceWith++-- | @O(min(n1 m1,n2 m2))@. Like 'differenceWith', but in addition to the two+-- values, the key they are associated with is passed to the combining+-- function.+differenceWithKey :: Map map k => ([k] -> a -> b -> Maybe a)+                               -> TrieMap map k a+                               -> TrieMap map k b+                               -> TrieMap map k a+differenceWithKey = Base.differenceWithKey++-- | @O(min(n1 m1,n2 m2))@. The intersection of the two maps: the map which+-- contains all keys that are members of both maps.+--+-- The worst-case performance occurs when the two maps are identical.+--+-- > intersection = intersectionWith const+intersection :: Map map k+             => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+intersection = intersectionWith const++-- | @O(min(n1 m1,n2 m2))@. Like 'intersection', but the combining function is+-- applied strictly.+--+-- > intersection' = intersectionWith' const+intersection' :: Map map k+              => TrieMap map k a -> TrieMap map k b -> TrieMap map k a+intersection' = intersectionWith' const++-- | @O(min(n1 m1,n2 m2))@. Like 'intersection', but the given function+-- determines the new values.+intersectionWith :: Map map k => (a -> b -> c)+                              -> TrieMap map k a+                              -> TrieMap map k b+                              -> TrieMap map k c+intersectionWith = Base.intersectionWith++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWith', but the combining function+-- is applied strictly.+intersectionWith' :: Map map k => (a -> b -> c)+                               -> TrieMap map k a+                               -> TrieMap map k b+                               -> TrieMap map k c+intersectionWith' = Base.intersectionWith'++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWith', but in addition to the two+-- values, the key they are associated with is passed to the combining+-- function.+intersectionWithKey :: Map map k => ([k] -> a -> b -> c)+                                 -> TrieMap map k a+                                 -> TrieMap map k b+                                 -> TrieMap map k c+intersectionWithKey = Base.intersectionWithKey++-- | @O(min(n1 m1,n2 m2))@. Like 'intersectionWithKey', but the combining+-- function is applied strictly.+intersectionWithKey' :: Map map k => ([k] -> a -> b -> c)+                                  -> TrieMap map k a+                                  -> TrieMap map k b+                                  -> TrieMap map k c+intersectionWithKey' = Base.intersectionWithKey'++-- * Filtering++-- | @O(n m)@. Apply the given function to the elements in the map, discarding+-- those for which the function returns 'False'.+filter :: Map map k => (a -> Bool) -> TrieMap map k a -> TrieMap map k a+filter = filterWithKey . const++-- | @O(n m)@. Like 'filter', but the key associated with the element is also+-- passed to the given predicate.+filterWithKey :: Map map k+              => ([k] -> a -> Bool) -> TrieMap map k a -> TrieMap map k a+filterWithKey = Base.filterWithKey++-- | @O(n m)@. A pair of maps: the first element contains those values for+-- which the given predicate returns 'True', and the second contains those for+-- which it was 'False'.+partition :: Map map k => (a -> Bool)+                       -> TrieMap map k a+                       -> (TrieMap map k a, TrieMap map k a)+partition = partitionWithKey . const++-- | @O(n m)@. Like 'partition', but the key associated with the element is+-- also passed to the given predicate.+partitionWithKey :: Map map k => ([k] -> a -> Bool)+                              -> TrieMap map k a+                              -> (TrieMap map k a, TrieMap map k a)+partitionWithKey = Base.partitionWithKey++-- | @O(n m)@. Apply the given function to the elements in the map, preserving+-- only the 'Just' results.+mapMaybe :: Map map k+         => (a -> Maybe b) -> TrieMap map k a -> TrieMap map k b+mapMaybe = mapMaybeWithKey . const++-- | @O(n m)@. Like 'mapMaybe', but the key associated with the element is also+-- passed to the given function.+mapMaybeWithKey :: Map map k+                => ([k] -> a -> Maybe b) -> TrieMap map k a -> TrieMap map k b+mapMaybeWithKey f =+   fromList . Maybe.mapMaybe (\(k,v) -> fmap ((,) k) (f k v)) . toList++-- | @O(n m)@. Apply the given function to the elements in the map, separating+-- the 'Left' results from the 'Right'. The first element of the pair contains+-- the former results, and the second the latter.+mapEither :: Map map k => (a -> Either b c)+                       -> TrieMap map k a+                       -> (TrieMap map k b, TrieMap map k c)+mapEither = mapEitherWithKey . const++-- | @O(n m)@. Like 'mapEither', but the key associated with the element is+-- also passed to the given function.+mapEitherWithKey :: Map map k => ([k] -> a -> Either b c)+                              -> TrieMap map k a+                              -> (TrieMap map k b, TrieMap map k c)+mapEitherWithKey f =+   (fromList *** fromList) . partitionEithers .+   Prelude.map (\(k,v) -> either (Left . (,) k) (Right . (,) k) (f k v)) .+   toList++-- * Mapping++-- | @O(n m)@. Apply the given function to all the elements in the map.+map :: Map map k => (a -> b) -> TrieMap map k a -> TrieMap map k b+map = genericMap fmap++-- | @O(n m)@. Like 'map', but apply the function strictly.+map' :: Map map k => (a -> b) -> TrieMap map k a -> TrieMap map k b+map' = genericMap fmap'++genericMap :: Map map k => ((a -> b) -> Maybe a -> Maybe b)+                        -> (a -> b) -> TrieMap map k a -> TrieMap map k b+genericMap myFmap f (Tr v p m) = Tr (myFmap f v) p+                                    (Map.map (genericMap myFmap f) m)++-- | @O(n m)@. Like 'map', but also pass the key associated with the element to+-- the given function.+mapWithKey :: Map map k+           => ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+mapWithKey = genericMapWithKey fmap++-- | @O(n m)@. Like 'mapWithKey', but apply the function strictly.+mapWithKey' :: Map map k+            => ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+mapWithKey' = genericMapWithKey fmap'++genericMapWithKey :: Map map k+                  => ((a -> b) -> Maybe a -> Maybe b)+                  -> ([k] -> a -> b) -> TrieMap map k a -> TrieMap map k b+genericMapWithKey = go DL.empty+ where+   go k myFmap f (Tr v p m) =+      let k' = k `DL.append` DL.fromList p+       in Tr (myFmap (f $ DL.toList k') v)+             p+             (Map.mapWithKey (\x -> go (k' `DL.snoc` x) myFmap f) m)++-- | @O(n m)@. Apply the given function to all the keys in a map.+--+-- > mapKeys = mapKeysWith const+mapKeys :: (Map map k1, Map map k2)+        => ([k1] -> [k2]) -> TrieMap map k1 a -> TrieMap map k2 a+mapKeys = mapKeysWith const++-- | @O(n m)@. Like 'mapKeys', but use the first given function to combine+-- elements if the second function gives two keys the same value.+mapKeysWith :: (Map map k1, Map map k2) => (a -> a -> a)+                                        -> ([k1] -> [k2])+                                        -> TrieMap map k1 a+                                        -> TrieMap map k2 a+mapKeysWith = Base.mapKeysWith . fromListWith++-- | @O(n m)@. Apply the given function to the contents of all the keys in the+-- map.+--+-- > mapInKeys = mapInKeysWith const+mapInKeys :: (Map map k1, Map map k2)+          => (k1 -> k2) -> TrieMap map k1 a -> TrieMap map k2 a+mapInKeys = mapInKeysWith defaultUnion++-- | @O(n m)@. Like 'mapInKeys', but combine identical keys strictly.+--+-- > mapInKeys' = mapInKeysWith' const+mapInKeys' :: (Map map k1, Map map k2)+           => (k1 -> k2) -> TrieMap map k1 a -> TrieMap map k2 a+mapInKeys' = mapInKeysWith' defaultUnion++-- | @O(n m)@. Like 'mapInKeys', but use the first given function to combine+-- elements if the second function gives two keys the same value.+mapInKeysWith :: (Map map k1, Map map k2) => (a -> a -> a)+                                          -> (k1 -> k2)+                                          -> TrieMap map k1 a+                                          -> TrieMap map k2 a+mapInKeysWith = Base.mapInKeysWith++-- | @O(n m)@. Like 'mapInKeysWith', but apply the combining function strictly.+mapInKeysWith' :: (Map map k1, Map map k2) => (a -> a -> a)+                                           -> (k1 -> k2)+                                           -> TrieMap map k1 a+                                           -> TrieMap map k2 a+mapInKeysWith' = Base.mapInKeysWith'++-- | @O(n m)@. Like "Data.List".@mapAccumL@ on the 'toList' representation.+--+-- Essentially a combination of 'map' and 'foldl': the given+-- function is applied to each element of the map, resulting in a new value for+-- the accumulator and a replacement element for the map.+mapAccum :: Map map k => (acc -> a -> (acc, b))+                      -> acc+                      -> TrieMap map k a+                      -> (acc, TrieMap map k b)+mapAccum = genericMapAccum Map.mapAccum (flip const)++-- | @O(n m)@. Like 'mapAccum', but the function is applied strictly.+mapAccum' :: Map map k => (acc -> a -> (acc, b))+                       -> acc+                       -> TrieMap map k a+                       -> (acc, TrieMap map k b)+mapAccum' = genericMapAccum Map.mapAccum seq++-- | @O(n m)@. Like 'mapAccum', but the function receives the key in addition+-- to the value associated with it.+mapAccumWithKey :: Map map k => (acc -> [k] -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumWithKey = genericMapAccumWithKey Map.mapAccumWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumWithKey', but the function is applied strictly.+mapAccumWithKey' :: Map map k => (acc -> [k] -> a -> (acc, b))+                              -> acc+                              -> TrieMap map k a+                              -> (acc, TrieMap map k b)+mapAccumWithKey' = genericMapAccumWithKey Map.mapAccumWithKey seq++-- | @O(n m)@. Like 'mapAccum', but in ascending order, as though operating on+-- the 'toAscList' representation.+mapAccumAsc :: OrdMap map k => (acc -> a -> (acc, b))+                            -> acc+                            -> TrieMap map k a+                            -> (acc, TrieMap map k b)+mapAccumAsc = genericMapAccum Map.mapAccumAsc (flip const)++-- | @O(n m)@. Like 'mapAccumAsc', but the function is applied strictly.+mapAccumAsc' :: OrdMap map k => (acc -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumAsc' = genericMapAccum Map.mapAccumAsc seq++-- | @O(n m)@. Like 'mapAccumAsc', but the function receives the key in+-- addition to the value associated with it.+mapAccumAscWithKey :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                   -> acc+                                   -> TrieMap map k a+                                   -> (acc, TrieMap map k b)+mapAccumAscWithKey = genericMapAccumWithKey Map.mapAccumAscWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumAscWithKey', but the function is applied strictly.+mapAccumAscWithKey' :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                    -> acc+                                    -> TrieMap map k a+                                    -> (acc, TrieMap map k b)+mapAccumAscWithKey' = genericMapAccumWithKey Map.mapAccumAscWithKey seq++-- | @O(n m)@. Like 'mapAccum', but in descending order, as though operating on+-- the 'toDescList' representation.+mapAccumDesc :: OrdMap map k => (acc -> a -> (acc, b))+                             -> acc+                             -> TrieMap map k a+                             -> (acc, TrieMap map k b)+mapAccumDesc = genericMapAccum Map.mapAccumDesc (flip const)++-- | @O(n m)@. Like 'mapAccumDesc', but the function is applied strictly.+mapAccumDesc' :: OrdMap map k => (acc -> a -> (acc, b))+                              -> acc+                              -> TrieMap map k a+                              -> (acc, TrieMap map k b)+mapAccumDesc' = genericMapAccum Map.mapAccumDesc seq++-- | @O(n m)@. Like 'mapAccumDesc', but the function receives the key in+-- addition to the value associated with it.+mapAccumDescWithKey :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                    -> acc+                                    -> TrieMap map k a+                                    -> (acc, TrieMap map k b)+mapAccumDescWithKey =+   genericMapAccumWithKey Map.mapAccumDescWithKey (flip const)++-- | @O(n m)@. Like 'mapAccumDescWithKey', but the function is applied+-- strictly.+mapAccumDescWithKey' :: OrdMap map k => (acc -> [k] -> a -> (acc, b))+                                     -> acc+                                     -> TrieMap map k a+                                     -> (acc, TrieMap map k b)+mapAccumDescWithKey' = genericMapAccumWithKey Map.mapAccumDescWithKey seq++genericMapAccum :: Map map k+                => (  (acc -> TrieMap map k a -> (acc, TrieMap map k b))+                   -> acc+                   -> CMap map k a+                   -> (acc, CMap map k b)+                   )+                -> (b -> (acc, Maybe b) -> (acc, Maybe b))+                -> (acc -> a -> (acc, b))+                -> acc+                -> TrieMap map k a+                -> (acc, TrieMap map k b)+genericMapAccum subMapAccum seeq f acc (Tr mv p m) =+   let (acc', mv') =+          case mv of+               Nothing -> (acc, Nothing)+               Just v  ->+                  let (acc'', v') = f acc v+                   in v' `seeq` (acc'', Just v')+    in second (Tr mv' p) $+         subMapAccum (genericMapAccum subMapAccum seeq f) acc' m++genericMapAccumWithKey :: Map map k => (  (  acc+                                          -> k+                                          -> TrieMap map k a+                                          -> (acc, TrieMap map k b)+                                          )+                                       -> acc+                                       -> CMap map k a+                                       -> (acc, CMap map k b)+                                       )+                                    -> (b -> (acc, Maybe b) -> (acc, Maybe b))+                                    -> (acc -> [k] -> a -> (acc, b))+                                    -> acc+                                    -> TrieMap map k a+                                    -> (acc, TrieMap map k b)+genericMapAccumWithKey = go DL.empty+ where+   go k subMapAccum seeq f acc (Tr mv p m) =+      let k'         = k `DL.append` DL.fromList p+          (acc', mv') =+             case mv of+                  Nothing -> (acc, Nothing)+                  Just v  ->+                     let (acc'', v') = f acc (DL.toList k') v+                      in v' `seeq` (acc'', Just v')+       in second (Tr mv' p) $+             subMapAccum (\a x -> go (k' `DL.snoc` x) subMapAccum seeq f a)+                         acc' m++-- * Folding++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation,+-- folding only over the elements.+foldr :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldr = foldrWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation,+-- folding over both the keys and the elements.+foldrWithKey :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrWithKey = Base.foldrWithKey++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation.+foldrAsc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldrAsc = foldrAscWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation,+-- folding over both the keys and the elements.+foldrAscWithKey :: OrdMap map k+                => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrAscWithKey = Base.foldrAscWithKey++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation.+foldrDesc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldrDesc = foldrDescWithKey . const++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation,+-- folding over both the keys and the elements.+foldrDescWithKey :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldrDescWithKey = Base.foldrDescWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toList representation.+foldl :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldl = foldlWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toList representation,+-- folding over both the keys and the elements.+foldlWithKey :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlWithKey = Base.foldlWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toAscList representation.+foldlAsc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlAsc = foldlAscWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toAscList representation,+-- folding over both the keys and the elements.+foldlAscWithKey :: OrdMap map k+                => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlAscWithKey = Base.foldlAscWithKey++-- | @O(n m)@. Equivalent to a list @foldl@ on the toDescList representation.+foldlDesc :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlDesc = foldlDescWithKey . const++-- | @O(n m)@. Equivalent to a list @foldl@ on the toDescList representation,+-- folding over both the keys and the elements.+foldlDescWithKey :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlDescWithKey = Base.foldlDescWithKey++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation.+foldl' :: Map map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldl' = foldlWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation,+-- folding over both the keys and the elements.+foldlWithKey' :: Map map k => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlWithKey' = Base.foldlWithKey'++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation.+foldlAsc' :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlAsc' = foldlAscWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation,+-- folding over both the keys and the elements.+foldlAscWithKey' :: OrdMap map k+                 => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlAscWithKey' = Base.foldlAscWithKey'++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation.+foldlDesc' :: OrdMap map k => (a -> b -> b) -> b -> TrieMap map k a -> b+foldlDesc' = foldlDescWithKey' . const++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation, folding over both the keys and the elements.+foldlDescWithKey' :: OrdMap map k+                  => ([k] -> a -> b -> b) -> b -> TrieMap map k a -> b+foldlDescWithKey' = Base.foldlDescWithKey'++-- * Conversion between lists++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in undefined order.+toList :: Map map k => TrieMap map k a -> [([k],a)]+toList = Base.toList++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in ascending order.+toAscList :: OrdMap map k => TrieMap map k a -> [([k],a)]+toAscList = Base.toAscList++-- | @O(n m)@. Converts the map to a list of the key-value pairs contained+-- within, in descending order.+toDescList :: OrdMap map k => TrieMap map k a -> [([k],a)]+toDescList = Base.toDescList++-- | @O(n m)@. Creates a map from a list of key-value pairs. If a key occurs+-- more than once, the value from the last pair (according to the list's order)+-- is the one which ends up in the map.+--+-- > fromList = fromListWith const+fromList :: Map map k => [([k],a)] -> TrieMap map k a+fromList = Base.fromList++-- | @O(n m)@. Like 'fromList', but the given function is used to determine the+-- final value if a key occurs more than once. The function is applied as+-- though it were flipped and then applied as a left fold over the values in+-- the given list's order. Or, equivalently (except as far as performance is+-- concerned), as though the function were applied as a right fold over the+-- values in the reverse of the given list's order. For example:+--+-- > fromListWith (-) [("a",1),("a",2),("a",3),("a",4)]+-- >    == fromList [("a",4-(3-(2-1)))]+-- >    == fromList [("a",2)]+fromListWith :: Map map k => (a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWith = Base.fromListWith++-- | @O(n m)@. Like 'fromListWith', but the combining function is applied+-- strictly.+fromListWith' :: Map map k => (a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWith' = Base.fromListWith'++-- | @O(n m)@. Like 'fromListWith', but the key, in addition to the values to+-- be combined, is passed to the combining function.+fromListWithKey :: Map map k+                => ([k] -> a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWithKey = Base.fromListWithKey++-- | @O(n m)@. Like 'fromListWithKey', but the combining function is applied+-- strictly.+fromListWithKey' :: Map map k+                 => ([k] -> a -> a -> a) -> [([k],a)] -> TrieMap map k a+fromListWithKey' = Base.fromListWithKey'++-- * Ordering ops++-- | @O(m)@. Removes and returns the minimal key in the map, along with the+-- value associated with it. If the map is empty, 'Nothing' and the original+-- map are returned.+minView :: OrdMap map k => TrieMap map k a -> (Maybe ([k], a), TrieMap map k a)+minView = Base.minView++-- | @O(m)@. Removes and returns the maximal key in the map, along with the+-- value associated with it. If the map is empty, 'Nothing' and the original+-- map are returned.+maxView :: OrdMap map k => TrieMap map k a -> (Maybe ([k], a), TrieMap map k a)+maxView = Base.maxView++-- | @O(m)@. Like 'fst' composed with 'minView'. 'Just' the minimal key in the+-- map and its associated value, or 'Nothing' if the map is empty.+findMin :: OrdMap map k => TrieMap map k a -> Maybe ([k], a)+findMin = Base.findMin++-- | @O(m)@. Like 'fst' composed with 'maxView'. 'Just' the minimal key in the+-- map and its associated value, or 'Nothing' if the map is empty.+findMax :: OrdMap map k => TrieMap map k a -> Maybe ([k], a)+findMax = Base.findMax++-- | @O(m)@. Like 'snd' composed with 'minView'. The map without its minimal+-- key, or the unchanged original map if it was empty.+deleteMin :: OrdMap map k => TrieMap map k a -> TrieMap map k a+deleteMin = Base.deleteMin++-- | @O(m)@. Like 'snd' composed with 'maxView'. The map without its maximal+-- key, or the unchanged original map if it was empty.+deleteMax :: OrdMap map k => TrieMap map k a -> TrieMap map k a+deleteMax = Base.deleteMax++-- | @O(min(m,s))@. Splits the map in two about the given key. The first+-- element of the resulting pair is a map containing the keys lesser than the+-- given key; the second contains those keys that are greater.+split :: OrdMap map k+      => [k] -> TrieMap map k a -> (TrieMap map k a, TrieMap map k a)+split = Base.split++-- | @O(min(m,s))@. Like 'split', but also returns the value associated with+-- the given key, if any.+splitLookup :: OrdMap map k => [k]+                            -> TrieMap map k a+                            -> (TrieMap map k a, Maybe a, TrieMap map k a)+splitLookup = Base.splitLookup++-- | @O(m)@. 'Just' the key of the map which precedes the given key in order,+-- along with its associated value, or 'Nothing' if the map is empty.+findPredecessor :: OrdMap map k => [k] -> TrieMap map k a -> Maybe ([k], a)+findPredecessor = Base.findPredecessor++-- | @O(m)@. 'Just' the key of the map which succeeds the given key in order,+-- along with its associated value, or 'Nothing' if the map is empty.+findSuccessor :: OrdMap map k => [k] -> TrieMap map k a -> Maybe ([k], a)+findSuccessor = Base.findSuccessor++-- * Trie-only operations++-- | @O(s)@. Prepends the given key to all the keys of the map. For example:+--+-- > addPrefix "xa" (fromList [("a",1),("b",2)])+-- >    == fromList [("xaa",1),("xab",2)]+addPrefix :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+addPrefix = Base.addPrefix++-- | @O(m)@. The map which contains all keys of which the given key is a+-- prefix, with the prefix removed from each key. If the given key is not a+-- prefix of any key in the map, the map is returned unchanged. For example:+--+-- > deletePrefix "a" (fromList [("a",1),("ab",2),("ac",3)])+-- >    == fromList [("",1),("b",2),("c",3)]+--+-- This function can be used, for instance, to reduce potentially expensive I/O+-- operations: if you need to find the value in a map associated with a string,+-- but you only have a prefix of it and retrieving the rest is an expensive+-- operation, calling 'deletePrefix' with what you have might allow you to+-- avoid the operation: if the resulting map is empty, the entire string cannot+-- be a member of the map.+deletePrefix :: Map map k => [k] -> TrieMap map k a -> TrieMap map k a+deletePrefix = Base.deletePrefix++-- | @O(1)@. A triple containing the longest common prefix of all keys in the+-- map, the value associated with that prefix, if any, and the map with that+-- prefix removed from all the keys as well as the map itself. Examples:+--+-- > splitPrefix (fromList [("a",1),("b",2)])+-- >    == ("", Nothing, fromList [("a",1),("b",2)])+-- > splitPrefix (fromList [("a",1),("ab",2),("ac",3)])+-- >    == ("a", Just 1, fromList [("b",2),("c",3)])+splitPrefix :: Map map k => TrieMap map k a -> ([k], Maybe a, TrieMap map k a)+splitPrefix = Base.splitPrefix++-- | @O(1)@. The children of the longest common prefix in the trie as maps,+-- associated with their distinguishing key value. If the map contains less+-- than two keys, this function will return the empty list. Examples;+--+-- > children (fromList [("a",1),("abc",2),("abcd",3)])+-- >    == [('b',fromList [("c",2),("cd",3)])]+-- > children (fromList [("b",1),("c",2)])+-- >    == [('b',fromList [("",1)]),('c',fromList [("",2)])]+children :: Map map k => TrieMap map k a -> [(k, TrieMap map k a)]+children = Base.children++-- * Visualization++-- | @O(n m)@. Displays the map's internal structure in an undefined way. That+-- is to say, no program should depend on the function's results.+showTrie :: (Show k, Show a, Map map k) => TrieMap map k a -> ShowS+showTrie = Base.showTrieWith $ \mv -> case mv of+                                           Nothing -> showChar ' '+                                           Just v  -> showsPrec 11 v++-- | @O(n m)@. Like 'showTrie', but uses the given function to display the+-- elements of the map. Still undefined.+showTrieWith :: (Show k, Map map k)+             => (Maybe a -> ShowS) -> TrieMap map k a -> ShowS+showTrieWith = Base.showTrieWith
+ Data/ListTrie/Patricia/Map/Enum.hs view
@@ -0,0 +1,17 @@+-- File created: 2008-12-29 12:42:12++-- | A map from lists of enumerable elements to arbitrary values, based on a+-- Patricia trie.+--+-- Note that those operations which require an ordering, such as 'toAscList',+-- do not compare the elements themselves, but rather their 'Int'+-- representation after 'fromEnum'.+module Data.ListTrie.Patricia.Map.Enum ( TrieMap+                                       , module Data.ListTrie.Patricia.Map+                                       ) where++import Data.ListTrie.Base.Map            (WrappedIntMap)+import Data.ListTrie.Patricia.Map hiding (TrieMap)+import qualified Data.ListTrie.Patricia.Map as Base++type TrieMap = Base.TrieMap WrappedIntMap
+ Data/ListTrie/Patricia/Map/Eq.hs view
@@ -0,0 +1,13 @@+-- File created: 2009-01-06 13:49:30++-- | A map from lists of elements that can be compared for equality to+-- arbitrary values, based on a Patricia trie.+module Data.ListTrie.Patricia.Map.Eq ( TrieMap+                                     , module Data.ListTrie.Patricia.Map+                                     ) where++import Data.ListTrie.Base.Map            (AList)+import Data.ListTrie.Patricia.Map hiding (TrieMap)+import qualified Data.ListTrie.Patricia.Map as Base++type TrieMap = Base.TrieMap AList
+ Data/ListTrie/Patricia/Map/Ord.hs view
@@ -0,0 +1,13 @@+-- File created: 2009-01-06 13:48:52++-- | A map from lists of elements that can be totally ordered to arbitrary+-- values, based on a Patricia trie.+module Data.ListTrie.Patricia.Map.Ord ( TrieMap+                                      , module Data.ListTrie.Patricia.Map+                                      ) where++import Data.Map                          (Map)+import Data.ListTrie.Patricia.Map hiding (TrieMap)+import qualified Data.ListTrie.Patricia.Map as Base++type TrieMap = Base.TrieMap Map
+ Data/ListTrie/Patricia/Set.hs view
@@ -0,0 +1,405 @@+-- File created: 2008-11-08 19:22:07++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances+           , FlexibleContexts, UndecidableInstances #-}++#include "exports.h"++-- | The base implementation of a Patricia trie representing a set of lists,+-- generalized over any type of map from element values to tries.+--+-- Worst-case complexities are given in terms of @n@, @m@, and @k@. @n@ refers+-- to the number of keys in the set and @m@ to their maximum length. @k@ refers+-- to the length of a key given to the function, not any property of the set.+--+-- In addition, the trie's branching factor plays a part in almost every+-- operation, but the complexity depends on the underlying 'Map'. Thus, for+-- instance, 'member' is actually @O(m f(b))@ where @f(b)@ is the complexity of+-- a lookup operation on the 'Map' used. This complexity depends on the+-- underlying operation, which is not part of the specification of the visible+-- function. Thus it could change whilst affecting the complexity only for+-- certain Map types: hence this \"b factor\" is not shown explicitly.+--+-- Disclaimer: the complexities have not been proven.+module Data.ListTrie.Patricia.Set (SET_EXPORTS) where++import Control.Arrow  ((***), second)+import Data.Function  (on)+import Data.Monoid    (Monoid(..))+import Prelude hiding (filter, foldl, foldr, map, null)+import qualified Prelude++#if __GLASGOW_HASKELL__+import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))+#endif++import qualified Data.ListTrie.Base.Map      as Map+import qualified Data.ListTrie.Patricia.Base as Base+import Data.ListTrie.Base.Classes (Identity(..), Unwrappable(..))+import Data.ListTrie.Base.Map     (Map, OrdMap)+import Data.ListTrie.Util         ((.:), (.:.), both)++#include "docs.h"++-- Invariant: any (Tr False _ _) has at least two children, all of which are+-- True or have a True descendant.+--+-- In order to avoid a lot of special casing it has to be the case that there's+-- only one way to represent a given trie. The above property makes sure of+-- that, so that, for instance, 'fromList ["foo"]' can only be 'Tr True "foo"+-- Map.empty', and not 'Tr False "fo" (Map.fromList [('o',Tr True ""+-- Map.empty)])'. Base.tryCompress is a function which takes care of this.+--+-- This Base stuff is needed just as in the non-Patricia version.+data TrieSetBase map a bool = Tr !bool ![a] !(CMap map a bool)+type CMap map a bool = map a (TrieSetBase map a bool)++-- | The data structure itself: a set of keys of type @[a]@ implemented as a+-- trie, using @map@ to map keys of type @a@ to sub-tries.+--+-- Regarding the instances:+--+-- - The @CMap@ type is internal, ignore it. For 'Eq' and 'Ord' an 'Eq'+--   instance is required: what this means is that @map a v@ is expected to be+--   an instance of 'Eq', given 'Eq'@ v@.+--+-- - The 'Eq' constraint for the 'Ord' instance is misleading: it is needed+--   only because 'Eq' is a superclass of 'Ord'.+--+-- - The 'Monoid' instance defines 'mappend' as 'union' and 'mempty' as+--   'empty'.+newtype TrieSet map a = TS { unTS :: TrieSetBase map a Bool }++inTS :: (TrieSetBase map a Bool -> TrieSetBase nap b Bool)+     -> (TrieSet map a -> TrieSet nap b)+inTS f = TS . f . unTS++instance Map map k => Base.Trie TrieSetBase Identity map k where+   mkTrie = Tr . unwrap+   tParts (Tr b p m) = (Id b,p,m)++-- CMap contains TrieSetBase, not TrieSet, hence we must supply these instances+-- for TrieSetBase first+instance (Map map a, Eq (CMap map a Bool)) => Eq (TrieSetBase map a Bool) where+   Tr b1 p1 m1 == Tr b2 p2 m2 =+      b1 == b2 && Base.eqComparePrefixes (Map.eqCmp m1) p1 p2+               && m1 == m2++instance (Eq (CMap map a Bool), OrdMap map a, Ord a)+      => Ord (TrieSetBase map a Bool)+ where+   compare = compare `on` Base.toAscList++instance (Eq (CMap map a Bool), Map map a) => Eq (TrieSet map a) where+   (==) = (==) `on` unTS++-- The CMap constraint is needed only because Eq is a superclass of Ord....+-- sigh+instance (Eq (CMap map a Bool), OrdMap map a, Ord a) => Ord (TrieSet map a)+ where+   compare = compare `on` unTS++instance Map map a => Monoid (TrieSet map a) where+   mempty  = empty+   mappend = union+   mconcat = unions++instance (Map map a, Show a) => Show (TrieSet map a) where+   showsPrec p s = showParen (p > 10) $+      showString "fromList " . shows (toList s)++instance (Map map a, Read a) => Read (TrieSet map a) where+#if __GLASGOW_HASKELL__+   readPrec = parens $ prec 10 $ do+      Ident "fromList" <- lexP+      fmap fromList readPrec+#else+   readsPrec p = readParen (p > 10) $ \r -> do+      ("fromList", list) <- lex r+      (xs, rest) <- readsPrec (p+1) list+      [(fromList xs, rest)]+#endif++-- * Construction++-- | @O(1)@. The empty set.+empty :: Map map a => TrieSet map a+empty = TS Base.empty++-- | @O(1)@. The singleton set containing only the given key.+singleton :: Map map a => [a] -> TrieSet map a+singleton k = TS$ Base.singleton k True++-- * Modification++-- | @O(min(m,s))@. Inserts the key into the set. If the key is already a+-- member of the set, the set is unchanged.+insert :: Map map a => [a] -> TrieSet map a -> TrieSet map a+insert k = inTS$ Base.insert k True++-- | @O(min(m,s))@. Removes the key from the set. If the key is not a member of+-- the set, the set is unchanged.+delete :: Map map a => [a] -> TrieSet map a -> TrieSet map a+delete = inTS . Base.delete++-- * Querying++-- | @O(1)@. 'True' iff the set is empty.+null :: Map map a => TrieSet map a -> Bool+null = Base.null . unTS++-- | @O(n m)@. The number of keys in the set. The value is built up lazily,+-- allowing for delivery of partial results without traversing the whole set.+size :: (Map map a, Num n) => TrieSet map a -> n+size = Base.size . unTS++-- | @O(n m)@. The number of keys in the set. The value is built strictly: no+-- value is returned until the set has been fully traversed.+size' :: (Map map a, Num n) => TrieSet map a -> n+size' = Base.size' . unTS++-- | @O(min(m,s))@. 'True' iff the given key is contained within the set.+member :: Map map a => [a] -> TrieSet map a -> Bool+member = Base.member .:. unTS++-- | @O(min(m,s))@. 'False' iff the given key is contained within the set.+notMember :: Map map a => [a] -> TrieSet map a -> Bool+notMember = Base.notMember .:. unTS++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first set is a subset of the second,+-- i.e. all keys that are members of the first set are also members of the+-- second set.+isSubsetOf :: Map map a => TrieSet map a -> TrieSet map a -> Bool+isSubsetOf = Base.isSubmapOfBy (&&) `on` unTS++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first set is a proper subset of the+-- second, i.e. the first is a subset of the second, but the sets are not+-- equal.+isProperSubsetOf :: Map map a => TrieSet map a -> TrieSet map a -> Bool+isProperSubsetOf = Base.isProperSubmapOfBy (&&) `on` unTS++-- * Combination++defaultUnion :: Bool -> Bool -> Bool+defaultUnion = error "TrieSet.union :: internal error"++-- | @O(min(n1 m1,n2 m2))@. The union of the two sets: the set which contains+-- all keys that are members of either set.+--+-- The worst-case performance occurs when the two sets are identical.+union :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+union = TS .: Base.unionWith defaultUnion `on` unTS++-- | @O(sum(n))@. The union of all the sets: the set which contains all keys+-- that are members of any of the sets.+--+-- The worst-case performance occurs when all the sets are identical.+unions :: Map map a => [TrieSet map a] -> TrieSet map a+unions = TS . Base.unionsWith defaultUnion . Prelude.map unTS++-- | @O(min(n1 m1,n2 m2))@. The difference of the two sets: the set which+-- contains all keys that are members of the first set and not members of the+-- second set.+--+-- The worst-case performance occurs when the two sets are identical.+difference :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+difference = TS .: Base.differenceWith+                      (error "TrieSet.difference :: internal error")+                   `on` unTS++-- | @O(min(n1 m1,n2 m2))@. The intersection of the two sets: the set which+-- contains all keys that are members of both sets.+--+-- The worst-case performance occurs when the two sets are identical.+intersection :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+intersection = TS .: Base.intersectionWith+                        (error "TrieSet.intersection :: internal error")+                     `on` unTS++-- * Filtering++-- | @O(n m)@. The set of those keys in the set for which the given predicate+-- returns 'True'.+filter :: Map map a => ([a] -> Bool) -> TrieSet map a -> TrieSet map a+filter p = inTS $ Base.filterWithKey (\k _ -> p k)++-- | @O(n m)@. A pair of sets: the first element contains those keys for which+-- the given predicate returns 'True', and the second element contains those+-- for which it was 'False'.+partition :: Map map a+          => ([a] -> Bool) -> TrieSet map a -> (TrieSet map a, TrieSet map a)+partition p = both TS . Base.partitionWithKey (\k _ -> p k) . unTS++-- * Mapping++-- | @O(n m)@. Apply the given function to all the keys in the set.+map :: (Map map a, Map map b) => ([a] -> [b]) -> TrieSet map a -> TrieSet map b+map = inTS . Base.mapKeysWith Base.fromList++-- | @O(n m)@. Apply the given function to the contents of all the keys in the+-- set.+mapIn :: (Map map a, Map map b) => (a -> b) -> TrieSet map a -> TrieSet map b+mapIn = inTS . Base.mapInKeysWith defaultUnion++-- * Folding++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation.+foldr :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldr f = Base.foldrWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation.+foldrAsc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldrAsc f = Base.foldrAscWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation.+foldrDesc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldrDesc f = Base.foldrDescWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toList' representation.+foldl :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldl f = Base.foldlWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toAscList' representation.+foldlAsc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlAsc f = Base.foldlAscWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toDescList' representation.+foldlDesc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlDesc f = Base.foldlDescWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation.+foldl' :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldl' f = Base.foldlWithKey' (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation.+foldlAsc' :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlAsc' f = Base.foldlAscWithKey' (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation.+foldlDesc' :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlDesc' f = Base.foldlDescWithKey' (\k _ -> f k) .:. unTS++-- * Conversion between lists++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- undefined order.+toList :: Map map a => TrieSet map a -> [[a]]+toList = Prelude.map fst . Base.toList . unTS++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- ascending order.+toAscList :: OrdMap map a => TrieSet map a -> [[a]]+toAscList = Prelude.map fst . Base.toAscList . unTS++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- descending order.+toDescList :: OrdMap map a => TrieSet map a -> [[a]]+toDescList = Prelude.map fst . Base.toDescList . unTS++-- | @O(n m)@. Creates a set from a list of keys.+fromList :: Map map a => [[a]] -> TrieSet map a+fromList = TS . Base.fromList . Prelude.map (flip (,) True)++-- * Ordering ops++-- | @O(m)@. Removes and returns the minimal key in the set. If the set is+-- empty, 'Nothing' and the original set are returned.+minView :: OrdMap map a => TrieSet map a -> (Maybe [a], TrieSet map a)+minView = (fmap fst *** TS) . Base.minView . unTS++-- | @O(m)@. Removes and returns the maximal key in the set. If the set is+-- empty, 'Nothing' and the original set are returned.+maxView :: OrdMap map a => TrieSet map a -> (Maybe [a], TrieSet map a)+maxView = (fmap fst *** TS) . Base.maxView . unTS++-- | @O(m)@. Like 'fst' composed with 'minView'. 'Just' the minimal key in the+-- set, or 'Nothing' if the set is empty.+findMin :: OrdMap map a => TrieSet map a -> Maybe [a]+findMin = fmap fst . Base.findMin . unTS++-- | @O(m)@. Like 'fst' composed with 'maxView'. 'Just' the maximal key in the+-- set, or 'Nothing' if the set is empty.+findMax :: OrdMap map a => TrieSet map a -> Maybe [a]+findMax = fmap fst . Base.findMax . unTS++-- | @O(m)@. Like 'snd' composed with 'minView'. The set without its minimal+-- key, or the unchanged original set if it was empty.+deleteMin :: OrdMap map a => TrieSet map a -> TrieSet map a+deleteMin = inTS Base.deleteMin++-- | @O(m)@. Like 'snd' composed with 'maxView'. The set without its maximal+-- key, or the unchanged original set if it was empty.+deleteMax :: OrdMap map a => TrieSet map a -> TrieSet map a+deleteMax = inTS Base.deleteMax++-- | @O(min(m,s))@. Splits the set in two about the given key. The first+-- element of the resulting pair is a set containing the keys lesser than the+-- given key; the second contains those keys that are greater.+split :: OrdMap map a => [a] -> TrieSet map a -> (TrieSet map a, TrieSet map a)+split = both TS .: Base.split .:. unTS++-- | @O(min(m,s))@. Like 'split', but also returns whether the given key was a+-- member of the set or not.+splitMember :: OrdMap map a+            => [a] -> TrieSet map a -> (TrieSet map a, Bool, TrieSet map a)+splitMember = (\(l,b,g) -> (TS l,unwrap b,TS g)) .: Base.splitLookup .:. unTS++-- | @O(m)@. 'Just' the key of the set which precedes the given key in order,+-- or 'Nothing' if the set is empty.+findPredecessor :: OrdMap map a => [a] -> TrieSet map a -> Maybe [a]+findPredecessor = fmap fst .: Base.findPredecessor .:. unTS++-- | @O(m)@. 'Just' the key of the set which succeeds the given key in order,+-- or 'Nothing' if the set is empty.+findSuccessor :: OrdMap map a => [a] -> TrieSet map a -> Maybe [a]+findSuccessor = fmap fst .: Base.findSuccessor .:. unTS++-- * Trie-only operations++-- | @O(s)@. Prepends the given key to all the keys of the set. For example:+--+-- > addPrefix "pre" (fromList ["a","b"]) == fromList ["prea","preb"]+addPrefix :: Map map a => [a] -> TrieSet map a -> TrieSet map a+addPrefix = TS .: Base.addPrefix .:. unTS++-- | @O(m)@. The set which contains all keys of which the given key is a+-- prefix, with the prefix removed from each key. If the given key is not a+-- prefix of any key in the set, the set is returned unchanged. For example:+--+-- > deletePrefix "a" (fromList ["a","ab","ac"]) == fromList ["","b","c"]+--+-- This function can be used, for instance, to reduce potentially expensive I/O+-- operations: if you need to check whether a string is a member of a set, but+-- you only have a prefix of it and retrieving the rest is an expensive+-- operation, calling 'deletePrefix' with what you have might allow you to+-- avoid the operation: if the resulting set is empty, the entire string cannot+-- be a member of the set.+deletePrefix :: Map map a => [a] -> TrieSet map a -> TrieSet map a+deletePrefix = TS .: Base.deletePrefix .:. unTS++-- | @O(1)@. A triple containing the longest common prefix of all keys in the+-- set, whether that prefix was a member of the set, and the set with that+-- prefix removed from all the keys as well as the set itself. Examples:+--+-- > splitPrefix (fromList ["a","b"]) == ("", False, fromList ["a","b"])+-- > splitPrefix (fromList ["a","ab","ac"]) == ("a", True, fromList ["b","c"])+splitPrefix :: Map map a => TrieSet map a -> ([a], Bool, TrieSet map a)+splitPrefix = (\(k,b,t) -> (k,unwrap b,TS t)) . Base.splitPrefix . unTS++-- | @O(1)@. The children of the longest common prefix in the trie as sets,+-- associated with their distinguishing key value. If the set contains less+-- than two keys, this function will return the empty list. Examples;+--+-- > children (fromList ["a","abc","abcd"]) == [('b',fromList ["c","cd"])]+-- > children (fromList ["b","c"]) == [('b',fromList [""]),('c',fromList [""])]+children :: Map map a => TrieSet map a -> [(a, TrieSet map a)]+children = Prelude.map (second TS) . Base.children . unTS++-- * Visualization++-- | @O(n m)@. Displays the set's internal structure in an undefined way. That+-- is to say, no program should depend on the function's results.+showTrie :: (Show a, Map map a) => TrieSet map a -> ShowS+showTrie = Base.showTrieWith (\(Id b) -> showChar $ if b then 'X' else ' ')+         . unTS
+ Data/ListTrie/Patricia/Set/Enum.hs view
@@ -0,0 +1,16 @@+-- File created: 2008-10-22 20:44:46++-- | A set of lists of enumerable elements, based on a Patricia trie.+--+-- Note that those operations which require an ordering, such as 'toAscList',+-- do not compare the elements themselves, but rather their 'Int'+-- representation after 'fromEnum'.+module Data.ListTrie.Patricia.Set.Enum ( TrieSet+                                       , module Data.ListTrie.Patricia.Set+                                       ) where++import Data.ListTrie.Base.Map            (WrappedIntMap)+import Data.ListTrie.Patricia.Set hiding (TrieSet)+import qualified Data.ListTrie.Patricia.Set as Base++type TrieSet = Base.TrieSet WrappedIntMap
+ Data/ListTrie/Patricia/Set/Eq.hs view
@@ -0,0 +1,13 @@+-- File created: 2009-01-06 13:51:25++-- | A set of lists of elements that can be compared for equality, based on a+-- Patricia trie.+module Data.ListTrie.Patricia.Set.Eq ( TrieSet+                                     , module Data.ListTrie.Patricia.Set+                                     ) where++import Data.ListTrie.Base.Map            (AList)+import Data.ListTrie.Patricia.Set hiding (TrieSet)+import qualified Data.ListTrie.Patricia.Set as Base++type TrieSet = Base.TrieSet AList
+ Data/ListTrie/Patricia/Set/Ord.hs view
@@ -0,0 +1,13 @@+-- File created: 2009-01-06 13:50:00++-- | A set of lists of elements that can be totally ordered, based on a+-- Patricia trie.+module Data.ListTrie.Patricia.Set.Ord ( TrieSet+                                      , module Data.ListTrie.Patricia.Set+                                      ) where++import Data.Map                          (Map)+import Data.ListTrie.Patricia.Set hiding (TrieSet)+import qualified Data.ListTrie.Patricia.Set as Base++type TrieSet = Base.TrieSet Map
+ Data/ListTrie/Set.hs view
@@ -0,0 +1,400 @@+-- File created: 2008-11-08 15:52:33++{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances+           , FlexibleContexts, UndecidableInstances #-}++#include "exports.h"++-- | The base implementation of a trie representing a set of lists, generalized+-- over any type of map from key values to tries.+--+-- Worst-case complexities are given in terms of @n@, @m@, and @k@. @n@ refers+-- to the number of keys in the set and @m@ to their maximum length. @k@ refers+-- to the length of a key given to the function, not any property of the set.+--+-- In addition, the trie's branching factor plays a part in almost every+-- operation, but the complexity depends on the underlying 'Map'. Thus, for+-- instance, 'member' is actually @O(m f(b))@ where @f(b)@ is the complexity of+-- a lookup operation on the 'Map' used. This complexity depends on the+-- underlying operation, which is not part of the specification of the visible+-- function. Thus it could change whilst affecting the complexity only for+-- certain Map types: hence this \"b factor\" is not shown explicitly.+--+-- Disclaimer: the complexities have not been proven.+module Data.ListTrie.Set (SET_EXPORTS) where++import Control.Arrow  ((***), second)+import Data.Function  (on)+import Data.Monoid    (Monoid(..))+import Prelude hiding (filter, foldl, foldr, map, null)+import qualified Prelude++#if __GLASGOW_HASKELL__+import Text.Read (readPrec, lexP, parens, prec, Lexeme(Ident))+#endif++import qualified Data.ListTrie.Base     as Base+import qualified Data.ListTrie.Base.Map as Map+import Data.ListTrie.Base.Classes (Identity(..), Unwrappable(..))+import Data.ListTrie.Base.Map     (Map, OrdMap)+import Data.ListTrie.Util         ((.:), (.:.), both)++#include "docs.h"++-- Invariant: any (Tr False _) has a True descendant.+--+-- We need this 'bool' and Base stuff in order to satisfy the Base.Trie type+-- class.+data TrieSetBase map a bool = Tr !bool !(CMap map a bool)+type CMap map a bool = map a (TrieSetBase map a bool)++-- That makes TrieSet a newtype, which means some unfortunate wrapping and+-- unwrapping in the function definitions below.+--+-- | The data structure itself: a set of keys of type @[a]@ implemented as a+-- trie, using @map@ to map keys of type @a@ to sub-tries.+--+-- Regarding the instances:+--+-- - The @CMap@ type is internal, ignore it. For 'Eq' and 'Ord' an 'Eq'+--   instance is required: what this means is that @map a v@ is expected to be+--   an instance of 'Eq', given 'Eq'@ v@.+--+-- - The 'Eq' constraint for the 'Ord' instance is misleading: it is needed+--   only because 'Eq' is a superclass of 'Ord'.+--+-- - The 'Monoid' instance defines 'mappend' as 'union' and 'mempty' as+--   'empty'.+newtype TrieSet map a = TS { unTS :: TrieSetBase map a Bool }++inTS :: (TrieSetBase map a Bool -> TrieSetBase nap b Bool)+     -> (TrieSet map a -> TrieSet nap b)+inTS f = TS . f . unTS++instance Map map k => Base.Trie TrieSetBase Identity map k where+   mkTrie = Tr . unwrap+   tParts (Tr b m) = (Id b,m)++-- CMap contains TrieSetBase, not TrieSet, hence we must supply these instances+-- for TrieSetBase first+instance Eq (CMap map a Bool) => Eq (TrieSetBase map a Bool) where+   Tr b1 m1 == Tr b2 m2 = b1 == b2 && m1 == m2++instance (Eq (CMap map a Bool), OrdMap map a, Ord a)+      => Ord (TrieSetBase map a Bool)+ where+   compare = compare `on` Base.toAscList++instance Eq (CMap map a Bool) => Eq (TrieSet map a) where+   (==) = (==) `on` unTS++-- The CMap constraint is needed only because Eq is a superclass of Ord....+-- sigh+instance (Eq (CMap map a Bool), OrdMap map a, Ord a) => Ord (TrieSet map a)+ where+   compare = compare `on` unTS++instance Map map a => Monoid (TrieSet map a) where+   mempty  = empty+   mappend = union+   mconcat = unions++instance (Map map a, Show a) => Show (TrieSet map a) where+   showsPrec p s = showParen (p > 10) $+      showString "fromList " . shows (toList s)++instance (Map map a, Read a) => Read (TrieSet map a) where+#if __GLASGOW_HASKELL__+   readPrec = parens $ prec 10 $ do+      Ident "fromList" <- lexP+      fmap fromList readPrec+#else+   readsPrec p = readParen (p > 10) $ \r -> do+      ("fromList", list) <- lex r+      (xs, rest) <- readsPrec (p+1) list+      [(fromList xs, rest)]+#endif++-- * Construction++-- | @O(1)@. The empty set.+empty :: Map map a => TrieSet map a+empty = TS Base.empty++-- | @O(s)@. The singleton set containing only the given key.+singleton :: Map map a => [a] -> TrieSet map a+singleton k = TS$ Base.singleton k True++-- * Modification++-- | @O(min(m,s))@. Inserts the key into the set. If the key is already a+-- member of the set, the set is unchanged.+insert :: Map map a => [a] -> TrieSet map a -> TrieSet map a+insert k = inTS$ Base.insert k True++-- | @O(min(m,s))@. Removes the key from the set. If the key is not a member of+-- the set, the set is unchanged.+delete :: Map map a => [a] -> TrieSet map a -> TrieSet map a+delete = inTS . Base.delete++-- * Querying++-- | @O(1)@. 'True' iff the set is empty.+null :: Map map a => TrieSet map a -> Bool+null = Base.null . unTS++-- | @O(n m)@. The number of keys in the set. The value is built up lazily,+-- allowing for delivery of partial results without traversing the whole set.+size :: (Map map a, Num n) => TrieSet map a -> n+size = Base.size . unTS++-- | @O(n m)@. The number of keys in the set. The value is built strictly: no+-- value is returned until the set has been fully traversed.+size' :: (Map map a, Num n) => TrieSet map a -> n+size' = Base.size' . unTS++-- | @O(min(m,s))@. 'True' iff the given key is contained within the set.+member :: Map map a => [a] -> TrieSet map a -> Bool+member = Base.member .:. unTS++-- | @O(min(m,s))@. 'False' iff the given key is contained within the set.+notMember :: Map map a => [a] -> TrieSet map a -> Bool+notMember = Base.notMember .:. unTS++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first set is a subset of the second,+-- i.e. all keys that are members of the first set are also members of the+-- second set.+isSubsetOf :: Map map a => TrieSet map a -> TrieSet map a -> Bool+isSubsetOf = Base.isSubmapOfBy (&&) `on` unTS++-- | @O(min(n1 m1,n2 m2))@. 'True' iff the first set is a proper subset of the+-- second, i.e. the first is a subset of the second, but the sets are not+-- equal.+isProperSubsetOf :: Map map a => TrieSet map a -> TrieSet map a -> Bool+isProperSubsetOf = Base.isProperSubmapOfBy (&&) `on` unTS++-- * Combination++defaultUnion :: Bool -> Bool -> Bool+defaultUnion = error "TrieSet.union :: internal error"++-- | @O(min(n1 m1,n2 m2))@. The union of the two sets: the set which contains+-- all keys that are members of either set.+--+-- The worst-case performance occurs when the two sets are identical.+union :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+union = TS .: Base.unionWith defaultUnion `on` unTS++-- | @O(sum(n))@. The union of all the sets: the set which contains all keys+-- that are members of any of the sets.+--+-- The worst-case performance occurs when all the sets are identical.+unions :: Map map a => [TrieSet map a] -> TrieSet map a+unions = TS . Base.unionsWith defaultUnion . Prelude.map unTS++-- | @O(min(n1 m1,n2 m2))@. The difference of the two sets: the set which+-- contains all keys that are members of the first set and not members of the+-- second set.+--+-- The worst-case performance occurs when the two sets are identical.+difference :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+difference = TS .: Base.differenceWith+                      (error "TrieSet.difference :: internal error")+                   `on` unTS++-- | @O(min(n1 m1,n2 m2))@. The intersection of the two sets: the set which+-- contains all keys that are members of both sets.+--+-- The worst-case performance occurs when the two sets are identical.+intersection :: Map map a => TrieSet map a -> TrieSet map a -> TrieSet map a+intersection = TS .: Base.intersectionWith+                        (error "TrieSet.intersection :: internal error")+                     `on` unTS++-- * Filtering++-- | @O(n m)@. The set of those keys in the set for which the given predicate+-- returns 'True'.+filter :: Map map a => ([a] -> Bool) -> TrieSet map a -> TrieSet map a+filter p = inTS $ Base.filterWithKey (\k _ -> p k)++-- | @O(n m)@. A pair of sets: the first element contains those keys for which+-- the given predicate returns 'True', and the second element contains those+-- for which it was 'False'.+partition :: Map map a+          => ([a] -> Bool) -> TrieSet map a -> (TrieSet map a, TrieSet map a)+partition p = both TS . Base.partitionWithKey (\k _ -> p k) . unTS++-- * Mapping++-- | @O(n m)@. Apply the given function to all the keys in the set.+map :: (Map map a, Map map b) => ([a] -> [b]) -> TrieSet map a -> TrieSet map b+map = inTS . Base.mapKeysWith Base.fromList++-- | @O(n m)@. Apply the given function to the contents of all the keys in the+-- set.+mapIn :: (Map map a, Map map b) => (a -> b) -> TrieSet map a -> TrieSet map b+mapIn = inTS . Base.mapInKeysWith defaultUnion++-- * Folding++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toList' representation.+foldr :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldr f = Base.foldrWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toAscList' representation.+foldrAsc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldrAsc f = Base.foldrAscWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldr@ on the 'toDescList' representation.+foldrDesc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldrDesc f = Base.foldrDescWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toList' representation.+foldl :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldl f = Base.foldlWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toAscList' representation.+foldlAsc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlAsc f = Base.foldlAscWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl@ on the 'toDescList' representation.+foldlDesc :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlDesc f = Base.foldlDescWithKey (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toList' representation.+foldl' :: Map map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldl' f = Base.foldlWithKey' (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toAscList' representation.+foldlAsc' :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlAsc' f = Base.foldlAscWithKey' (\k _ -> f k) .:. unTS++-- | @O(n m)@. Equivalent to a list @foldl'@ on the 'toDescList'+-- representation.+foldlDesc' :: OrdMap map a => ([a] -> b -> b) -> b -> TrieSet map a -> b+foldlDesc' f = Base.foldlDescWithKey' (\k _ -> f k) .:. unTS++-- * Conversion between lists++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- undefined order.+toList :: Map map a => TrieSet map a -> [[a]]+toList = Prelude.map fst . Base.toList . unTS++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- ascending order.+toAscList :: OrdMap map a => TrieSet map a -> [[a]]+toAscList = Prelude.map fst . Base.toAscList . unTS++-- | @O(n m)@. Converts the set to a list of the keys contained within, in+-- descending order.+toDescList :: OrdMap map a => TrieSet map a -> [[a]]+toDescList = Prelude.map fst . Base.toDescList . unTS++-- | @O(n m)@. Creates a set from a list of keys.+fromList :: Map map a => [[a]] -> TrieSet map a+fromList = TS . Base.fromList . Prelude.map (flip (,) True)++-- * Ordering ops++-- | @O(m)@. Removes and returns the minimal key in the set. If the set is+-- empty, 'Nothing' and the original set are returned.+minView :: OrdMap map a => TrieSet map a -> (Maybe [a], TrieSet map a)+minView = (fmap fst *** TS) . Base.minView . unTS++-- | @O(m)@. Removes and returns the maximal key in the set. If the set is+-- empty, 'Nothing' and the original set are returned.+maxView :: OrdMap map a => TrieSet map a -> (Maybe [a], TrieSet map a)+maxView = (fmap fst *** TS) . Base.maxView . unTS++-- | @O(m)@. Like 'fst' composed with 'minView'. 'Just' the minimal key in the+-- set, or 'Nothing' if the set is empty.+findMin :: OrdMap map a => TrieSet map a -> Maybe [a]+findMin = fmap fst . Base.findMin . unTS++-- | @O(m)@. Like 'fst' composed with 'maxView'. 'Just' the maximal key in the+-- set, or 'Nothing' if the set is empty.+findMax :: OrdMap map a => TrieSet map a -> Maybe [a]+findMax = fmap fst . Base.findMax . unTS++-- | @O(m)@. Like 'snd' composed with 'minView'. The set without its minimal+-- key, or the unchanged original set if it was empty.+deleteMin :: OrdMap map a => TrieSet map a -> TrieSet map a+deleteMin = inTS Base.deleteMin++-- | @O(m)@. Like 'snd' composed with 'maxView'. The set without its maximal+-- key, or the unchanged original set if it was empty.+deleteMax :: OrdMap map a => TrieSet map a -> TrieSet map a+deleteMax = inTS Base.deleteMax++-- | @O(min(m,s))@. Splits the set in two about the given key. The first+-- element of the resulting pair is a set containing the keys lesser than the+-- given key; the second contains those keys that are greater.+split :: OrdMap map a => [a] -> TrieSet map a -> (TrieSet map a, TrieSet map a)+split = both TS .: Base.split .:. unTS++-- | @O(min(m,s))@. Like 'split', but also returns whether the given key was a+-- member of the set or not.+splitMember :: OrdMap map a+            => [a] -> TrieSet map a -> (TrieSet map a, Bool, TrieSet map a)+splitMember = (\(l,b,g) -> (TS l,unwrap b,TS g)) .: Base.splitLookup .:. unTS++-- | @O(m)@. 'Just' the key of the set which precedes the given key in order,+-- or 'Nothing' if the set is empty.+findPredecessor :: OrdMap map a => [a] -> TrieSet map a -> Maybe [a]+findPredecessor = fmap fst .: Base.findPredecessor .:. unTS++-- | @O(m)@. 'Just' the key of the set which succeeds the given key in order,+-- or 'Nothing' if the set is empty.+findSuccessor :: OrdMap map a => [a] -> TrieSet map a -> Maybe [a]+findSuccessor = fmap fst .: Base.findSuccessor .:. unTS++-- * Trie-only operations++-- | @O(s)@. Prepends the given key to all the keys of the set. For example:+--+-- > addPrefix "pre" (fromList ["a","b"]) == fromList ["prea","preb"]+addPrefix :: Map map a => [a] -> TrieSet map a -> TrieSet map a+addPrefix = TS .: Base.addPrefix .:. unTS++-- | @O(m)@. The set which contains all keys of which the given key is a+-- prefix, with the prefix removed from each key. If the given key is not a+-- prefix of any key in the set, the set is returned unchanged. For example:+--+-- > deletePrefix "a" (fromList ["a","ab","ac"]) == fromList ["","b","c"]+--+-- This function can be used, for instance, to reduce potentially expensive I/O+-- operations: if you need to check whether a string is a member of a set, but+-- you only have a prefix of it and retrieving the rest is an expensive+-- operation, calling 'deletePrefix' with what you have might allow you to+-- avoid the operation: if the resulting set is empty, the entire string cannot+-- be a member of the set.+deletePrefix :: Map map a => [a] -> TrieSet map a -> TrieSet map a+deletePrefix = TS .: Base.deletePrefix .:. unTS++-- | @O(m)@. A triple containing the longest common prefix of all keys in the+-- set, whether that prefix was a member of the set, and the set with that+-- prefix removed from all the keys as well as the set itself. Examples:+--+-- > splitPrefix (fromList ["a","b"]) == ("", False, fromList ["a","b"])+-- > splitPrefix (fromList ["a","ab","ac"]) == ("a", True, fromList ["b","c"])+splitPrefix :: Map map a => TrieSet map a -> ([a], Bool, TrieSet map a)+splitPrefix = (\(k,b,t) -> (k,unwrap b,TS t)) . Base.splitPrefix . unTS++-- | @O(m)@. The children of the longest common prefix in the trie as sets,+-- associated with their distinguishing key value. If the set contains less+-- than two keys, this function will return the empty list. Examples;+--+-- > children (fromList ["a","abc","abcd"]) == [('b',fromList ["c","cd"])]+-- > children (fromList ["b","c"]) == [('b',fromList [""]),('c',fromList [""])]+children :: Map map a => TrieSet map a -> [(a, TrieSet map a)]+children = Prelude.map (second TS) . Base.children . unTS++-- * Visualization++-- | @O(n m)@. Displays the set's internal structure in an undefined way. That+-- is to say, no program should depend on the function's results.+showTrie :: (Show a, Map map a) => TrieSet map a -> ShowS+showTrie = Base.showTrieWith (\(Id b) -> showChar $ if b then 'X' else ' ')+         . unTS
+ Data/ListTrie/Set/Enum.hs view
@@ -0,0 +1,14 @@+-- File created: 2008-10-18 21:33:40++-- | A set of lists of enumerable elements, based on a trie.+--+-- Note that those operations which require an ordering, such as 'toAscList',+-- do not compare the elements themselves, but rather their Int representation+-- after 'fromEnum'.+module Data.ListTrie.Set.Enum (TrieSet, module Data.ListTrie.Set) where++import Data.ListTrie.Base.Map   (WrappedIntMap)+import Data.ListTrie.Set hiding (TrieSet)+import qualified Data.ListTrie.Set as Base++type TrieSet = Base.TrieSet WrappedIntMap
+ Data/ListTrie/Set/Eq.hs view
@@ -0,0 +1,11 @@+-- File created: 2009-01-06 13:26:03++-- | A set of lists of elements that can be compared for equality, based on a+-- trie.+module Data.ListTrie.Set.Eq (TrieSet, module Data.ListTrie.Set) where++import Data.ListTrie.Base.Map   (AList)+import Data.ListTrie.Set hiding (TrieSet)+import qualified Data.ListTrie.Set as Base++type TrieSet = Base.TrieSet AList
+ Data/ListTrie/Set/Ord.hs view
@@ -0,0 +1,10 @@+-- File created: 2009-01-06 13:18:32++-- | A set of lists of elements that can be totally ordered, based on a trie.+module Data.ListTrie.Set.Ord (TrieSet, module Data.ListTrie.Set) where++import Data.Map                 (Map)+import Data.ListTrie.Set hiding (TrieSet)+import qualified Data.ListTrie.Set as Base++type TrieSet = Base.TrieSet Map
+ Data/ListTrie/Util.hs view
@@ -0,0 +1,14 @@+-- File created: 2008-12-27 22:04:52++module Data.ListTrie.Util ((.:), (.:.), both) where++infixr 9 .:, .:.++(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)+(f .: g) x y = f (g x y)++(.:.) :: (a -> b -> c) -> (d -> b) -> (a -> d -> c)+(f .:. g) x y = f x (g y)++both :: (a -> b) -> (a,a) -> (b,b)+both f (a,b) = (f a, f b)
+ LICENSE.txt view
@@ -0,0 +1,24 @@+Copyright (c) 2009 Matti Niemenmaa
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+    * Redistributions in binary form must reproduce the above copyright
+      notice, this list of conditions and the following disclaimer in the
+      documentation and/or other materials provided with the distribution.
+    * Neither the name of the project nor the names of its contributors may be
+      used to endorse or promote products derived from this software without
+      specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
+OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ headers/docs.h view
@@ -0,0 +1,16 @@+-- File created: 2009-03-08 20:36:00++-- $trie-only-ops+--+-- Functions which utilize the unique structure of tries.+--+-- 'addPrefix' and 'deletePrefix' allow fast adding and removing of prefixes+-- to/from all keys of a trie.+--+-- 'splitPrefix' and 'children' allow traversing of a trie in a manner suitable+-- for its structure.++-- I would have most of the docs here but using #defines and relying on cpphs's+-- --layout flag is a pain due to+-- http://hackage.haskell.org/trac/hackage/ticket/519, and Haddock can't help+-- me until http://trac.haskell.org/haddock/ticket/97 gets attention.
+ headers/exports.h view
@@ -0,0 +1,134 @@+-- File created: 2008-12-30 18:33:18++#define SET_EXPORTS \+	{- * Set type -} \+	TrieSet, \+	{- * Construction -} \+	empty, singleton, \+	\+	{- * Modification -} \+	insert, delete, \+	\+	{- * Querying -} \+	null, size, size', member, notMember, \+	\+	{- ** Subsets -} \+	isSubsetOf, isProperSubsetOf, \+	\+	{- * Combination -} \+	union, unions, difference, intersection, \+	\+	{- * Filtering -} \+	filter, partition, \+	\+	{- * Mapping -} \+	map, mapIn, \+	\+	{- * Folding -} \+	foldr, foldrAsc, foldrDesc, \+	foldl, foldlAsc, foldlDesc, \+	foldl', foldlAsc', foldlDesc', \+	\+	{- * Conversion to and from lists -} \+	toList, toAscList, toDescList, fromList, \+	\+	{- * Ordering-sensitive operations -} \+	{- ** Minimum and maximum -} \+	minView, maxView, findMin, findMax, deleteMin, deleteMax, \+	\+	{- ** Predecessor and successor -} \+	split, splitMember, \+	findPredecessor, findSuccessor, \+	\+	{- * Trie-specific operations -} \+	{- $trie-only-ops -} \+	addPrefix, deletePrefix, splitPrefix, children, \+	\+	{- * Visualization -} \+	showTrie++#define MAP_EXPORTS \+	{- * Map type -} \+	TrieMap, \+	\+	{- * Construction -} \+	empty, singleton, \+	\+	{- * Modification -} \+	insert, insert', insertWith, insertWith', \+	delete, \+	update, updateLookup, \+	adjust, adjust', alter, alter', \+	\+	{- * Querying -} \+	null, size, size', member, notMember, \+	lookup, lookupWithDefault, \+	\+	{- ** Submaps -} \+	isSubmapOf, isSubmapOfBy, \+	isProperSubmapOf, isProperSubmapOfBy, \+	\+	{- * Combination -} \+	{- ** Union -} \+	union, union', unions, unions', \+	unionWith,  unionWithKey,  unionsWith,  unionsWithKey, \+	unionWith', unionWithKey', unionsWith', unionsWithKey', \+	\+	{- ** Difference -} \+	difference, differenceWith, differenceWithKey, \+	\+	{- ** Intersection -} \+	intersection, intersection', \+	intersectionWith,  intersectionWithKey, \+	intersectionWith', intersectionWithKey', \+	\+	{- * Filtering -} \+	filter, filterWithKey, partition, partitionWithKey, \+	mapMaybe, mapMaybeWithKey, mapEither, mapEitherWithKey, \+	\+	{- * Mapping -} \+	{- ** Values -} \+	map, map', mapWithKey, mapWithKey', \+	\+	{- ** Keys -} \+	mapKeys, mapKeysWith, \+	mapInKeys, mapInKeys', mapInKeysWith, mapInKeysWith', \+	\+	{- ** With accumulation -} \+	mapAccum,      mapAccumWithKey, \+	mapAccum',     mapAccumWithKey', \+	mapAccumAsc,   mapAccumAscWithKey, \+	mapAccumAsc',  mapAccumAscWithKey', \+	mapAccumDesc,  mapAccumDescWithKey, \+	mapAccumDesc', mapAccumDescWithKey', \+	\+	{- * Folding -} \+	foldr, foldrWithKey, \+	foldrAsc, foldrAscWithKey, \+	foldrDesc, foldrDescWithKey, \+	foldl, foldlWithKey, \+	foldlAsc, foldlAscWithKey, \+	foldlDesc, foldlDescWithKey, \+	foldl', foldlWithKey', \+	foldlAsc', foldlAscWithKey', \+	foldlDesc', foldlDescWithKey', \+	\+	{- * Conversion to and from lists -} \+	toList, toAscList, toDescList, fromList, \+	fromListWith,  fromListWithKey, \+	fromListWith', fromListWithKey', \+	\+	{- * Ordering-sensitive operations -} \+	{- ** Minimum and maximum -} \+	minView, maxView, findMin, findMax, deleteMin, deleteMax, \+	\+	{- ** Predecessor and successor -} \+	split, splitLookup, \+	findPredecessor, findSuccessor, \+	\+	{- * Trie-specific operations -} \+	{- $trie-only-ops -} \+	addPrefix, deletePrefix, splitPrefix, children, \+	\+	{- * Visualization -} \+	showTrie, showTrieWith
+ list-tries.cabal view
@@ -0,0 +1,79 @@+Cabal-Version: >= 1.6++Name:        list-tries+Version:     0.0+Homepage:    http://iki.fi/matti.niemenmaa/list-tries/+Synopsis:    Tries and Patricia tries: finite sets and maps for list keys+Category:    Data, Data Structures+Stability:   provisional+Description:+   This library provides implementations of finite sets and maps for list keys+   using tries, both simple and of the Patricia kind. In most (or all? sorry,+   haven't benchmarked yet) cases, the Patricia tries will have better+   performance, so use them unless you have reasons not to.+   .+   The data types are parametrized over the map type they use internally to+   store the child nodes: this allows extending them to support different kinds+   of key types or increasing efficiency. Child maps are required to be+   instances of the Map class in Data.ListTrie.Base.Map. Some operations+   additionally require an OrdMap instance.+   .+   The Eq, Ord, and Enum modules contain ready structures for key types which+   are instances of those classes, using lists of pairs, Data.Map, and+   Data.IntMap respectively.++Author:       Matti Niemenmaa+Maintainer:   Matti Niemenmaa <matti.niemenmaa+list-tries@iki.fi>+License:      BSD3+License-File: LICENSE.txt++Build-Type: Simple++Extra-Source-Files: headers/*.h+                    tests/README.txt+                    tests/*.hs+                    tests/Tests/*.hs++Flag containers03+   Description: Assume that containers has a version number of at least 0.3. If+                false, some functionality cannot be implemented and is changed+                to call 'error' instead. Defaults to False as such a version+                hasn't yet been released.+   Default: False++Library+   Extensions: CPP++   if flag(containers03)+      Build-Depends: base       >= 3 && < 4.1+                   , containers >= 0.3 && < 0.4+                   , dlist      == 0.4.*+   else+      Build-Depends: base       >= 3 && < 4.1+                   , containers >= 0.2 && < 0.3+                   , dlist      == 0.4.*++   Exposed-Modules: Data.ListTrie.Base.Map+                    Data.ListTrie.Map+                    Data.ListTrie.Map.Eq+                    Data.ListTrie.Map.Ord+                    Data.ListTrie.Map.Enum+                    Data.ListTrie.Set+                    Data.ListTrie.Set.Eq+                    Data.ListTrie.Set.Ord+                    Data.ListTrie.Set.Enum+                    Data.ListTrie.Patricia.Map+                    Data.ListTrie.Patricia.Map.Eq+                    Data.ListTrie.Patricia.Map.Ord+                    Data.ListTrie.Patricia.Map.Enum+                    Data.ListTrie.Patricia.Set+                    Data.ListTrie.Patricia.Set.Eq+                    Data.ListTrie.Patricia.Set.Ord+                    Data.ListTrie.Patricia.Set.Enum+   Other-Modules:   Data.ListTrie.Base+                    Data.ListTrie.Base.Classes+                    Data.ListTrie.Base.Map.Internal+                    Data.ListTrie.Patricia.Base+                    Data.ListTrie.Util++   Include-Dirs: headers
+ tests/Main.hs view
@@ -0,0 +1,24 @@+-- File created: 2009-01-06 12:56:34++module Main (main) where++import System.Environment (getArgs)+import Test.Framework++import qualified Tests.Cases      as Cases+import qualified Tests.Properties as Properties+import qualified Tests.Strictness as Strictness++main = do+   args <- getArgs+   defaultMainWithArgs tests . concat $+      [ ["--timeout", show 10]+      , ["--maximum-generated-tests", show 200]+      , args+      ]++tests =+   [ Cases.tests+   , Properties.tests+   , Strictness.tests+   ]
+ tests/README.txt view
@@ -0,0 +1,18 @@+These are the tests for the Tries library by Matti Niemenmaa, and should reside+in a subdirectory of the Tries distribution.++To run the tests, run 'Main.hs'.++You'll need the following packages, other versions may work but haven't been+tested:++  base                       == 4.*+, HUnit                      == 1.2.*+, QuickCheck                 == 2.1.*+, test-framework             == 0.2.*+, test-framework-hunit       == 0.2.*+, test-framework-quickcheck2 == 0.2.*+, ChasingBottoms             == 1.2.*++In addition, unlike the library itself, no attempt has been made to make sure+that the tests would work with anything other than GHC.
+ tests/Tests/Base.hs view
@@ -0,0 +1,53 @@+-- File created: 2009-01-06 13:01:36++{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances+           , FunctionalDependencies, FlexibleContexts #-}++module Tests.Base (Str(..), alpha, unArb, getKey) where++import Control.Arrow   (first)+import Test.QuickCheck (Arbitrary(arbitrary, shrink), sized, choose)++import Data.ListTrie.Base.Map (Map)+import qualified Data.ListTrie.Set          as  BS+import qualified Data.ListTrie.Map          as  BM+import qualified Data.ListTrie.Patricia.Set as PBS+import qualified Data.ListTrie.Patricia.Map as PBM++newtype Str = Str { unStr :: String } deriving Show++alpha = ('0','9')++instance Arbitrary Str where+   arbitrary = sized $ \size -> do+      s <- mapM (const $ choose alpha) [0..size `mod` 6]+      return (Str s)++   shrink (Str s) = map Str (shrink s)++instance Map map Char => Arbitrary ( BS.TrieSet map Char) where+   arbitrary = fmap ( BS.fromList . map unArb) arbitrary+instance Map map Char => Arbitrary (PBS.TrieSet map Char) where+   arbitrary = fmap (PBS.fromList . map unArb) arbitrary+instance (Map map Char, Arbitrary a) => Arbitrary ( BM.TrieMap map Char a)+ where+   arbitrary = fmap ( BM.fromList . map unArb) arbitrary+instance (Map map Char, Arbitrary a) => Arbitrary (PBM.TrieMap map Char a)+ where+   arbitrary = fmap (PBM.fromList . map unArb) arbitrary++--------- HACKS TO MAKE LIFE EASY++-- Some classes that allow us to convert between Str and String for both Sets+-- (where we're interested only in Str) and Maps (where it's (Str,value))+-- without having to write the functions twice, adding complexity either to+-- them or to TH.++class UnArbitrary a b | b -> a where unArb :: a -> b++instance UnArbitrary Str [Char] where unArb = unStr+instance UnArbitrary (Str,c) ([Char],c) where unArb = first unStr++class GetKey a where getKey :: a -> String+instance GetKey [Char] where getKey = id+instance GetKey ([Char],a) where getKey = fst
+ tests/Tests/Cases.hs view
@@ -0,0 +1,191 @@+-- File created: 2009-01-16 18:54:26++{-# LANGUAGE TemplateHaskell #-}++module Tests.Cases (tests) where++import Control.Monad                  (join)+import Test.Framework                 (testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit                     (assert)++import qualified Data.ListTrie.Set.Eq+import qualified Data.ListTrie.Set.Ord+import qualified Data.ListTrie.Set.Enum+import qualified Data.ListTrie.Map.Eq+import qualified Data.ListTrie.Map.Ord+import qualified Data.ListTrie.Map.Enum+import qualified Data.ListTrie.Patricia.Set.Eq+import qualified Data.ListTrie.Patricia.Set.Ord+import qualified Data.ListTrie.Patricia.Set.Enum+import qualified Data.ListTrie.Patricia.Map.Eq+import qualified Data.ListTrie.Patricia.Map.Ord+import qualified Data.ListTrie.Patricia.Map.Enum++import Data.ListTrie.Util++import Tests.TH++$(makeFunc allTries ["null","empty"] [d|+   nullEmpty null empty = null (empty :: TrieType)+ |])++-- "foo" is obviously not equal to "fo"+$(makeFunc setsOnly ["singleton"] [d|+   eq1_s singleton = singleton "foo" /= (singleton "fo" :: TrieType)+ |])+$(makeFunc mapsOnly ["singleton"] [d|+   eq1_m singleton = singleton "foo" 0 /= (singleton "fo" 0 :: TrieType)+ |])++-- eq1 via compare instead of ==+$(makeFunc setsOnly ["singleton"] [d|+   ord1_s singleton =+      compare (singleton "foo") (singleton "fo" :: TrieType) == GT+ |])+$(makeFunc mapsOnly ["singleton"] [d|+   ord1_m singleton =+      compare (singleton "foo" 0) (singleton "fo" 0 :: TrieType) == GT+ |])++-- Subset/map tests where the maps aren't identical or empty, couldn't think of+-- a good property for such cases+$(makeFunc setsOnly ["fromList","isSubsetOf"] [d|+   isSubsetOf1 fromList isSubsetOf =+      (fromList ["cameroon","camera"] :: TrieType)+      `isSubsetOf`+      fromList ["cameroon","camera","camel","camouflage","cat"]+ |])+$(makeFunc setsOnly ["fromList","isSubsetOf"] [d|+   isSubsetOf2 fromList isSubsetOf =+      not $+         (fromList ["cameroon","camera","came"] :: TrieType)+         `isSubsetOf`+         fromList ["cameroon","camera","camel","camouflage","cat"]+ |])+$(makeFunc mapsOnly ["fromList","isSubmapOf"] [d|+   isSubmapOf1 fromList isSubmapOf =+      not $+         (fromList (zip ["cameroon","camera","came"] [0..]) :: TrieType)+         `isSubmapOf`+         fromList (zip ["cameroon","camera","camel","camouflage","cat"] [0..])+ |])++-- Simple tests for alter to up the code coverage a bit+$(makeFunc mapsOnly ["fromList","alter"] [d|+   alter1 fromList alter =+      alter (\Nothing -> Just 42) "foo" (fromList [("foobar",0)] :: TrieType)+      == fromList [("foo",42),("foobar",0)]+ |])+$(makeFunc mapsOnly ["fromList","alter"] [d|+   alter2 fromList alter =+      let x = fromList [("xxx",0)] :: TrieType+       in alter id "x" x == x+ |])++-- Make sure insertWith applies the combining function in the right order+$(makeFunc mapsOnly ["singleton","insertWith"] [d|+   insertWith1 singleton insertWith =+      insertWith (-) [] 3 (singleton [] 1) == (singleton [] 2 :: TrieType)+ |])++-- And the same for fromListWith+$(makeFunc mapsOnly ["singleton","fromListWith"] [d|+   fromListWith1 singleton fromListWith =+      fromListWith (-) (zip (repeat []) [1..4]) ==+         (singleton [] 2 :: TrieType)+ |])++-- A couple of simple sanity tests for the *WithKey set operations since they+-- don't have properties at all+$(makeFunc mapsOnly ["fromList","unionWithKey"] [d|+   unionWithKey1 fromList unionWithKey =+      let al = ["tom","tome","tomatoes","fork"]+          bl = ["tom","tomb","tomes","tomato","fark"]+          a = fromList $ zip al [1..] :: TrieType+          b = fromList $ zip bl [length al..]+       in unionWithKey (\k vl vr -> vl - vr + length k) a b+          == fromList (("tom",3+1-length al) : zip (tail al ++ tail bl) [2..])+ |])+$(makeFunc mapsOnly ["fromList","differenceWithKey"] [d|+   differenceWithKey1 fromList differenceWithKey =+      let al = ["tom","tome","tomatoes","fork"]+          bl = ["tom","tomb","tomes","tomato","fark"]+          a = fromList $ zip al [1..] :: TrieType+          b = fromList $ zip bl [length al..]+       in differenceWithKey (\k vl vr -> Just $ vl - vr + length k) a b+          == fromList (("tom",3+1-length al) : zip (tail al) [2..])+ |])+$(makeFunc mapsOnly ["fromList","differenceWithKey"] [d|+   differenceWithKey2 fromList differenceWithKey =+      let al = ["shiner","shine"]+          bl = ["shiner","shin","shiners","shoe"]+          a = fromList $ zip al [1..] :: TrieType+          b = fromList $ zip bl [length al..]+       in differenceWithKey (\k vl vr -> Just $ vl - vr + length k) a b+          == fromList (("shiner",6+1-length al) : zip (tail al) [2..])+ |])+$(makeFunc mapsOnly ["fromList","differenceWithKey"] [d|+   differenceWithKey3 fromList differenceWithKey =+      let al = ["mar","marks","marksman","marksman's bow"]+          bl = ["mark","marksman's","marksman's bow"]+          a = fromList $ zip al [1..] :: TrieType+          b = fromList $ zip bl [length al..]+       in differenceWithKey (\_ _ _ -> Nothing) a b+          == fromList (zip (init al) [1..])+ |])+$(makeFunc mapsOnly ["fromList","intersectionWithKey"] [d|+   intersectionWithKey1 fromList intersectionWithKey =+      let al = ["cat","caterers","caterwauling","caterer"]+          bl = ["cat","caterers","c","caterwauler"]+          a = fromList $ zip al [1..] :: TrieType+          b = fromList $ zip bl [length al..]+       in intersectionWithKey (\k vl vr -> length k - vl + vr) a b+          == fromList (zip ["cat","caterers"] $+                zipWith3 (join (.:) (+) . negate)+                         [1..] [length al..] (map length al))+ |])+$(makeFunc mapsOnly ["fromList","intersectionWithKey"] [d|+   intersectionWithKey2 fromList intersectionWithKey =+      let al = ["wa","wart","wartortle"]+          bl = ["w","wartor","wartortles","wartortle army"]+          a = fromList $ zip al [1..]+          b = fromList $ zip bl [length al..]+       in intersectionWithKey undefined a b == (fromList [] :: TrieType)+ |])++-- children should return something nonempty even if there's only one path+-- through the trie+$(makeFunc setsOnly ["fromList","children"] [d|+   children1_s fromList children =+      children (fromList ["foo","foobar"] :: TrieType) ==+         [('b',fromList ["ar"])]+ |])+$(makeFunc mapsOnly ["fromList","children"] [d|+   children1_m fromList children =+      children (fromList [("foo",1),("foobar",2)] :: TrieType) ==+         [('b',fromList [("ar",2)])]+ |])++tests = testGroup "Individual cases"+   [ $(makeCases allTries "nullEmpty")+   , $(makeCases setsOnly "eq1_s")+   , $(makeCases mapsOnly "eq1_m")+   , $(makeCases setsOnly "ord1_s")+   , $(makeCases mapsOnly "ord1_m")+   , $(makeCases setsOnly "isSubsetOf1")+   , $(makeCases setsOnly "isSubsetOf2")+   , $(makeCases mapsOnly "isSubmapOf1")+   , $(makeCases mapsOnly "alter1")+   , $(makeCases mapsOnly "alter2")+   , $(makeCases mapsOnly "insertWith1")+   , $(makeCases mapsOnly "fromListWith1")+   , $(makeCases mapsOnly "unionWithKey1")+   , $(makeCases mapsOnly "differenceWithKey1")+   , $(makeCases mapsOnly "differenceWithKey2")+   , $(makeCases mapsOnly "differenceWithKey3")+   , $(makeCases mapsOnly "intersectionWithKey1")+   , $(makeCases mapsOnly "intersectionWithKey2")+   , $(makeCases setsOnly "children1_s")+   , $(makeCases mapsOnly "children1_m")+   ]
+ tests/Tests/Properties.hs view
@@ -0,0 +1,536 @@+-- File created: 2009-01-06 12:59:53++{-# LANGUAGE TemplateHaskell, NoMonomorphismRestriction #-}++module Tests.Properties (tests) where++import Control.Arrow    ((&&&), first)+import Data.Foldable    (foldMap)+import Data.Function    (on)+import Data.List        (nubBy)+import Data.Maybe       (fromJust, isNothing)+import Data.Monoid      (mappend, mempty)+import Data.Traversable (fmapDefault, foldMapDefault)++import Test.Framework                       (testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.QuickCheck                      ((==>))++import qualified Data.ListTrie.Set.Eq+import qualified Data.ListTrie.Set.Ord+import qualified Data.ListTrie.Set.Enum+import qualified Data.ListTrie.Map.Eq+import qualified Data.ListTrie.Map.Ord+import qualified Data.ListTrie.Map.Enum+import qualified Data.ListTrie.Patricia.Set.Eq+import qualified Data.ListTrie.Patricia.Set.Ord+import qualified Data.ListTrie.Patricia.Set.Enum+import qualified Data.ListTrie.Patricia.Map.Eq+import qualified Data.ListTrie.Patricia.Map.Ord+import qualified Data.ListTrie.Patricia.Map.Enum++import Tests.Base+import Tests.TH++keyNub = nubBy ((==) `on` getKey)++-- List of tests is at the bottom because it doesn't work at the top: looks+-- like a TH limitation.++-- The size of a set built from a list should be <= the length of the list+$(makeFunc allTries ["fromList","size"] [d|+   prop_size1 fromList size l_ = let l = map unArb l_+                                  in size (fromList l :: TrieType) <= length l_+ |])++-- The size of a set should be == its length in list form+$(makeFunc allTries ["toList","size"] [d|+   prop_size2 toList size m = size (m :: TrieType) == length (toList m)+ |])++-- A set built from a list should include all elements of the original list+$(makeFunc allTries ["fromList","member"] [d|+  -- using flip avoids GHC #2956+  prop_member1 fromList member l_ =+     let l = map unArb l_+         m = fromList l :: TrieType+      in all (flip member m . getKey) (l :: [ListElemType])+ |])++-- A map built from a list should have the same key/value pairs as the list+-- Of course the list needs to be nubbed; and in case of duplicates the last+-- value is preferred, so reversed+$(makeFunc mapsOnly ["fromList","lookup"] [d|+   prop_lookup1 fromList lookup l_ =+      let l = map unArb l_+          m = fromList l :: TrieType+       in all (\(k,v) -> fromJust (lookup k m) == v) (keyNub . reverse $ l)+ |])++-- lookupWithDefault should return the default if the key is not a member of+-- the map+$(makeFunc mapsOnly ["lookupWithDefault","notMember"] [d|+   prop_lookupWithDefault1 lookupWithDefault notMember m k_ v =+      let k = unArb k_+       in notMember k (m :: TrieType) ==> lookupWithDefault v k m == v+ |])++-- Sets/maps should be subsets/submaps of themselves+$(makeFunc setsOnly ["isSubsetOf"] [d|+   prop_isSubsetOf1 isSubsetOf m = isSubsetOf m (m :: TrieType)+ |])+$(makeFunc mapsOnly ["isSubmapOf"] [d|+   prop_isSubmapOf1 isSubmapOf m = isSubmapOf m (m :: TrieType)+ |])++-- Sets/maps should not be proper subsets/submaps of themselves+$(makeFunc setsOnly ["isProperSubsetOf"] [d|+   prop_isProperSubsetOf1 isProperSubsetOf m =+      not (isProperSubsetOf m (m :: TrieType))+ |])+$(makeFunc mapsOnly ["isProperSubmapOf"] [d|+   prop_isProperSubmapOf1 isProperSubmapOf m =+      not (isProperSubmapOf m (m :: TrieType))+ |])++$(makeFunc setsOnly ["isSubsetOf", "isProperSubsetOf"] [d|+   prop_isProperSubsetOf2 isSubsetOf isProperSubsetOf m n =+      if isProperSubsetOf m n+         then isSubsetOf m (n :: TrieType)+         else True+ |])+$(makeFunc mapsOnly ["isSubmapOf", "isProperSubmapOf"] [d|+   prop_isProperSubmapOf2 isSubmapOf isProperSubmapOf m n =+      if isProperSubmapOf m n+         then isSubmapOf (m :: TrieType) (n :: TrieType)+         else True+ |])++-- Looking up a singleton's key in a singleton should return the singleton's+-- value+$(makeFunc mapsOnly ["lookup","singleton"] [d|+   prop_singleton1 lookup singleton k_ v =+      let k = unArb k_+       in (fromJust . lookup k) (singleton k v :: TrieType) == v+ |])++-- Inserting a value into a map and then looking it up should return that value+-- (note: regardless of whether it was there previously, the new value should+-- overwrite)+$(makeFunc mapsOnly ["lookup","insert"] [d|+   prop_insert1 lookup insert m k_ v =+      let k = unArb k_+       in (fromJust . lookup k . insert k v) (m :: TrieType) == v+ |])++-- Inserting into empty is the same thing as a singleton+$(makeFunc setsOnly ["empty","insert","singleton"] [d|+   prop_insert2_s empty insert singleton k_ =+      let k = unArb k_+       in insert k empty == (singleton k :: TrieType)+ |])+$(makeFunc mapsOnly ["empty","insert","singleton"] [d|+   prop_insert2_m empty insert singleton k_ v =+      let k = unArb k_+       in insert k v empty == (singleton k v :: TrieType)+ |])++-- Deleting a key means it should no longer be in the set+$(makeFunc allTries ["notMember","delete"] [d|+   prop_delete1 notMember delete k_ m =+      let k = unArb k_+       in notMember k . delete k $ (m :: TrieType)+ |])++-- Altering a value within a map and then looking it up is the same as first+-- looking it up and then altering it: lookup k (alter f k m) == f (lookup k m)+$(makeFunc mapsOnly ["alter","lookup"] [d|+   prop_alter1 alter lookup k_ m =+      let k = unArb k_+       in lookup k (alter (const Nothing) k m :: TrieType) == Nothing+ |])+$(makeFunc mapsOnly ["alter","lookup"] [d|+   prop_alter2 alter lookup k_ m =+      let k = unArb k_+       in lookup k (alter (const (Just 2)) k m :: TrieType) == Just 2+ |])+$(makeFunc mapsOnly ["alter","lookup"] [d|+   prop_alter3 alter lookup k_ m =+      let k = unArb k_+       in lookup k (alter (fmap ((+) 1)) k m :: TrieType)+          == fmap ((+) 1) (lookup k m)+ |])++-- updateLookup (const Nothing) is equivalent to lookup &&& delete+--+-- Run on head.toList as well to make sure that the key's actually in there+--+-- Avoids #2956+$(makeFunc mapsOnly ["updateLookup","lookup","delete","toList","null"] [d|+   prop_updateLookup1 updateLookup lookup delete toList null k_ m =+      check (unArb k_) && (null m || check (getKey.head.toList $ m))+    where+      check k =+         updateLookup (const Nothing) k (m :: TrieType)+            == (lookup k &&& delete k) m+ |])+-- updateLookup (Just . f) is equivalent to lookup &&& adjust f+--+-- Run on head.toList as well to make sure that the key's actually in there+--+-- Avoids #2956+$(makeFunc mapsOnly ["updateLookup","lookup","adjust","toList","null"] [d|+   prop_updateLookup2 updateLookup lookup adjust toList null k_ m =+      check (unArb k_) && (null m || check (getKey.head.toList $ m))+    where+      check k =+         updateLookup (Just . (+) 1) k (m :: TrieType)+            == (lookup k &&& adjust ((+) 1) k) m+ |])++-- A union should include all keys of the original sets+$(makeFunc allTries ["union","member","toList"] [d|+   prop_union1 union member toList m n =+      let u = union m (n :: TrieType)+       in all (flip member u . getKey) (toList m ++ toList n)+ |])++-- Union with empty is the identity function+$(makeFunc allTries ["union","empty"] [d|+   prop_union2 union empty m = union m empty == (m :: TrieType)+ |])+$(makeFunc allTries ["union","empty"] [d|+   prop_union3 union empty m = union empty m == (m :: TrieType)+ |])++-- Difference with oneself should result in an empty set+$(makeFunc allTries ["null","difference"] [d|+   prop_difference1 null difference m = null (difference m (m :: TrieType))+ |])++-- Difference with empty is the identity function+$(makeFunc allTries ["empty","difference"] [d|+   prop_difference2 difference empty m = difference (m :: TrieType) empty == m+ |])++-- Difference of anything from empty should stay empty+$(makeFunc allTries ["empty","difference","null"] [d|+   prop_difference3 difference empty null m =+      null $ difference empty (m :: TrieType)+ |])++-- Intersection with oneself is the identity function+$(makeFunc allTries ["intersection"] [d|+   prop_intersection1 intersection m = intersection m m == (m :: TrieType)+ |])++-- Intersection with empty should result in the empty set+$(makeFunc allTries ["intersection","null","empty"] [d|+   prop_intersection2 intersection null empty m =+      null $ intersection empty (m :: TrieType)+ |])++-- De Morgan's laws: union and intersection interchange under complementation+$(makeFunc allTries ["union","difference","intersection"] [d|+   prop_deMorgan1 union difference intersection a b c =+      complement (intersection a b) == union (complement a) (complement b)+    where+      complement :: TrieType -> TrieType+      complement = difference c+ |])+$(makeFunc allTries ["union","difference","intersection"] [d|+   prop_deMorgan2 union difference intersection a b c =+      complement (union a b) == intersection (complement a) (complement b)+    where+      complement :: TrieType -> TrieType+      complement = difference c+ |])++-- Partition is equivalent to two filters+--+-- #2956 avoidance+$(makeFunc mapsOnly ["filter","partition"] [d|+   prop_partition1 filter partition m =+      let (a,b) = partition p (m :: TrieType)+       in a == filter p m && b == filter (not.p) m+    where+      p = (==) 0 . flip mod 2+ |])++-- mapMaybe can function as a filter and mapEither as a partition+--+-- #2956 avoidance+$(makeFunc mapsOnly ["mapMaybe","filter"] [d|+   prop_mapMaybe1 mapMaybe filter m =+      mapMaybe (\x -> if p x then Just x else Nothing) m+         == filter p (m :: TrieType)+    where+      p = (==) 0 . flip mod 2+ |])+$(makeFunc mapsOnly ["mapEither","partition"] [d|+   prop_mapEither1 mapEither partition m =+      mapEither (\x -> if p x then Left x else Right x) m+         == partition p (m :: TrieType)+    where+      p = (==) 0 . flip mod 2+ |])++-- The maximum of the left side of a split about k is the predecessor of k+$(makeFunc allTries ["split","findMax","findPredecessor"] [d|+   prop_splitMaxPredecessor split findMax findPredecessor m k_ =+      let k = unArb k_+          (a,_) = split k (m :: TrieType)+       in findMax a == findPredecessor k m+ |])+-- The minimum of the right side of a split about k is the successor of k+$(makeFunc allTries ["split","findMin","findSuccessor"] [d|+   prop_splitMinSuccessor split findMin findSuccessor m k_ =+      let k = unArb k_+          (_,b) = split k (m :: TrieType)+       in findMin b == findSuccessor k m+ |])++-- The centre of a splitLookup/Member is the result of a lookup/member+$(makeFunc mapsOnly ["splitLookup","lookup"] [d|+   prop_splitLookup1 splitLookup lookup m k_ =+      let k = unArb k_+          (_,v,_) = splitLookup k (m :: TrieType)+       in v == lookup k m+ |])+$(makeFunc setsOnly ["splitMember","member"] [d|+   prop_splitMember1 splitMember member m k_ =+      let k = unArb k_+          (_,v,_) = splitMember k (m :: TrieType)+       in v == member k m+ |])++-- toList (map trie) should be equivalent to map (toList trie)+-- modulo ordering, hence toAscList+--+-- #2956 avoidance+$(makeFunc setsOnly ["map","toAscList"] [d|+   prop_mapKeys1_s map toAscList m =+      toAscList (map f (m :: TrieType)) ==+         keyNub (Prelude.map f $ toAscList m)+    where f = (:) 'x'+ |])+$(makeFunc mapsOnly ["mapKeys","toAscList"] [d|+   prop_mapKeys1_m mapKeys toAscList m =+      toAscList (mapKeys f (m :: TrieType)) ==+         keyNub (Prelude.map (first f) $ toAscList m)+    where f = (:) 'x'+ |])+$(makeFunc setsOnly ["mapIn","toAscList"] [d|+   prop_mapInKeys1_s mapIn toAscList m =+      toAscList (mapIn f (m :: TrieType)) ==+         keyNub (map (map f) $ toAscList m)+    where f = toEnum . (+) 1 . fromEnum :: Char -> Char+ |])+$(makeFunc mapsOnly ["mapInKeys","toAscList"] [d|+   prop_mapInKeys1_m mapInKeys toAscList m =+      toAscList (mapInKeys f (m :: TrieType)) ==+         keyNub (map (first (map f)) $ toAscList m)+    where f = toEnum . (+) 1 . fromEnum :: Char -> Char+ |])++-- toAscList = reverse . toDescList+$(makeFunc allTries ["toAscList","toDescList"] [d|+   prop_ascDesc1 toAscList toDescList m =+      toAscList (m :: TrieType) == reverse (toDescList m)+ |])++-- min/maxView should be equivalent to separately finding and deleting the+-- min/max+$(makeFunc allTries ["minView","findMin","deleteMin"] [d|+   prop_minView1 minView findMin deleteMin m =+      minView m == (findMin &&& deleteMin) (m :: TrieType)+ |])+$(makeFunc allTries ["maxView","findMax","deleteMax"] [d|+   prop_maxView1 maxView findMax deleteMax m =+      maxView m == (findMax &&& deleteMax) (m :: TrieType)+ |])++-- [] has no predecessor+$(makeFunc allTries ["findPredecessor"] [d|+   prop_findPredecessor1 findPredecessor m =+      isNothing (findPredecessor [] (m :: TrieType))+ |])++-- The successor of [] is the minimum (unless [] itself is the minimum)+$(makeFunc allTries ["findSuccessor","findMin","notMember","null"] [d|+   prop_findSuccessor1 findSuccessor findMin notMember null m =+      not (null m) && notMember [] m ==>+         findSuccessor [] (m :: TrieType) == findMin m+ |])++-- The minimum has no predecessor+$(makeFunc allTries ["findPredecessor","findMin","null"] [d|+   prop_findPredecessor2 findPredecessor findMin null m =+      not (null m) ==>+         isNothing $ findPredecessor (getKey.fromJust.findMin $ m)+                                     (m :: TrieType)+ |])+-- The maximum has no successor+$(makeFunc allTries ["findSuccessor","findMax","null"] [d|+   prop_findSuccessor2 findSuccessor findMax null m =+      not (null m) ==>+         isNothing $ findSuccessor (getKey.fromJust.findMax $ m)+                                   (m :: TrieType)+ |])++-- Splitting away the common prefix and adding it and its value back+-- should change nothing+$(makeFunc setsOnly ["addPrefix","splitPrefix","insert"] [d|+   prop_prefixOps1_s addPrefix splitPrefix insert m =+      let (k,b,t) = splitPrefix (m :: TrieType)+       in (if b then insert k else id) (addPrefix k t) == m+ |])+$(makeFunc mapsOnly ["addPrefix","splitPrefix","insert"] [d|+   prop_prefixOps1_m addPrefix splitPrefix insert m =+      let (k,mv,t) = splitPrefix (m :: TrieType)+       in (case mv of Just v -> insert k v; _ -> id) (addPrefix k t) == m+ |])++-- Looking up the common prefix and then adding it back should change nothing+$(makeFunc allTries ["addPrefix","splitPrefix","deletePrefix"] [d|+   prop_prefixOps2 addPrefix splitPrefix deletePrefix m =+      let (k,_,_) = splitPrefix (m :: TrieType)+       in addPrefix k (deletePrefix k m) == m+ |])++-- Splitting away the prefix shouldn't affect the children+$(makeFunc allTries ["splitPrefix","children"] [d|+   prop_prefixOps3 splitPrefix children t =+      let (_,_,t') = splitPrefix (t :: TrieType)+       in children t == children t'+ |])++-- Adding the common prefix and value to the union of the children should give+-- back the original trie+$(makeFunc setsOnly ["addPrefix","splitPrefix","children","unions","insert"]+ [d|+   prop_prefixOps4_s addPrefix splitPrefix children unions insert t =+      let (k,b,_) = splitPrefix (t :: TrieType)+       in t == ((if b then insert k else id) . addPrefix k .+                   unions $ map (uncurry $ addPrefix . return)+                                (children t))+ |])+$(makeFunc mapsOnly ["addPrefix","splitPrefix","children","unions","insert"]+ [d|+   prop_prefixOps4_m addPrefix splitPrefix children unions insert t =+      let (k,mv,_) = splitPrefix (t :: TrieType)+       in t == ((case mv of Just v -> insert k v; _ -> id) . addPrefix k .+                   unions $ map (uncurry $ addPrefix . return)+                                (children t))+ |])++-- The monoid laws: associativity, left identity, right identity+$(makeFunc allTries [] [d|+   prop_monoidLaw1 x y z =+      mappend x (mappend y z) == mappend (mappend x y) (z :: TrieType)+ |])+$(makeFunc allTries [] [d|+   prop_monoidLaw2 x = mappend mempty x == (x :: TrieType)+ |])+$(makeFunc allTries [] [d|+   prop_monoidLaw3 x = mappend x mempty == (x :: TrieType)+ |])++-- The functor laws: fmap id == id, fmap (f.g) == (fmap f . fmap g)+$(makeFunc mapsOnly [] [d|+   prop_functorLaw1 x = fmap id x == (x :: TrieType)+ |])+$(makeFunc mapsOnly [] [d|+   prop_functorLaw2 x = fmap (f.g) x == (fmap f . fmap g) (x :: TrieType)+    where+      f = (+) 10; g = (*) 2;+ |])++-- The Traversable laws: fmap == fmapDefault, foldMap == foldMapDefault+-- Both avoid #2956 again+$(makeFunc mapsOnly [] [d|+   prop_traversableLaw1 x =+      fmap ((+) 1) x == fmapDefault ((+) 1) (x :: TrieType)+ |])+$(makeFunc mapsOnly [] [d|+   prop_traversableLaw2 x =+      foldMap (flip (:) []) x == foldMapDefault (flip (:) []) (x :: TrieType)+ |])++-- (read.show) is the identity function+$(makeFunc allTries [] [d|+   prop_showRead1 x = (read.show) (x :: TrieType) == x+ |])++-- (compare `on` toAscList) should be equivalent to compare+$(makeFunc allTries ["toAscList"] [d|+   prop_ord1 toAscList x y =+      compare x (y :: TrieType) == compare (toAscList x) (toAscList y)+ |])++tests = testGroup "QuickCheck properties"+   [ $(makeProps allTries "prop_size1")+   , $(makeProps allTries "prop_size2")+   , $(makeProps allTries "prop_member1")+   , $(makeProps mapsOnly "prop_lookup1")+   , $(makeProps mapsOnly "prop_lookupWithDefault1")+   , $(makeProps setsOnly "prop_isSubsetOf1")+   , $(makeProps setsOnly "prop_isProperSubsetOf1")+   , $(makeProps mapsOnly "prop_isSubmapOf1")+   , $(makeProps mapsOnly "prop_isProperSubmapOf1")+   , $(makeProps setsOnly "prop_isProperSubsetOf2")+   , $(makeProps mapsOnly "prop_isProperSubmapOf2")+   , $(makeProps mapsOnly "prop_singleton1")+   , $(makeProps mapsOnly "prop_insert1")+   , $(makeProps setsOnly "prop_insert2_s")+   , $(makeProps mapsOnly "prop_insert2_m")+   , $(makeProps allTries "prop_delete1")+   , $(makeProps mapsOnly "prop_alter1")+   , $(makeProps mapsOnly "prop_alter2")+   , $(makeProps mapsOnly "prop_alter3")+   , $(makeProps mapsOnly "prop_updateLookup1")+   , $(makeProps mapsOnly "prop_updateLookup2")+   , $(makeProps allTries "prop_union1")+   , $(makeProps allTries "prop_union2")+   , $(makeProps allTries "prop_union3")+   , $(makeProps allTries "prop_difference1")+   , $(makeProps allTries "prop_difference2")+   , $(makeProps allTries "prop_difference3")+   , $(makeProps allTries "prop_intersection1")+   , $(makeProps allTries "prop_intersection2")+   , $(makeProps allTries "prop_deMorgan1")+   , $(makeProps allTries "prop_deMorgan2")+   , $(makeProps mapsOnly "prop_partition1")+   , $(makeProps mapsOnly "prop_mapMaybe1")+   , $(makeProps mapsOnly "prop_mapEither1")+   , $(makeProps allTries "prop_splitMaxPredecessor")+   , $(makeProps allTries "prop_splitMinSuccessor")+   , $(makeProps mapsOnly "prop_splitLookup1")+   , $(makeProps setsOnly "prop_splitMember1")+   , $(makeProps setsOnly "prop_mapKeys1_s")+   , $(makeProps mapsOnly "prop_mapKeys1_m")+   , $(makeProps setsOnly "prop_mapInKeys1_s")+   , $(makeProps mapsOnly "prop_mapInKeys1_m")+   , $(makeProps allTries "prop_ascDesc1")+   , $(makeProps allTries "prop_minView1")+   , $(makeProps allTries "prop_maxView1")+   , $(makeProps allTries "prop_findPredecessor1")+   , $(makeProps allTries "prop_findSuccessor1")+   , $(makeProps allTries "prop_findPredecessor2")+   , $(makeProps allTries "prop_findSuccessor2")+   , $(makeProps setsOnly "prop_prefixOps1_s")+   , $(makeProps mapsOnly "prop_prefixOps1_m")+   , $(makeProps allTries "prop_prefixOps2")+   , $(makeProps allTries "prop_prefixOps3")+   , $(makeProps setsOnly "prop_prefixOps4_s")+   , $(makeProps mapsOnly "prop_prefixOps4_m")+   , $(makeProps allTries "prop_monoidLaw1")+   , $(makeProps allTries "prop_monoidLaw2")+   , $(makeProps allTries "prop_monoidLaw3")+   , $(makeProps mapsOnly "prop_functorLaw1")+   , $(makeProps mapsOnly "prop_functorLaw2")+   , $(makeProps mapsOnly "prop_traversableLaw1")+   , $(makeProps mapsOnly "prop_traversableLaw2")+   , $(makeProps allTries "prop_showRead1")+   , $(makeProps allTries "prop_ord1")+   ]
+ tests/Tests/Strictness.hs view
@@ -0,0 +1,388 @@+-- File created: 2009-01-06 13:08:00++{-# LANGUAGE CPP, TemplateHaskell #-}++module Tests.Strictness (tests) where++import Test.ChasingBottoms.IsBottom   (isBottom)+import Test.Framework                 (testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit                     (assert)++import qualified Data.ListTrie.Set.Eq+import qualified Data.ListTrie.Set.Ord+import qualified Data.ListTrie.Set.Enum+import qualified Data.ListTrie.Map.Eq+import qualified Data.ListTrie.Map.Ord+import qualified Data.ListTrie.Map.Enum+import qualified Data.ListTrie.Patricia.Set.Eq+import qualified Data.ListTrie.Patricia.Set.Ord+import qualified Data.ListTrie.Patricia.Set.Enum+import qualified Data.ListTrie.Patricia.Map.Eq+import qualified Data.ListTrie.Patricia.Map.Ord+import qualified Data.ListTrie.Patricia.Map.Enum++import Tests.Base+import Tests.TH++-- size doesn't evaluate the values but it does traverse the whole trie+-- returning a single result, so it works well for checking whether there are+-- any bottoms in the trie+#define IS_LAZY   (not.isBottom.size)+#define IS_STRICT (    isBottom.size)++-- insert' should be strict in the value, insert should not.+$(makeFunc mapsOnly ["size","empty","insert"] [d|+   insert size empty insert =+      IS_LAZY   . insert  "foo" undefined $ (empty :: TrieType)+ |])+$(makeFunc mapsOnly ["size","empty","insert'"] [d|+   insert' size empty insert' =+      IS_STRICT . insert' "foo" undefined $ (empty :: TrieType)+ |])++-- insertWith' should apply the combining function strictly, insertWith should+-- not. We use a singleton to make sure that the combining function is called.+$(makeFunc mapsOnly ["size","singleton","insertWith"] [d|+   insertWith1 size singleton insertWith =+      IS_LAZY   . insertWith  undefined "foo" undefined $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","insertWith'"] [d|+   insertWith'1 size singleton insertWith' =+      IS_STRICT . insertWith' undefined "foo" undefined $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","insertWith'"] [d|+   insertWith'2 size singleton insertWith' =+      IS_STRICT . insertWith' (+)       "foo" undefined $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","insertWith'"] [d|+   insertWith'3 size singleton insertWith' =+      IS_STRICT . insertWith' undefined "foo" 0 $+         (singleton "foo" 0 :: TrieType)+ |])++-- Also, insertWith' should always be strict in the value.+$(makeFunc mapsOnly ["size","empty","insertWith"] [d|+   insertWith2 size empty insertWith =+      IS_LAZY   . insertWith  undefined "foo" undefined $ (empty :: TrieType)+ |])+$(makeFunc mapsOnly ["size","empty","insertWith'"] [d|+   insertWith'4 size empty insertWith' =+      IS_STRICT . insertWith' undefined "foo" undefined $ (empty :: TrieType)+ |])++-- As for insertWith, but for adjust' and adjust.+$(makeFunc mapsOnly ["size","singleton","adjust"] [d|+   adjust size singleton adjust =+      IS_LAZY   . adjust  undefined "foo" $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","adjust'"] [d|+   adjust' size singleton adjust' =+      IS_STRICT . adjust' undefined "foo" $ (singleton "foo" 0 :: TrieType)+ |])++-- As above, but for alter and alter'.+--+-- Need to use more sophisticated testing here because now the value itself is+-- ⊥, including whether it's Just or not; size wants that info.+--+-- And there's also the following facts:+--   - Patricia's alter is lazy for only one case: the key to be altered is the+--     prefix of more than one key in the trie.+--   - Non-Patricia's alter is lazy for only one case: the key to be altered is+--     the prefix of at least one key in the trie.+--+-- So we have to be careful about the case we test.+$(makeFunc mapsOnly ["member","fromList","alter"] [d|+   alter member fromList alter =+      not.isBottom.member "foob" . alter undefined "foo" $+         (fromList [("foo",1),("foob",2),("fooz",3)] :: TrieType)+ |])+$(makeFunc mapsOnly ["member","fromList","alter'"] [d|+   alter' member fromList alter' =+      isBottom.member "foob" . alter' undefined "foo" $+         (fromList [("foo",1),("foob",2),("fooz",3)] :: TrieType)+ |])++-- As above, but for the union family.+$(makeFunc mapsOnly ["size","singleton","union"] [d|+   union size singleton union =+      IS_LAZY   $ union  (singleton "foo" undefined :: TrieType)+                         (singleton "foo" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","union'"] [d|+   union' size singleton union' =+      IS_STRICT $ union' (singleton "foo" undefined :: TrieType)+                         (singleton "foo" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","unionWith"] [d|+   unionWith size singleton unionWith =+      IS_LAZY   $ unionWith undefined  (singleton "foo" 1 :: TrieType)+                                       (singleton "foo" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","unionWith'"] [d|+   unionWith' size singleton unionWith' =+      IS_STRICT $ unionWith' undefined (singleton "foo" 1 :: TrieType)+                                       (singleton "foo" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","unionWithKey"] [d|+   unionWithKey size singleton unionWithKey =+      IS_LAZY   $ unionWithKey undefined  (singleton "foo" 1 :: TrieType)+                                          (singleton "foo" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","unionWithKey'"] [d|+   unionWithKey' size singleton unionWithKey' =+      IS_STRICT $ unionWithKey' undefined (singleton "foo" 1 :: TrieType)+                                          (singleton "foo" 1)+ |])++-- As above, but for the unions family.+$(makeFunc mapsOnly ["size","singleton","unions"] [d|+   unions size singleton unions =+      IS_LAZY   $ unions  [singleton "foo" undefined :: TrieType+                          ,singleton "foo" 1+                          ]+ |])+$(makeFunc mapsOnly ["size","singleton","unions'"] [d|+   unions' size singleton unions' =+      IS_STRICT $ unions' [singleton "foo" undefined :: TrieType+                          ,singleton "foo" 1+                          ]+ |])+$(makeFunc mapsOnly ["size","singleton","unionsWith"] [d|+   unionsWith size singleton unionsWith =+      IS_LAZY   $ unionsWith undefined  [singleton "foo" 1 :: TrieType+                                        ,singleton "foo" 1+                                        ]+ |])+$(makeFunc mapsOnly ["size","singleton","unionsWith'"] [d|+   unionsWith' size singleton unionsWith' =+      IS_STRICT $ unionsWith' undefined [singleton "foo" 1 :: TrieType+                                        ,singleton "foo" 1+                                        ]+ |])+$(makeFunc mapsOnly ["size","singleton","unionsWithKey"] [d|+   unionsWithKey size singleton unionsWithKey =+      IS_LAZY   $ unionsWithKey undefined  [singleton "foo" 1 :: TrieType+                                           ,singleton "foo" 1+                                           ]+ |])+$(makeFunc mapsOnly ["size","singleton","unionsWithKey'"] [d|+   unionsWithKey' size singleton unionsWithKey' =+      IS_STRICT $ unionsWithKey' undefined [singleton "foo" 1 :: TrieType+                                           ,singleton "foo" 1+                                           ]+ |])++-- As above, but for the intersection family.+$(makeFunc mapsOnly ["size","singleton","intersection"] [d|+   intersection size singleton intersection =+      IS_LAZY   $ intersection  (singleton "a" undefined :: TrieType)+                                (singleton "a" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","intersection'"] [d|+   intersection' size singleton intersection' =+      IS_STRICT $ intersection' (singleton "a" undefined :: TrieType)+                                (singleton "a" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","intersectionWith"] [d|+   intersectionWith size singleton intersectionWith =+      IS_LAZY   $ intersectionWith undefined  (singleton "a" 1 :: TrieType)+                                              (singleton "a" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","intersectionWith'"] [d|+   intersectionWith' size singleton intersectionWith' =+      IS_STRICT $ intersectionWith' undefined (singleton "a" 1 :: TrieType)+                                              (singleton "a" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","intersectionWithKey"] [d|+   intersectionWithKey size singleton intersectionWithKey =+      IS_LAZY   $ intersectionWithKey undefined  (singleton "a" 1 :: TrieType)+                                                 (singleton "a" 1)+ |])+$(makeFunc mapsOnly ["size","singleton","intersectionWithKey'"] [d|+   intersectionWithKey' size singleton intersectionWithKey' =+      IS_STRICT $ intersectionWithKey' undefined (singleton "a" 1 :: TrieType)+                                                 (singleton "a" 1)+ |])++-- As above, but for the map family.+$(makeFunc mapsOnly ["size","singleton","map"] [d|+   map size singleton map =+      IS_LAZY   . map  undefined $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","map'"] [d|+   map' size singleton map' =+      IS_STRICT . map' undefined $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapWithKey"] [d|+   mapWithKey size singleton mapWithKey =+      IS_LAZY   . mapWithKey  undefined $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapWithKey'"] [d|+   mapWithKey' size singleton mapWithKey' =+      IS_STRICT . mapWithKey' undefined $ (singleton "foo" 0 :: TrieType)+ |])++-- As above, but for the mapInKeys family.+--+-- The *With ones need to actually trigger the union function, hence a simple+-- singleton won't do.+$(makeFunc mapsOnly ["size","fromList","mapInKeys"] [d|+   mapInKeys size fromList mapInKeys =+      IS_LAZY   . mapInKeys (const 'x') $+         (fromList [("xy",0),("xz",undefined)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromList","mapInKeys'"] [d|+   mapInKeys' size fromList mapInKeys' =+      IS_STRICT . mapInKeys' (const 'x') $+         (fromList [("xy",0),("xz",undefined)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromList","mapInKeysWith"] [d|+   mapInKeysWith size fromList mapInKeysWith =+      IS_LAZY   . mapInKeysWith  undefined (const 'x') $+         (fromList [("xy",0),("xz",1)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromList","mapInKeysWith'"] [d|+   mapInKeysWith' size fromList mapInKeysWith' =+      IS_STRICT . mapInKeysWith' undefined (const 'x') $+         (fromList [("xy",0),("xz",1)] :: TrieType)+ |])++-- As above, but for the mapAccum family.+$(makeFunc mapsOnly ["size","singleton","mapAccum"] [d|+   mapAccum size singleton mapAccum =+      IS_LAZY   . snd . mapAccum  undefined 0 $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccum'"] [d|+   mapAccum' size singleton mapAccum' =+      IS_STRICT . snd . mapAccum' undefined 0 $ (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumWithKey"] [d|+   mapAccumWithKey size singleton mapAccumWithKey =+      IS_LAZY   . snd . mapAccumWithKey  undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumWithKey'"] [d|+   mapAccumWithKey' size singleton mapAccumWithKey' =+      IS_STRICT . snd . mapAccumWithKey' undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumAsc"] [d|+   mapAccumAsc size singleton mapAccumAsc =+      IS_LAZY   . snd . mapAccumAsc  undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumAsc'"] [d|+   mapAccumAsc' size singleton mapAccumAsc' =+      IS_STRICT . snd . mapAccumAsc' undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumAscWithKey"] [d|+   mapAccumAscWithKey size singleton mapAccumAscWithKey =+      IS_LAZY   . snd . mapAccumAscWithKey  undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumAscWithKey'"] [d|+   mapAccumAscWithKey' size singleton mapAccumAscWithKey' =+      IS_STRICT . snd . mapAccumAscWithKey' undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumDesc"] [d|+   mapAccumDesc size singleton mapAccumDesc =+      IS_LAZY   . snd . mapAccumDesc  undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumDesc'"] [d|+   mapAccumDesc' size singleton mapAccumDesc' =+      IS_STRICT . snd . mapAccumDesc' undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumDescWithKey"] [d|+   mapAccumDescWithKey size singleton mapAccumDescWithKey =+      IS_LAZY   . snd . mapAccumDescWithKey  undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])+$(makeFunc mapsOnly ["size","singleton","mapAccumDescWithKey'"] [d|+   mapAccumDescWithKey' size singleton mapAccumDescWithKey' =+      IS_STRICT . snd . mapAccumDescWithKey' undefined 0 $+         (singleton "foo" 0 :: TrieType)+ |])++-- As above, but for the fromListWith family.+$(makeFunc mapsOnly ["size","fromListWith"] [d|+   fromListWith size fromListWith =+      IS_LAZY   (fromListWith  undefined [("a",1),("a",2)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromListWith'"] [d|+   fromListWith' size fromListWith' =+      IS_STRICT (fromListWith' undefined [("a",1),("a",2)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromListWithKey"] [d|+   fromListWithKey size fromListWithKey =+      IS_LAZY   (fromListWithKey  undefined [("a",1),("a",2)] :: TrieType)+ |])+$(makeFunc mapsOnly ["size","fromListWithKey'"] [d|+   fromListWithKey' size fromListWithKey' =+      IS_STRICT (fromListWithKey' undefined [("a",1),("a",2)] :: TrieType)+ |])++tests = testGroup "Strictness"+   [ $(makeCases mapsOnly "insert")+   , $(makeCases mapsOnly "insert'")+   , $(makeCases mapsOnly "insertWith1")+   , $(makeCases mapsOnly "insertWith'1")+   , $(makeCases mapsOnly "insertWith'2")+   , $(makeCases mapsOnly "insertWith'3")+   , $(makeCases mapsOnly "insertWith2")+   , $(makeCases mapsOnly "insertWith'4")+   , $(makeCases mapsOnly "adjust")+   , $(makeCases mapsOnly "adjust'")+   , $(makeCases mapsOnly "alter")+   , $(makeCases mapsOnly "alter'")+   , $(makeCases mapsOnly "union")+   , $(makeCases mapsOnly "union'")+   , $(makeCases mapsOnly "unionWith")+   , $(makeCases mapsOnly "unionWith'")+   , $(makeCases mapsOnly "unionWithKey")+   , $(makeCases mapsOnly "unionWithKey'")+   , $(makeCases mapsOnly "unions")+   , $(makeCases mapsOnly "unions'")+   , $(makeCases mapsOnly "unionsWith")+   , $(makeCases mapsOnly "unionsWith'")+   , $(makeCases mapsOnly "unionsWithKey")+   , $(makeCases mapsOnly "unionsWithKey'")+   , $(makeCases mapsOnly "intersection")+   , $(makeCases mapsOnly "intersection'")+   , $(makeCases mapsOnly "intersectionWith")+   , $(makeCases mapsOnly "intersectionWith'")+   , $(makeCases mapsOnly "intersectionWithKey")+   , $(makeCases mapsOnly "intersectionWithKey'")+   , $(makeCases mapsOnly "map")+   , $(makeCases mapsOnly "map'")+   , $(makeCases mapsOnly "mapWithKey")+   , $(makeCases mapsOnly "mapWithKey'")+   , $(makeCases mapsOnly "mapInKeys")+   , $(makeCases mapsOnly "mapInKeys'")+   , $(makeCases mapsOnly "mapInKeysWith")+   , $(makeCases mapsOnly "mapInKeysWith'")+   , $(makeCases mapsOnly "mapAccum")+   , $(makeCases mapsOnly "mapAccum'")+   , $(makeCases mapsOnly "mapAccumWithKey")+   , $(makeCases mapsOnly "mapAccumWithKey'")+   , $(makeCases mapsOnly "mapAccumAsc")+   , $(makeCases mapsOnly "mapAccumAsc'")+   , $(makeCases mapsOnly "mapAccumAscWithKey")+   , $(makeCases mapsOnly "mapAccumAscWithKey'")+   , $(makeCases mapsOnly "mapAccumDesc")+   , $(makeCases mapsOnly "mapAccumDesc'")+   , $(makeCases mapsOnly "mapAccumDescWithKey")+   , $(makeCases mapsOnly "mapAccumDescWithKey'")+   , $(makeCases mapsOnly "fromListWith")+   , $(makeCases mapsOnly "fromListWith'")+   , $(makeCases mapsOnly "fromListWithKey")+   , $(makeCases mapsOnly "fromListWithKey'")+   ]
+ tests/Tests/TH.hs view
@@ -0,0 +1,209 @@+-- File created: 2009-01-09 13:57:13++{-# LANGUAGE EmptyDataDecls, PatternGuards, TemplateHaskell #-}++module Tests.TH+   ( Module(..)+   , TrieType, ListElemType+   , makeFunc, makeCases, makeProps+   , setsOnly, mapsOnly, allTries+   ) where++import Control.Arrow ((***))+import Data.Char     (isDigit)+import Data.Maybe    (isJust, fromMaybe)+import Data.List     (break, isPrefixOf, isSuffixOf)+import Language.Haskell.TH+   ( Exp(..), Lit(..), Stmt(..), Dec(..), Type(..), Clause(..), Pat(..)+   , Guard(..), Body(..), Match(..)+   , Q, ExpQ+   , Name, nameBase, nameModule, mkName+   )++data Module = SetModule String | MapModule String++moduleName :: Module -> String+moduleName (SetModule m) = m+moduleName (MapModule m) = m++data TestType = Case | Property++data ListElemType++data TrieType_ a+type TrieType = TrieType_ Int++keyType  = ''Char+elemType = ''Int++replaceTypes :: Module -> Type -> Type+replaceTypes m (ForallT names cxt t) = ForallT names cxt (replaceTypes m t)+replaceTypes m (AppT t1 t2) = AppT (replaceTypes m t1) (replaceTypes m t2)+replaceTypes m (ConT t) | t == ''TrieType =+   case m of+        SetModule m' -> ConT (mkName $ m' ++ ".TrieSet") `AppT` ConT keyType+        MapModule m' -> ConT (mkName $ m' ++ ".TrieMap") `AppT` ConT keyType+                                                         `AppT` ConT elemType+replaceTypes m (ConT t) | t == ''ListElemType =+   case m of+        SetModule _ -> ListT `AppT` ConT keyType+        MapModule _ -> TupleT 2 `AppT` (ListT `AppT` ConT keyType)+                                `AppT` (ConT elemType)++replaceTypes _ x = x++-- Given, say:+--    [SetModule "S", MapModule "M"]+--    [("x",Just (AppT (TupleT 2) (ConT Int) (ConT TrieType)))]+--    [d| f x y = x |]+--+-- generate: [d| f_S y = S.x  :: (Int,S.TrieSet Char)+--               f_M y = S2.x :: (Int,M.TrieMap Char Int)+--             |]+--+-- WARNING: shadowing names will break this! For instance the following:+--+--   f x y = let x = y in x+--+-- will result in:+--+--   f_S y = let x = y in S.x+--+-- Which is obviously very different in terms of semantics.+--+-- (Yes, this could be handled properly but I couldn't be bothered.)+makeFunc :: [Module] -> [String] -> Q [Dec] -> Q [Dec]+makeFunc modules expands =+   let expandFuns = map expandTopDec modules+    in fmap (\decs -> concat [map f decs | f <- expandFuns])+ where+   isExpandable n = nameBase n `elem` expands+                 && fromMaybe True+                       (fmap ("Data.ListTrie." `isPrefixOf`) (nameModule n))++   expandTopDec modu (FunD name clauses) =+      FunD (modularName (nameBase name) (moduleName modu))+           (map (expandClause modu) clauses)+   expandTopDec _ _ =+      error "expandTopDec :: shouldn't ever see this declaration type"++   expandDec modu (FunD name clauses) =+      FunD name (map (expandClause modu) clauses)+   expandDec modu (ValD pat body decs) =+      ValD pat (expandBody modu body) (map (expandDec modu) decs)+   expandDec modu (SigD name typ) = SigD name (replaceTypes modu typ)+   expandDec _ _ =+      error "expandDec :: shouldn't ever see this declaration type"++   expandClause modu (Clause pats body decs) =+      Clause (concatMap clearPat pats)+             (expandBody modu body)+             (map (expandDec modu) decs)++   -- Remove matching ones from the function arguments+   clearPat (VarP n) | isExpandable n = []+   clearPat x = [x]++   expandBody modu (NormalB expr)    = NormalB (expandE modu expr)+   expandBody modu (GuardedB guards) =+      GuardedB (map (expandGuard modu *** expandE modu) guards)++   expandE m (VarE n) | isExpandable n = qualify VarE m n+   expandE m (ConE n) | isExpandable n = qualify ConE m n+   expandE m (AppE e1 e2)         = AppE (expandE m e1) (expandE m e2)+   expandE m (InfixE me1 e me2)   = InfixE (fmap (expandE m) me1)+                                           (expandE m e)+                                           (fmap (expandE m) me2)+   expandE m (LamE pats e)        = LamE pats (expandE m e)+   expandE m (TupE es)            = TupE (map (expandE m) es)+   expandE m (CondE e1 e2 e3)     = CondE (expandE m e1)+                                          (expandE m e2)+                                          (expandE m e3)+   expandE m (LetE decs e)        = LetE (map (expandDec m) decs) (expandE m e)+   expandE m (CaseE e matches)    = CaseE (expandE m e)+                                          (map (expandMatch m) matches)+   expandE m (DoE stmts)          = DoE (map (expandStmt m) stmts)+   expandE m (CompE stmts)        = CompE (map (expandStmt m) stmts)+   expandE m (SigE e t)           = SigE (expandE m e) (replaceTypes m t)+   expandE m (RecConE name fexps) = RecConE name (map (expandFieldExp m) fexps)+   expandE m (RecUpdE name fexps) = RecUpdE name (map (expandFieldExp m) fexps)+   expandE m (ListE exps)         = ListE (map (expandE m) exps)+   expandE _ x = x++   qualify expr modu name =+      expr $ mkName (moduleName modu ++ "." ++ nameBase name)++   expandMatch modu (Match pat body decs) =+      Match pat (expandBody modu body) (map (expandDec modu) decs)++   expandStmt modu (BindS pat expr) = BindS pat (expandE modu expr)+   expandStmt modu (LetS decs)      = LetS (map (expandDec modu) decs)+   expandStmt modu (NoBindS expr)   = NoBindS (expandE modu expr)+   expandStmt _    (ParS _)         = error "expandStmt :: ParS? What's that?"++   expandFieldExp modu (name,expr) = (name, expandE modu expr)++   expandGuard modu (NormalG expr) = NormalG (expandE modu expr)+   expandGuard modu (PatG stmts)   = PatG (map (expandStmt modu) stmts)++makeTests :: TestType -> [Module] -> String -> ExpQ+makeTests typ modules test =+   return$+      VarE (mkName "testGroup") `AppE`+      LitE (StringL (testName typ test)) `AppE`+      ListE (+         map (\m -> let mn = moduleName m+                        n  = modularName test mn+                     in VarE (mkName testType) `AppE`+                        LitE (StringL (relevantPart mn)) `AppE`+                        (VarE (mkName testMaker) `AppE`+                         VarE n)+                        )+             modules)+ where+   testType = case typ of+                   Case     -> "testCase"+                   Property -> "testProperty"++   testMaker = case typ of+                    Case     -> "assert"+                    Property -> "id"++makeCases = makeTests Case+makeProps = makeTests Property++-- Used to name the generated functions+modularName :: String -> String -> Name+modularName name modu =+   mkName $ name ++ "_" ++ map (\c -> if c == '.' then '_' else c) modu++testName :: TestType -> String -> String+testName Case test = test+testName Property test =+   let (s,num) = break isDigit.tail.dropWhile (/= '_') $ test+    in concat+          [ s+          , if null num+               then ""+               else "-"+          , num+          ]++relevantPart :: String -> String+relevantPart = drop (length "Data.ListTrie.")++setsOnly = [SetModule "Data.ListTrie.Set.Eq"+           ,SetModule "Data.ListTrie.Set.Ord"+           ,SetModule "Data.ListTrie.Set.Enum"+           ,SetModule "Data.ListTrie.Patricia.Set.Eq"+           ,SetModule "Data.ListTrie.Patricia.Set.Ord"+           ,SetModule "Data.ListTrie.Patricia.Set.Enum"+           ]+mapsOnly = [MapModule "Data.ListTrie.Map.Eq"+           ,MapModule "Data.ListTrie.Map.Ord"+           ,MapModule "Data.ListTrie.Map.Enum"+           ,MapModule "Data.ListTrie.Patricia.Map.Eq"+           ,MapModule "Data.ListTrie.Patricia.Map.Ord"+           ,MapModule "Data.ListTrie.Patricia.Map.Enum"+           ]+allTries = setsOnly ++ mapsOnly