-- File created: 2008-12-28 17:20:14

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies
           , FlexibleContexts, ScopedTypeVariables, Rank2Types #-}

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
   , lookupPrefix, addPrefix, deletePrefix, deleteSuffixes
   , splitPrefix, children, children1
   , showTrieWith
   , eqComparePrefixes, ordComparePrefixes
   ) where

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 :: forall b. Boolable b => b -> Bool
hasValue = b -> Bool
forall b. Boolable b => b -> Bool
toBool
noValue :: forall b. Boolable b => b -> Bool
noValue  = Bool -> Bool
not (Bool -> Bool) -> (b -> Bool) -> b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Bool
forall b. Boolable b => b -> Bool
hasValue

tVal :: Trie trie st map k => trie map k a -> st a
tVal :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> st a
tVal = (\(st a
a,[k]
_,CMap trie map k a
_) -> st a
a) ((st a, [k], CMap trie map k a) -> st a)
-> (trie map k a -> (st a, [k], CMap trie map k a))
-> trie map k a
-> st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts

tMap :: Trie trie st map k => trie map k a -> CMap trie map k a
tMap :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap = (\(st a
_,[k]
_,CMap trie map k a
c) -> CMap trie map k a
c) ((st a, [k], CMap trie map k a) -> CMap trie map k a)
-> (trie map k a -> (st a, [k], CMap trie map k a))
-> trie map k a
-> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts

-----------------------

-- * Construction

-- O(1)
empty :: (Alt st a, Trie trie st map k) => trie map k a
empty :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty = st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [] CMap trie map k a
forall a. map k a
forall (m :: * -> * -> *) k a. Map m k => m k a
Map.empty

-- O(1)
singleton :: (Alt st a, Trie trie st map k) => [k] -> a -> trie map k a
singleton :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> a -> trie map k a
singleton [k]
k a
v = st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie (a -> st a
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v) [k]
k CMap trie map k a
forall a. map k a
forall (m :: * -> * -> *) k a. Map m k => m k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> a -> trie map k a -> trie map k a
insert = (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> a -> a
forall a b. a -> b -> a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> a -> trie map k a -> trie map k a
insert' = (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> a -> a
forall a b. a -> b -> a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
genericInsertWith (x -> y) -> x -> y
forall x y. (x -> y) -> x -> y
forall a b. (a -> b) -> a -> b
($) (a -> a) -> st a -> st a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
(<$>)

-- 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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' = (a -> (trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. a -> b -> b
seq (a
 -> (trie map k a -> trie map k a) -> trie map k a -> trie map k a)
-> (a -> trie map k a -> trie map k a)
-> a
-> trie map k a
-> trie map k a
forall a b. (a -> a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) ((a -> trie map k a -> trie map k a)
 -> a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: (forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
genericInsertWith (x -> y) -> x -> y
forall x y. (x -> y) -> x -> y
forall a b. (a -> b) -> a -> b
($!) (a -> a) -> st a -> st a
forall (f :: * -> *) a b.
(Boolable (f a), Unwrappable f, Alt f b) =>
(a -> b) -> f a -> f b
(<$!>)

genericInsertWith :: (Alt st a, Boolable (st a), Trie trie st map k)
                  => (forall x y. (x -> y) -> x -> y)
                  -> ((a -> a) -> st a -> st a)
                  -> (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
genericInsertWith :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a -> a)
-> [k]
-> a
-> trie map k a
-> trie map k a
genericInsertWith forall x y. (x -> y) -> x -> y
($$) (a -> a) -> st a -> st a
(<$$>) a -> a -> a
f = [k] -> a -> trie map k a -> trie map k a
go
 where
   mkTrie' :: st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie' = (st a -> [k] -> CMap trie map k a -> trie map k a)
-> st a -> [k] -> CMap trie map k a -> trie map k a
forall x y. (x -> y) -> x -> y
($$) st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie
   go :: [k] -> a -> trie map k a -> trie map k a
go [k]
k a
new trie map k a
tr =
      let (st a
old,[k]
prefix,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
prefix [k]
k of
               PrefixOrdering k
Same -> st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie' ((a -> a -> a
f a
new (a -> a) -> st a -> st a
<$$> st a
old) st a -> st a -> st a
forall (a :: * -> *) x. Alt a x => a x -> a x -> a x
<|> a -> st a
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
new) [k]
prefix CMap trie map k a
m

               PostFix (Left (k
p:[k]
pr)) ->
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie' (a -> st a
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
new) [k]
k
                          (k -> trie map k a -> CMap trie map k a
forall a. k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a
Map.singleton k
p (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
old [k]
pr CMap trie map k a
m))
               PostFix (Right (k
x:[k]
xs)) ->
                  -- Minor optimization: instead of tryCompress we just check
                  -- for the case of an empty trie
                  if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr
                     then [k] -> a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> a -> trie map k a
singleton [k]
k a
new
                     else st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
old [k]
prefix (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                             (trie map k a -> trie map k a -> trie map k a)
-> k -> trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. (a -> a -> a) -> k -> a -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a -> a) -> k -> a -> m k a -> m k a
Map.insertWith (\trie map k a
_ trie map k a
oldt -> [k] -> a -> trie map k a -> trie map k a
go [k]
xs a
new trie map k a
oldt)
                                            k
x ([k] -> a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> a -> trie map k a
singleton [k]
xs a
new) CMap trie map k a
m

               DifferedAt [k]
pr' (k
p:[k]
pr) (k
x:[k]
xs) ->
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pr' (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ k -> trie map k a -> k -> trie map k a -> CMap trie map k a
forall a. k -> a -> k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> k -> a -> m k a
Map.doubleton k
x ([k] -> a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> a -> trie map k a
singleton [k]
xs a
new)
                                                      k
p (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
old [k]
pr CMap trie map k a
m)

               PrefixOrdering k
_ -> [Char] -> trie map k a
forall a. HasCallStack => [Char] -> a
error
                  [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
delete = (st a -> st a) -> [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 (st a -> st a -> st a
forall a b. a -> b -> a
const st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty)

-- O(min(m,s))
adjust :: Trie trie st map k
       => (a -> a) -> [k] -> trie map k a -> trie map k a
adjust :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
(a -> a) -> [k] -> trie map k a -> trie map k a
adjust = (forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a)
-> [k]
-> trie map k a
-> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a)
-> [k]
-> trie map k a
-> trie map k a
genericAdjust (x -> y) -> x -> y
forall x y. (x -> y) -> x -> y
forall a b. (a -> b) -> a -> b
($) (a -> a) -> st a -> st a
forall a b. (a -> b) -> st a -> st b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(a -> a) -> [k] -> trie map k a -> trie map k a
adjust' = (forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a)
-> [k]
-> trie map k a
-> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a)
-> [k]
-> trie map k a
-> trie map k a
genericAdjust (x -> y) -> x -> y
forall x y. (x -> y) -> x -> y
forall a b. (a -> b) -> a -> b
($!) (a -> a) -> st a -> st a
forall (f :: * -> *) a b.
(Boolable (f a), Unwrappable f, Alt f b) =>
(a -> b) -> f a -> f b
fmap'

genericAdjust :: Trie trie st map k
              => (forall x y. (x -> y) -> x -> y)
              -> ((a -> a) -> st a -> st a)
              -> (a -> a) -> [k] -> trie map k a -> trie map k a
genericAdjust :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
(forall x y. (x -> y) -> x -> y)
-> ((a -> a) -> st a -> st a)
-> (a -> a)
-> [k]
-> trie map k a
-> trie map k a
genericAdjust forall x y. (x -> y) -> x -> y
($$) (a -> a) -> st a -> st a
myFmap a -> a
f = [k] -> trie map k a -> trie map k a
forall {trie :: (* -> * -> *) -> * -> * -> *} {map :: * -> * -> *}
       {k}.
Trie trie st map k =>
[k] -> trie map k a -> trie map k a
go
 where
   go :: [k] -> trie map k a -> trie map k a
go [k]
k trie map k a
tr =
      let (st a
v,[k]
prefix,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
prefix [k]
k of
               PrefixOrdering k
Same                   -> (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie (st a -> [k] -> CMap trie map k a -> trie map k a)
-> st a -> [k] -> CMap trie map k a -> trie map k a
forall x y. (x -> y) -> x -> y
$$ (a -> a) -> st a -> st a
myFmap a -> a
f st a
v) [k]
prefix CMap trie map k a
m
               PostFix (Right (k
x:[k]
xs)) ->
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
prefix (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ (trie map k a -> trie map k a)
-> k -> CMap trie map k a -> CMap trie map k a
forall a. (a -> a) -> k -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a) -> k -> m k a -> m k a
Map.adjust ([k] -> trie map k a -> trie map k a
go [k]
xs) k
x CMap trie map k a
m
               PrefixOrdering k
_                      -> trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> st a
f = [k] -> trie map k a -> (st a, trie map k a)
forall {trie :: (* -> * -> *) -> * -> * -> *} {m :: * -> * -> *}
       {k}.
Trie trie st m k =>
[k] -> trie m k a -> (st a, trie m k a)
go
 where
   go :: [k] -> trie m k a -> (st a, trie m k a)
go [k]
k trie m k a
tr =
      let (st a
v,[k]
prefix,CMap trie m k a
m) = trie m k a -> (st a, [k], CMap trie m k a)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
m) [k]
prefix [k]
k of
               PrefixOrdering k
Same                   -> let v' :: st a
v' = if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v
                                                     then a -> st a
f (st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap st a
v)
                                                     else st a
v
                                          in (st a
v, st a -> [k] -> CMap trie m k a -> trie m k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
safeMkTrie st a
v' [k]
prefix CMap trie m k a
m)
               PostFix (Right (k
x:[k]
xs)) ->
                  case k -> CMap trie m k a -> Maybe (trie m k a)
forall a. k -> m k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie m k a
m of
                       Maybe (trie m k a)
Nothing  -> (st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, trie m k a
tr)
                       Just trie m k a
tr' ->
                          let (st a
ret, trie m k a
upd) = [k] -> trie m k a -> (st a, trie m k a)
go [k]
xs trie m k a
tr'
                           in ( st a
ret
                              , st a -> [k] -> CMap trie m k a -> trie m k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
safeMkTrie st a
v [k]
prefix (CMap trie m k a -> trie m k a) -> CMap trie m k a -> trie m k a
forall a b. (a -> b) -> a -> b
$
                                   if trie m k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie m k a
upd
                                      then k -> CMap trie m k a -> CMap trie m k a
forall a. k -> m k a -> m k a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> m k a
Map.delete k
x CMap trie m k a
m
                                      else (trie m k a -> trie m k a)
-> k -> CMap trie m k a -> CMap trie m k a
forall a. (a -> a) -> k -> m k a -> m k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a) -> k -> m k a -> m k a
Map.adjust (trie m k a -> trie m k a -> trie m k a
forall a b. a -> b -> a
const trie m k a
upd) k
x CMap trie m k a
m
                              )
               PrefixOrdering k
_ -> (st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, trie m k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (st a -> trie map k a -> trie map k a)
-> (st a -> st a) -> [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 ((trie map k a -> st a -> trie map k a)
-> st a -> trie map k a -> trie map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k a -> st a -> trie map k a
forall a b. a -> b -> a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' = (st a -> trie map k a -> trie map k a)
-> (st a -> st a) -> [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 st a -> trie map k a -> trie map k a
forall a b. a -> b -> b
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 st a -> trie map k a -> trie map k a
seeq st a -> st a
f = [k] -> trie map k a -> trie map k a
go
 where
   go :: [k] -> trie map k a -> trie map k a
go [k]
k trie map k a
tr =
      let (st a
v,[k]
prefix,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
prefix [k]
k of
               PrefixOrdering k
Same                   ->
                  let v' :: st a
v' = st a -> st a
f st a
v
                   in -- We need to compress if the map was empty or a
                      -- singleton and the value was removed
                      if    (CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie map k a
m Bool -> Bool -> Bool
|| Maybe (k, trie map k a) -> Bool
forall a. Maybe a -> Bool
isJust (CMap trie map k a -> Maybe (k, trie map k a)
forall a. map k a -> Maybe (k, a)
forall (m :: * -> * -> *) k a. Map m k => m k a -> Maybe (k, a)
Map.singletonView CMap trie map k a
m))
                         Bool -> Bool -> Bool
&& Bool -> Bool
not (st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v')
                         then trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' [k]
prefix CMap trie map k a
m)
                         else st a
v' st a -> trie map k a -> trie map k a
`seeq` st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' [k]
prefix CMap trie map k a
m

               PostFix (Right (k
x:[k]
xs)) ->
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
prefix (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                     (Maybe (trie map k a) -> Maybe (trie map k a))
-> k -> CMap trie map k a -> CMap trie map k a
forall a. (Maybe a -> Maybe a) -> k -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(Maybe a -> Maybe a) -> k -> m k a -> m k a
Map.alter
                        (\Maybe (trie map k a)
mt ->
                           case Maybe (trie map k a)
mt of
                                Maybe (trie map k a)
Nothing ->
                                   let v' :: st a
v' = st a -> st a
f st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty
                                    in if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v'
                                          then trie map k a -> Maybe (trie map k a)
forall a. a -> Maybe a
Just ([k] -> a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> a -> trie map k a
singleton [k]
xs (st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap st a
v'))
                                          else Maybe (trie map k a)
forall a. Maybe a
Nothing
                                Just trie map k a
t ->
                                   let new :: trie map k a
new = [k] -> trie map k a -> trie map k a
go [k]
xs trie map k a
t
                                    in if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
new then Maybe (trie map k a)
forall a. Maybe a
Nothing else trie map k a -> Maybe (trie map k a)
forall a. a -> Maybe a
Just trie map k a
new)
                        k
x CMap trie map k a
m

               PostFix (Left (k
p:[k]
ps)) ->
                  let v' :: st a
v' = st a -> st a
f st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty
                   in if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v'
                         then st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' [k]
k (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ k -> trie map k a -> CMap trie map k a
forall a. k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a
Map.singleton k
p (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
ps CMap trie map k a
m)
                         else trie map k a
tr

               DifferedAt [k]
pr (k
p:[k]
ps) (k
x:[k]
xs) ->
                  let v' :: st a
v' = st a -> st a
f st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty
                   in if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v'
                         then st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pr (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                                 k -> trie map k a -> k -> trie map k a -> CMap trie map k a
forall a. k -> a -> k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> k -> a -> m k a
Map.doubleton k
p (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v  [k]
ps CMap trie map k a
m)
                                               k
x (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' [k]
xs CMap trie map k a
forall a. map k a
forall (m :: * -> * -> *) k a. Map m k => m k a
Map.empty)
                         else trie map k a
tr

               PrefixOrdering k
_ -> [Char] -> trie map k a
forall a. HasCallStack => [Char] -> a
error
                  [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr = let (st a
v,[k]
p,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
           in CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie map k a
m Bool -> Bool -> Bool
&& st a -> Bool
forall b. Boolable b => b -> Bool
noValue st a
v Bool -> Bool -> Bool
&& Bool -> Bool -> Bool
forall a. HasCallStack => Bool -> a -> a
assert ([k] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [k]
p) Bool
True

-- O(n m)
size :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n
size :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k n.
(Boolable (st a), Trie trie st map k, Num n) =>
trie map k a -> n
size  trie map k a
tr = (trie map k a -> n -> n) -> n -> map k (trie map k a) -> n
forall a b. (a -> b -> b) -> b -> map k a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr  (n -> n -> n
forall a. Num a => a -> a -> a
(+) (n -> n -> n) -> (trie map k a -> n) -> trie map k a -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> n
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k n.
(Boolable (st a), Trie trie st map k, Num n) =>
trie map k a -> n
size)  (if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue (trie map k a -> st a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> st a
tVal trie map k a
tr) then n
1 else n
0) (trie map k a -> map k (trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap trie map k a
tr)

-- O(n m)
size' :: (Boolable (st a), Trie trie st map k, Num n) => trie map k a -> n
size' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k n.
(Boolable (st a), Trie trie st map k, Num n) =>
trie map k a -> n
size' trie map k a
tr = (n -> trie map k a -> n) -> n -> map k (trie map k a) -> n
forall b a. (b -> a -> b) -> b -> map k a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((trie map k a -> n -> n) -> n -> trie map k a -> n
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((trie map k a -> n -> n) -> n -> trie map k a -> n)
-> (trie map k a -> n -> n) -> n -> trie map k a -> n
forall a b. (a -> b) -> a -> b
$ n -> n -> n
forall a. Num a => a -> a -> a
(+) (n -> n -> n) -> (trie map k a -> n) -> trie map k a -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> n
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k n.
(Boolable (st a), Trie trie st map k, Num n) =>
trie map k a -> n
size')
                  (if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue (trie map k a -> st a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> st a
tVal trie map k a
tr) then n
1 else n
0)
                  (trie map k a -> map k (trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap trie map k a
tr)

-- O(min(m,s))
member :: (Alt st a, Boolable (st a), Trie trie st map k)
       => [k] -> trie map k a -> Bool
member :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> Bool
member = st a -> Bool
forall b. Boolable b => b -> Bool
hasValue (st a -> Bool)
-> ([k] -> trie map k a -> st a) -> [k] -> trie map k a -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: [k] -> trie map k a -> st a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> trie map k a -> st a
lookup

-- O(min(m,s))
notMember :: (Alt st a, Boolable (st a), Trie trie st map k)
          => [k] -> trie map k a -> Bool
notMember :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> Bool
notMember = Bool -> Bool
not (Bool -> Bool)
-> ([k] -> trie map k a -> Bool) -> [k] -> trie map k a -> Bool
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: [k] -> trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> Bool
member

-- O(min(m,s))
lookup :: (Alt st a, Trie trie st map k) => [k] -> trie map k a -> st a
lookup :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> trie map k a -> st a
lookup [k]
k trie map k a
tr =
   let (st a
v,[k]
prefix,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
prefix [k]
k of
            PrefixOrdering k
Same                   -> st a
v
            PostFix (Right (k
x:[k]
xs)) -> st a -> (trie map k a -> st a) -> Maybe (trie map k a) -> st a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty ([k] -> trie map k a -> st a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> trie map k a -> st a
lookup [k]
xs)
                                            (k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie map k a
m)
            PrefixOrdering k
_                      -> st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty

-- O(min(m,s))
lookupWithDefault :: (Alt st a, Trie trie st map k)
                  => a -> [k] -> trie map k a -> a
lookupWithDefault :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
a -> [k] -> trie map k a -> a
lookupWithDefault a
def [k]
k trie map k a
tr = st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap (st a -> a) -> st a -> a
forall a b. (a -> b) -> a -> b
$ [k] -> trie map k a -> st a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> trie map k a -> st a
lookup [k]
k trie map k a
tr st a -> st a -> st a
forall (a :: * -> *) x. Alt a x => a x -> a x -> a x
<|> a -> st a
forall a. a -> st a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
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 :: forall (st :: * -> *) a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Boolable (st b), Trie trie st map k) =>
(a -> b -> Bool) -> trie map k a -> trie map k b -> Bool
isSubmapOfBy a -> b -> Bool
f = trie map k a -> trie map k b -> Bool
forall {trie :: (* -> * -> *) -> * -> * -> *} {w :: * -> *}
       {m :: * -> * -> *} {k} {trie :: (* -> * -> *) -> * -> * -> *}
       {w :: * -> *}.
(Trie trie w m k, Trie trie w m k, Boolable (w b),
 Boolable (w a)) =>
trie m k a -> trie m k b -> Bool
go0
 where
   go0 :: trie m k a -> trie m k b -> Bool
go0 trie m k a
trl trie m k b
trr =
      let (w a
vl,[k]
prel,CMap trie m k a
ml) = trie m k a -> (w a, [k], CMap trie m k a)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
trl
          (w b
vr,[k]
prer,CMap trie m k b
mr) = trie m k b -> (w b, [k], CMap trie m k b)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
trr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
ml) [k]
prel [k]
prer of
               DifferedAt [k]
_ [k]
_ [k]
_  -> Bool
False

               -- Special case here: if the left trie is empty we return True.
               PostFix (Right [k]
_) -> trie m k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie m k a
trl
               PostFix (Left [k]
xs) -> CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go CMap trie m k b
mr w a
vl CMap trie m k a
ml [k]
xs
               PrefixOrdering k
Same              -> w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr

   go :: CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go CMap trie m k b
mr w a
vl CMap trie m k a
ml (k
x:[k]
xs) =
      case k -> CMap trie m k b -> Maybe (trie m k b)
forall a. k -> m k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie m k b
mr of
           Maybe (trie m k b)
Nothing -> Bool
False
           Just trie m k b
tr ->
              let (w b
vr,[k]
pre,CMap trie m k b
mr') = trie m k b -> (w b, [k], CMap trie m k b)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
tr
               in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k b -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k b
mr) [k]
xs [k]
pre of
                     DifferedAt [k]
_ [k]
_ [k]
_  -> Bool
False
                     PostFix (Right [k]
_) -> Bool
False
                     PostFix (Left [k]
ys) -> CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go CMap trie m k b
mr' w a
vl CMap trie m k a
ml [k]
ys
                     PrefixOrdering k
Same              -> w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr'

   go CMap trie m k b
_ w a
_ CMap trie m k a
_ [] =
      [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ListTrie.Patricia.Base.isSubmapOfBy :: internal error"

   same :: w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr =
      let hvl :: Bool
hvl = w a -> Bool
forall b. Boolable b => b -> Bool
hasValue w a
vl
          hvr :: Bool
hvr = w b -> Bool
forall b. Boolable b => b -> Bool
hasValue w b
vr
       in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (Bool
hvl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hvr)
              , (Bool -> Bool
not Bool
hvl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hvr) Bool -> Bool -> Bool
|| a -> b -> Bool
f (w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap w a
vl) (w b -> b
forall a. w a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap w b
vr)
              , (trie m k a -> trie m k b -> Bool)
-> CMap trie m k a -> CMap trie m k b -> Bool
forall a b. (a -> b -> Bool) -> m k a -> m k b -> Bool
forall (m :: * -> * -> *) k a b.
Map m k =>
(a -> b -> Bool) -> m k a -> m k b -> Bool
Map.isSubmapOfBy trie m k a -> trie m k b -> Bool
go0 CMap trie m k a
ml CMap trie m k b
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 :: forall (st :: * -> *) a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Boolable (st b), Trie trie st map k) =>
(a -> b -> Bool) -> trie map k a -> trie map k b -> Bool
isProperSubmapOfBy a -> b -> Bool
g = Bool -> trie map k a -> trie map k b -> Bool
forall {trie :: (* -> * -> *) -> * -> * -> *} {w :: * -> *}
       {m :: * -> * -> *} {k} {trie :: (* -> * -> *) -> * -> * -> *}
       {w :: * -> *}.
(Trie trie w m k, Trie trie w m k, Boolable (w b),
 Boolable (w a)) =>
Bool -> trie m k a -> trie m k b -> Bool
f Bool
False
 where
   f :: Bool -> trie m k a -> trie m k b -> Bool
f Bool
proper trie m k a
trl trie m k b
trr =
      let (w a
vl,[k]
prel,CMap trie m k a
ml) = trie m k a -> (w a, [k], CMap trie m k a)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
trl
          (w b
vr,[k]
prer,CMap trie m k b
mr) = trie m k b -> (w b, [k], CMap trie m k b)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
trr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
ml) [k]
prel [k]
prer of
               DifferedAt [k]
_ [k]
_ [k]
_  -> Bool
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 [k]
_) -> trie m k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie m k a
trl
               PostFix (Left [k]
xs) -> Bool -> CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go Bool
proper CMap trie m k b
mr w a
vl CMap trie m k a
ml [k]
xs
               PrefixOrdering k
Same              -> Bool -> w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same Bool
proper w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr

   go :: Bool -> CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go Bool
proper CMap trie m k b
mr w a
vl CMap trie m k a
ml (k
x:[k]
xs) =
      case k -> CMap trie m k b -> Maybe (trie m k b)
forall a. k -> m k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie m k b
mr of
           Maybe (trie m k b)
Nothing -> Bool
False
           Just trie m k b
tr ->
              let (w b
vr,[k]
pre,CMap trie m k b
mr') = trie m k b -> (w b, [k], CMap trie m k b)
forall a. trie m k a -> (w a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
tr
               in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k b -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k b
mr) [k]
xs [k]
pre of
                       DifferedAt [k]
_ [k]
_ [k]
_  -> Bool
False
                       PostFix (Right [k]
_) -> Bool
False
                       PostFix (Left [k]
ys) -> Bool -> CMap trie m k b -> w a -> CMap trie m k a -> [k] -> Bool
go Bool
proper CMap trie m k b
mr' w a
vl CMap trie m k a
ml [k]
ys
                       PrefixOrdering k
Same              -> Bool -> w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same Bool
proper w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr'

   go Bool
_ CMap trie m k b
_ w a
_ CMap trie m k a
_ [] =
      [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ListTrie.Patricia.Base.isProperSubmapOfBy :: internal error"

   same :: Bool -> w a -> w b -> CMap trie m k a -> CMap trie m k b -> Bool
same Bool
proper w a
vl w b
vr CMap trie m k a
ml CMap trie m k b
mr =
      let hvl :: Bool
hvl = w a -> Bool
forall b. Boolable b => b -> Bool
hasValue w a
vl
          hvr :: Bool
hvr = w b -> Bool
forall b. Boolable b => b -> Bool
hasValue w b
vr

          -- As the non-Patricia version, so does this seem suboptimal.
          proper' :: Bool
proper' = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [ Bool
proper
                       , Bool -> Bool
not Bool
hvl Bool -> Bool -> Bool
&& Bool
hvr
                       , Bool -> Bool
not (CMap trie m k b -> Bool
forall a. m k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null (CMap trie m k b -> Bool) -> CMap trie m k b -> Bool
forall a b. (a -> b) -> a -> b
$ CMap trie m k b -> CMap trie m k a -> CMap trie m k b
forall (m :: * -> * -> *) k a b. Map m k => m k a -> m k b -> m k a
Map.difference CMap trie m k b
mr CMap trie m k a
ml)
                       ]

       in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (Bool
hvl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hvr)
              , (Bool -> Bool
not Bool
hvl Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
hvr) Bool -> Bool -> Bool
|| a -> b -> Bool
g (w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap w a
vl) (w b -> b
forall a. w a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap w b
vr)
              , if CMap trie m k a -> Bool
forall a. m k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie m k a
ml
                   then Bool
proper'
                   else (trie m k a -> trie m k b -> Bool)
-> CMap trie m k a -> CMap trie m k b -> Bool
forall a b. (a -> b -> Bool) -> m k a -> m k b -> Bool
forall (m :: * -> * -> *) k a b.
Map m k =>
(a -> b -> Bool) -> m k a -> m k b -> Bool
Map.isSubmapOfBy (Bool -> trie m k a -> trie m k b -> Bool
f Bool
proper') CMap trie m k a
ml CMap trie m k b
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> a -> a
f = (st a -> trie map k a -> trie map k a)
-> (st a -> st a -> st a)
-> trie map k a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 -> st a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWith ((trie map k a -> st a -> trie map k a)
-> st a -> trie map k a -> trie map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k a -> st a -> trie map k a
forall a b. a -> b -> a
const) ((a -> a -> a) -> st a -> st a -> st a
forall (v :: * -> *) a.
Unionable v a =>
(a -> a -> a) -> v a -> v a -> v a
unionVals a -> a -> a
f)

-- 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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> a -> a
f = (st a -> trie map k a -> trie map k a)
-> (st a -> st a -> st a)
-> trie map k a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 -> st a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWith st a -> trie map k a -> trie map k a
forall a b. a -> b -> b
seq ((a -> a -> a) -> st a -> st a -> st a
forall (v :: * -> *) a.
Unionable v a =>
(a -> a -> a) -> v a -> v a -> v a
unionVals' a -> a -> a
f)

genericUnionWith :: (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 -> st a)
                 -> trie map k a
                 -> trie map k a
                 -> trie map k a
genericUnionWith :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 -> st a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWith st a -> trie map k a -> trie map k a
seeq = (st a -> st a -> st a)
-> trie map k a -> trie map k a -> trie map k a
go
 where
   go :: (st a -> st a -> st a)
-> trie map k a -> trie map k a -> trie map k a
go st a -> st a -> st a
valUnion trie map k a
tr1 trie map k a
tr2 =
      let (st a
v1,[k]
pre1,CMap trie map k a
m1) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr1
          (st a
v2,[k]
pre2,CMap trie map k a
m2) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr2
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m1) [k]
pre1 [k]
pre2 of
               PrefixOrdering k
Same ->
                  let v :: st a
v = st a -> st a -> st a
valUnion st a
v1 st a
v2

                      -- safeMkTrie not needed: if pre1 is not null then m1 or
                      -- v won't be and hence the union won't be.
                   in st a
v st a -> trie map k a -> trie map k a
`seeq` (trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie map k a -> trie map k a)
-> (CMap trie map k a -> trie map k a)
-> CMap trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre1 (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                                               (st a -> st a -> st a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
mapUnion st a -> st a -> st a
valUnion CMap trie map k a
m1 CMap trie map k a
m2)

               PostFix Either [k] [k]
remainder ->
                  -- As above, mkTrie is fine
                  --
                  -- The flip is important to retain left-biasedness
                  trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                     ([k] -> trie map k a)
-> ([k] -> trie map k a) -> Either [k] [k] -> trie map k a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                        (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v2 [k]
pre2 (CMap trie map k a -> trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (st a -> st a -> st a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
mapUnion ((st a -> st a -> st a) -> st a -> st a -> st a
forall a b c. (a -> b -> c) -> b -> a -> c
flip st a -> st a -> st a
valUnion) CMap trie map k a
m2 (CMap trie map k a -> CMap trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           CMap trie map k a -> st a -> [k] -> CMap trie map k a
forall {trie :: (* -> * -> *) -> * -> * -> *} {st :: * -> *}
       {map :: * -> * -> *} {k} {m :: * -> * -> *} {a}.
(Trie trie st map k, Map m k) =>
CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m1 st a
v1)
                        (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v1 [k]
pre1 (CMap trie map k a -> trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (st a -> st a -> st a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
mapUnion       st a -> st a -> st a
valUnion  CMap trie map k a
m1 (CMap trie map k a -> CMap trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                           CMap trie map k a -> st a -> [k] -> CMap trie map k a
forall {trie :: (* -> * -> *) -> * -> * -> *} {st :: * -> *}
       {map :: * -> * -> *} {k} {m :: * -> * -> *} {a}.
(Trie trie st map k, Map m k) =>
CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m2 st a
v2)
                        Either [k] [k]
remainder

               DifferedAt [k]
pr (k
x:[k]
xs) (k
y:[k]
ys) ->
                  -- As above, mkTrie is fine
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pr (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ k -> trie map k a -> k -> trie map k a -> CMap trie map k a
forall a. k -> a -> k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> k -> a -> m k a
Map.doubleton k
x (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v1 [k]
xs CMap trie map k a
m1)
                                                     k
y (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v2 [k]
ys CMap trie map k a
m2)

               PrefixOrdering k
_ -> trie map k a
forall {a}. a
can'tHappen

   mapUnion :: (st a -> st a -> st a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
mapUnion = (trie map k a -> trie map k a -> trie map k a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. (a -> a -> a) -> map k a -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a -> a) -> m k a -> m k a -> m k a
Map.unionWith ((trie map k a -> trie map k a -> trie map k a)
 -> CMap trie map k a -> CMap trie map k a -> CMap trie map k a)
-> ((st a -> st a -> st a)
    -> trie map k a -> trie map k a -> trie map k a)
-> (st a -> st a -> st a)
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (st a -> st a -> st a)
-> trie map k a -> trie map k a -> trie map k a
go

   decompress :: CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m st a
v (k
x:[k]
xs) = k -> trie map k a -> m k (trie map k a)
forall a. k -> a -> m k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a
Map.singleton k
x (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
xs CMap trie map k a
m)
   decompress CMap trie map k a
_ st a
_ []     = m k (trie map k a)
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (st a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(st a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWithKey ((trie map k a -> st a -> trie map k a)
-> st a -> trie map k a -> trie map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k a -> st a -> trie map k a
forall a b. a -> b -> a
const) (a -> a -> a) -> st a -> st a -> st a
forall (v :: * -> *) a.
Unionable v a =>
(a -> a -> a) -> v a -> v a -> v a
unionVals

-- 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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' = (st a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(st a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWithKey st a -> trie map k a -> trie map k a
forall a b. a -> b -> b
seq (a -> a -> a) -> st a -> st a -> st a
forall (v :: * -> *) a.
Unionable v a =>
(a -> a -> a) -> v a -> v a -> v a
unionVals'

genericUnionWithKey :: (Alt st a, Boolable (st a), Trie trie st map k)
                    => (st a -> trie map k a -> trie map k a)
                    -> ((a -> a -> a) -> st a -> st a -> st a)
                    -> ([k] -> a -> a -> a)
                    -> trie map k a
                    -> trie map k a
                    -> trie map k a
genericUnionWithKey :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(st a -> trie map k a -> trie map k a)
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
genericUnionWithKey st a -> trie map k a -> trie map k a
seeq = DList k
-> ((a -> a -> a) -> st a -> st a -> st a)
-> ([k] -> a -> a -> a)
-> trie map k a
-> trie map k a
-> trie map k a
forall {t}.
DList k
-> (t -> st a -> st a -> st a)
-> ([k] -> t)
-> trie map k a
-> trie map k a
-> trie map k a
go DList k
forall a. DList a
DL.empty
 where
   go :: DList k
-> (t -> st a -> st a -> st a)
-> ([k] -> t)
-> trie map k a
-> trie map k a
-> trie map k a
go DList k
k t -> st a -> st a -> st a
valUnion [k] -> t
j trie map k a
tr1 trie map k a
tr2 =
      let (st a
v1,[k]
pre1,CMap trie map k a
m1) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr1
          (st a
v2,[k]
pre2,CMap trie map k a
m2) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr2
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m1) [k]
pre1 [k]
pre2 of
               PrefixOrdering k
Same ->
                  let k' :: [k]
k' = DList k -> [k]
forall a. DList a -> [a]
DL.toList (DList k -> [k]) -> DList k -> [k]
forall a b. (a -> b) -> a -> b
$ DList k
k DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
pre1
                      v :: st a
v  = t -> st a -> st a -> st a
valUnion ([k] -> t
j [k]
k') st a
v1 st a
v2
                   in st a
v st a -> trie map k a -> trie map k a
`seeq`
                         (trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie map k a -> trie map k a)
-> (CMap trie map k a -> trie map k a)
-> CMap trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre1 (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                            (t -> st a -> st a -> st a)
-> ([k] -> t)
-> DList k
-> [k]
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
mapUnion t -> st a -> st a -> st a
valUnion [k] -> t
j DList k
k [k]
pre1 CMap trie map k a
m1 CMap trie map k a
m2)

               PostFix Either [k] [k]
remainder ->
                  trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                     ([k] -> trie map k a)
-> ([k] -> trie map k a) -> Either [k] [k] -> trie map k a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                        (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
v2 [k]
pre2 (CMap trie map k a -> trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> st a -> st a -> st a)
-> ([k] -> t)
-> DList k
-> [k]
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
mapUnion ((st a -> st a -> st a) -> st a -> st a -> st a
forall a b c. (a -> b -> c) -> b -> a -> c
flip((st a -> st a -> st a) -> st a -> st a -> st a)
-> (t -> st a -> st a -> st a) -> t -> st a -> st a -> st a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.t -> st a -> st a -> st a
valUnion) [k] -> t
j DList k
k [k]
pre2 CMap trie map k a
m2
                           (CMap trie map k a -> CMap trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> st a -> [k] -> CMap trie map k a
forall {trie :: (* -> * -> *) -> * -> * -> *} {st :: * -> *}
       {map :: * -> * -> *} {k} {m :: * -> * -> *} {a}.
(Trie trie st map k, Map m k) =>
CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m1 st a
v1)
                        (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
v1 [k]
pre1 (CMap trie map k a -> trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> st a -> st a -> st a)
-> ([k] -> t)
-> DList k
-> [k]
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
mapUnion       t -> st a -> st a -> st a
valUnion  [k] -> t
j DList k
k [k]
pre1 CMap trie map k a
m1
                           (CMap trie map k a -> CMap trie map k a)
-> ([k] -> CMap trie map k a) -> [k] -> CMap trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> st a -> [k] -> CMap trie map k a
forall {trie :: (* -> * -> *) -> * -> * -> *} {st :: * -> *}
       {map :: * -> * -> *} {k} {m :: * -> * -> *} {a}.
(Trie trie st map k, Map m k) =>
CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m2 st a
v2)
                        Either [k] [k]
remainder

               DifferedAt [k]
pr (k
x:[k]
xs) (k
y:[k]
ys) ->
                  st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pr (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ k -> trie map k a -> k -> trie map k a -> CMap trie map k a
forall a. k -> a -> k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> k -> a -> m k a
Map.doubleton k
x (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v1 [k]
xs CMap trie map k a
m1)
                                                     k
y (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v2 [k]
ys CMap trie map k a
m2)

               PrefixOrdering k
_ -> trie map k a
forall {a}. a
can'tHappen

   mk :: st a -> [k] -> CMap trie map k a -> trie map k a
mk = st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie

   mapUnion :: (t -> st a -> st a -> st a)
-> ([k] -> t)
-> DList k
-> [k]
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
mapUnion t -> st a -> st a -> st a
v [k] -> t
j DList k
k [k]
p =
      (k -> trie map k a -> trie map k a -> trie map k a)
-> CMap trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. (k -> a -> a -> a) -> map k a -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(k -> a -> a -> a) -> m k a -> m k a -> m k a
Map.unionWithKey ((k -> trie map k a -> trie map k a -> trie map k a)
 -> CMap trie map k a -> CMap trie map k a -> CMap trie map k a)
-> (k -> trie map k a -> trie map k a -> trie map k a)
-> CMap trie map k a
-> CMap trie map k a
-> CMap trie map k a
forall a b. (a -> b) -> a -> b
$
         \k
x -> DList k
-> (t -> st a -> st a -> st a)
-> ([k] -> t)
-> trie map k a
-> trie map k a
-> trie map k a
go (DList k
k DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
p DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
x) t -> st a -> st a -> st a
v [k] -> t
j

   decompress :: CMap trie map k a -> st a -> [k] -> m k (trie map k a)
decompress CMap trie map k a
m st a
v (k
x:[k]
xs) = k -> trie map k a -> m k (trie map k a)
forall a. k -> a -> m k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a
Map.singleton k
x (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
xs CMap trie map k a
m)
   decompress CMap trie map k a
_ st a
_ []     = m k (trie map k a)
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> a -> a
j = (trie map k a -> trie map k a -> trie map k a)
-> trie map k a -> [trie map k a] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> a -> a) -> trie map k a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> a -> a
j) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> a -> a
j = (trie map k a -> trie map k a -> trie map k a)
-> trie map k a -> [trie map k a] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((a -> a -> a) -> trie map k a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> a -> a
j) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k] -> a -> a -> a
j = (trie map k a -> trie map k a -> trie map k a)
-> trie map k a -> [trie map k a] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([k] -> a -> a -> a)
-> trie map k a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k] -> a -> a -> a
j) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' [k] -> a -> a -> a
j = (trie map k a -> trie map k a -> trie map k a)
-> trie map k a -> [trie map k a] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (([k] -> a -> a -> a)
-> trie map k a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' [k] -> a -> a -> a
j) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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 :: forall (st :: * -> *) a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> b -> Maybe a
j = trie map k a -> trie map k b -> trie map k a
forall {st :: * -> *} {trie :: (* -> * -> *) -> * -> * -> *}
       {m :: * -> * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}.
(Differentiable st a b, Boolable (st a), Trie trie st m a,
 Trie trie st m a) =>
trie m a a -> trie m a b -> trie m a a
go
 where
   go :: trie m a a -> trie m a b -> trie m a a
go trie m a a
tr1 trie m a b
tr2 =
      let (st a
v1,[a]
pre1,CMap trie m a a
m1) = trie m a a -> (st a, [a], CMap trie m a a)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a a
tr1
          (st b
v2,[a]
pre2,CMap trie m a b
m2) = trie m a b -> (st b, [a], CMap trie m a b)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a b
tr2
       in case (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m a a -> a -> a -> Bool
forall a. m a a -> a -> a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m a a
m1) [a]
pre1 [a]
pre2 of
               DifferedAt [a]
_ [a]
_ [a]
_   -> trie m a a
tr1
               PrefixOrdering a
Same               -> st a
-> st b -> [a] -> CMap trie m a a -> CMap trie m a b -> trie m a a
mk st a
v1 st b
v2 [a]
pre1 CMap trie m a a
m1 CMap trie m a b
m2
               PostFix (Left  [a]
xs) -> trie m a a -> CMap trie m a b -> [a] -> trie m a a
goRight trie m a a
tr1 CMap trie m a b
m2  [a]
xs
               PostFix (Right [a]
xs) -> trie m a a -> trie m a b -> [a] -> trie m a a
goLeft  trie m a a
tr1 trie m a b
tr2 [a]
xs

   dw :: trie m a a -> trie m a b -> Maybe (trie m a a)
dw trie m a a
a trie m a b
b =
      let c :: trie m a a
c = trie m a a -> trie m a b -> trie m a a
go trie m a a
a trie m a b
b
       in if trie m a a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie m a a
c then Maybe (trie m a a)
forall a. Maybe a
Nothing else trie m a a -> Maybe (trie m a a)
forall a. a -> Maybe a
Just trie m a a
c

   mk :: st a
-> st b -> [a] -> CMap trie m a a -> CMap trie m a b -> trie m a a
mk st a
v st b
v' [a]
p CMap trie m a a
m CMap trie m a b
m' =
      let vd :: st a
vd = (a -> b -> Maybe a) -> st a -> st b -> st a
forall (v :: * -> *) a b.
Differentiable v a b =>
(a -> b -> Maybe a) -> v a -> v b -> v a
differenceVals a -> b -> Maybe a
j st a
v st b
v'
       in trie m a a -> trie m a a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie m a a -> trie m a a)
-> (CMap trie m a a -> trie m a a) -> CMap trie m a a -> trie m a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [a] -> CMap trie m a a -> trie m a a
forall a. st a -> [a] -> CMap trie m a a -> trie m a a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vd [a]
p (CMap trie m a a -> trie m a a) -> CMap trie m a a -> trie m a a
forall a b. (a -> b) -> a -> b
$ (trie m a a -> trie m a b -> Maybe (trie m a a))
-> CMap trie m a a -> CMap trie m a b -> CMap trie m a a
forall a b. (a -> b -> Maybe a) -> m a a -> m a b -> m a a
forall (m :: * -> * -> *) k a b.
Map m k =>
(a -> b -> Maybe a) -> m k a -> m k b -> m k a
Map.differenceWith trie m a a -> trie m a b -> Maybe (trie m a a)
dw CMap trie m a a
m CMap trie m a b
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 :: trie m a a -> CMap trie m a b -> [a] -> trie m a a
goRight trie m a a
left CMap trie m a b
rightMap (a
x:[a]
xs) =
      let (st a
v,[a]
pre,CMap trie m a a
m) = trie m a a -> (st a, [a], CMap trie m a a)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a a
left
       in case a -> CMap trie m a b -> Maybe (trie m a b)
forall a. a -> m a a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup a
x CMap trie m a b
rightMap of
               Maybe (trie m a b)
Nothing     -> trie m a a
left
               Just trie m a b
right' ->
                  let (st b
v',[a]
pre',CMap trie m a b
m') = trie m a b -> (st b, [a], CMap trie m a b)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a b
right'
                   in case (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m a a -> a -> a -> Bool
forall a. m a a -> a -> a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m a a
m) [a]
xs [a]
pre' of
                           DifferedAt [a]
_ [a]
_ [a]
_   -> trie m a a
left
                           PrefixOrdering a
Same               -> st a
-> st b -> [a] -> CMap trie m a a -> CMap trie m a b -> trie m a a
mk st a
v st b
v' [a]
pre CMap trie m a a
m CMap trie m a b
m'
                           PostFix (Left  [a]
ys) -> trie m a a -> CMap trie m a b -> [a] -> trie m a a
goRight trie m a a
left CMap trie m a b
m'     [a]
ys
                           PostFix (Right [a]
ys) -> trie m a a -> trie m a b -> [a] -> trie m a a
goLeft  trie m a a
left trie m a b
right' [a]
ys

   goRight trie m a a
_ CMap trie m a b
_ [] = trie m a a
forall {a}. a
can'tHappen

   goLeft :: trie m a a -> trie m a b -> [a] -> trie m a a
goLeft trie m a a
left trie m a b
right (a
x:[a]
xs) =
      trie m a a -> trie m a a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie m a a -> trie m a a)
-> (CMap trie m a a -> trie m a a) -> CMap trie m a a -> trie m a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st a -> [a] -> CMap trie m a a -> trie m a a
forall a. st a -> [a] -> CMap trie m a a -> trie m a a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vl [a]
prel (CMap trie m a a -> trie m a a) -> CMap trie m a a -> trie m a a
forall a b. (a -> b) -> a -> b
$ (trie m a a -> Maybe (trie m a a))
-> a -> CMap trie m a a -> CMap trie m a a
forall a. (a -> Maybe a) -> a -> m a a -> m a a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> Maybe a) -> k -> m k a -> m k a
Map.update trie m a a -> Maybe (trie m a a)
f a
x CMap trie m a a
ml
    where
      (st a
vl,[a]
prel,CMap trie m a a
ml) = trie m a a -> (st a, [a], CMap trie m a a)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a a
left
      (st b
vr,   [a]
_,CMap trie m a b
mr) = trie m a b -> (st b, [a], CMap trie m a b)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a b
right

      f :: trie m a a -> Maybe (trie m a a)
f trie m a a
left' =
         let (st a
v,[a]
pre,CMap trie m a a
m) = trie m a a -> (st a, [a], CMap trie m a a)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a a
left'
          in case (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m a a -> a -> a -> Bool
forall a. m a a -> a -> a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m a a
m) [a]
pre [a]
xs of
                  DifferedAt [a]
_ [a]
_ [a]
_   -> trie m a a -> Maybe (trie m a a)
forall a. a -> Maybe a
Just trie m a a
left'
                  PrefixOrdering a
Same               -> trie m a a -> Maybe (trie m a a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m a a -> Maybe (trie m a a))
-> trie m a a -> Maybe (trie m a a)
forall a b. (a -> b) -> a -> b
$ st a
-> st b -> [a] -> CMap trie m a a -> CMap trie m a b -> trie m a a
mk st a
v st b
vr [a]
pre CMap trie m a a
m CMap trie m a b
mr
                  PostFix (Left  [a]
ys) -> trie m a a -> Maybe (trie m a a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m a a -> Maybe (trie m a a))
-> trie m a a -> Maybe (trie m a a)
forall a b. (a -> b) -> a -> b
$ trie m a a -> CMap trie m a b -> [a] -> trie m a a
goRight trie m a a
left' CMap trie m a b
mr    [a]
ys
                  PostFix (Right [a]
ys) -> trie m a a -> Maybe (trie m a a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m a a -> Maybe (trie m a a))
-> trie m a a -> Maybe (trie m a a)
forall a b. (a -> b) -> a -> b
$ trie m a a -> trie m a b -> [a] -> trie m a a
goLeft  trie m a a
left' trie m a b
right [a]
ys

      tryNull :: trie map k a -> Maybe (trie map k a)
tryNull trie map k a
t = if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
t then Maybe (trie map k a)
forall a. Maybe a
Nothing else trie map k a -> Maybe (trie map k a)
forall a. a -> Maybe a
Just trie map k a
t

   goLeft trie m a a
_ trie m a b
_ [] = trie m a a
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k] -> a -> b -> Maybe a
j = DList k -> trie map k a -> trie map k b -> trie map k a
forall {st :: * -> *} {trie :: (* -> * -> *) -> * -> * -> *}
       {m :: * -> * -> *} {trie :: (* -> * -> *) -> * -> * -> *}.
(Differentiable st a b, Boolable (st a), Trie trie st m k,
 Trie trie st m k) =>
DList k -> trie m k a -> trie m k b -> trie m k a
go DList k
forall a. DList a
DL.empty
 where
   go :: DList k -> trie m k a -> trie m k b -> trie m k a
go DList k
k trie m k a
tr1 trie m k b
tr2 =
      let (st a
v1,[k]
pre1,CMap trie m k a
m1) = trie m k a -> (st a, [k], CMap trie m k a)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
tr1
          (st b
v2,[k]
pre2,CMap trie m k b
m2) = trie m k b -> (st b, [k], CMap trie m k b)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
tr2
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
m1) [k]
pre1 [k]
pre2 of
               DifferedAt [k]
_ [k]
_ [k]
_   -> trie m k a
tr1
               PrefixOrdering k
Same               -> DList k
-> st a
-> st b
-> [k]
-> CMap trie m k a
-> CMap trie m k b
-> trie m k a
mk DList k
k st a
v1 st b
v2 [k]
pre1 CMap trie m k a
m1 CMap trie m k b
m2
               PostFix (Left  [k]
xs) -> DList k -> trie m k a -> CMap trie m k b -> [k] -> trie m k a
goRight (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k [k]
pre2) trie m k a
tr1 CMap trie m k b
m2  [k]
xs
               PostFix (Right [k]
xs) -> DList k -> trie m k a -> trie m k b -> [k] -> trie m k a
goLeft  (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k [k]
pre1) trie m k a
tr1 trie m k b
tr2 [k]
xs

   key :: DList a -> [a] -> DList a
key DList a
k [a]
p = DList a
k DList a -> DList a -> DList a
forall a. DList a -> DList a -> DList a
`DL.append` [a] -> DList a
forall a. [a] -> DList a
DL.fromList [a]
p

   dw :: DList k -> trie m k a -> trie m k b -> Maybe (trie m k a)
dw DList k
k trie m k a
a trie m k b
b =
      let c :: trie m k a
c = DList k -> trie m k a -> trie m k b -> trie m k a
go DList k
k trie m k a
a trie m k b
b
       in if trie m k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie m k a
c then Maybe (trie m k a)
forall a. Maybe a
Nothing else trie m k a -> Maybe (trie m k a)
forall a. a -> Maybe a
Just trie m k a
c

   mk :: DList k
-> st a
-> st b
-> [k]
-> CMap trie m k a
-> CMap trie m k b
-> trie m k a
mk DList k
k st a
v st b
v' [k]
p CMap trie m k a
m CMap trie m k b
m' =
      let k' :: DList k
k' = DList k
k DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
p
          vd :: st a
vd = (a -> b -> Maybe a) -> st a -> st b -> st a
forall (v :: * -> *) a b.
Differentiable v a b =>
(a -> b -> Maybe a) -> v a -> v b -> v a
differenceVals ([k] -> a -> b -> Maybe a
j ([k] -> a -> b -> Maybe a) -> [k] -> a -> b -> Maybe a
forall a b. (a -> b) -> a -> b
$ DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
k') st a
v st b
v'
       in trie m k a -> trie m k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie m k a -> trie m k a)
-> (CMap trie m k a -> trie m k a) -> CMap trie m k a -> trie m k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [k] -> CMap trie m k a -> trie m k a
forall a. st a -> [k] -> CMap trie m k a -> trie m k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vd [k]
p (CMap trie m k a -> trie m k a) -> CMap trie m k a -> trie m k a
forall a b. (a -> b) -> a -> b
$
             (k -> trie m k a -> trie m k b -> Maybe (trie m k a))
-> CMap trie m k a -> CMap trie m k b -> CMap trie m k a
forall a b. (k -> a -> b -> Maybe a) -> m k a -> m k b -> m k a
forall (m :: * -> * -> *) k a b.
Map m k =>
(k -> a -> b -> Maybe a) -> m k a -> m k b -> m k a
Map.differenceWithKey (DList k -> trie m k a -> trie m k b -> Maybe (trie m k a)
dw (DList k -> trie m k a -> trie m k b -> Maybe (trie m k a))
-> (k -> DList k)
-> k
-> trie m k a
-> trie m k b
-> Maybe (trie m k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DList k
k' DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc`)) CMap trie m k a
m CMap trie m k b
m'

   goRight :: DList k -> trie m k a -> CMap trie m k b -> [k] -> trie m k a
goRight DList k
k trie m k a
left CMap trie m k b
rightMap (k
x:[k]
xs) =
      let (st a
vl,[k]
_,CMap trie m k a
ml) = trie m k a -> (st a, [k], CMap trie m k a)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
left
       in case k -> CMap trie m k b -> Maybe (trie m k b)
forall a. k -> m k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie m k b
rightMap of
               Maybe (trie m k b)
Nothing    -> trie m k a
left
               Just trie m k b
right ->
                  let (st b
vr,[k]
pre,CMap trie m k b
mr) = trie m k b -> (st b, [k], CMap trie m k b)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
right
                      k' :: DList k
k'          = DList k
k DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
x
                   in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
ml) [k]
xs [k]
pre of
                           DifferedAt [k]
_ [k]
_ [k]
_   -> trie m k a
left
                           PrefixOrdering k
Same               -> DList k
-> st a
-> st b
-> [k]
-> CMap trie m k a
-> CMap trie m k b
-> trie m k a
mk DList k
k' st a
vl st b
vr [k]
pre CMap trie m k a
ml CMap trie m k b
mr
                           PostFix (Left  [k]
ys) -> DList k -> trie m k a -> CMap trie m k b -> [k] -> trie m k a
goRight (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k' [k]
pre)
                                                         trie m k a
left CMap trie m k b
mr    [k]
ys
                           PostFix (Right [k]
ys) -> DList k -> trie m k a -> trie m k b -> [k] -> trie m k a
goLeft  (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k' [k]
xs)
                                                         trie m k a
left trie m k b
right [k]
ys

   goRight DList k
_ trie m k a
_ CMap trie m k b
_ [] = trie m k a
forall {a}. a
can'tHappen

   goLeft :: DList k -> trie m k a -> trie m k b -> [k] -> trie m k a
goLeft DList k
k trie m k a
left trie m k b
right (k
x:[k]
xs) =
      trie m k a -> trie m k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie m k a -> trie m k a)
-> (CMap trie m k a -> trie m k a) -> CMap trie m k a -> trie m k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st a -> [k] -> CMap trie m k a -> trie m k a
forall a. st a -> [k] -> CMap trie m k a -> trie m k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vl [k]
prel (CMap trie m k a -> trie m k a) -> CMap trie m k a -> trie m k a
forall a b. (a -> b) -> a -> b
$ (trie m k a -> Maybe (trie m k a))
-> k -> CMap trie m k a -> CMap trie m k a
forall a. (a -> Maybe a) -> k -> m k a -> m k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> Maybe a) -> k -> m k a -> m k a
Map.update trie m k a -> Maybe (trie m k a)
f k
x CMap trie m k a
ml
    where
      (st a
vl,[k]
prel,CMap trie m k a
ml) = trie m k a -> (st a, [k], CMap trie m k a)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
left
      (st b
vr,   [k]
_,CMap trie m k b
mr) = trie m k b -> (st b, [k], CMap trie m k b)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k b
right

      k' :: DList k
k' = DList k
k DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
x

      f :: trie m k a -> Maybe (trie m k a)
f trie m k a
left' =
         let (st a
v,[k]
pre,CMap trie m k a
m) = trie m k a -> (st a, [k], CMap trie m k a)
forall a. trie m k a -> (st a, [k], CMap trie m k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m k a
left'
          in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie m k a -> k -> k -> Bool
forall a. m k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie m k a
m) [k]
pre [k]
xs of
                  DifferedAt [k]
_ [k]
_ [k]
_   -> trie m k a -> Maybe (trie m k a)
forall a. a -> Maybe a
Just trie m k a
left'
                  PrefixOrdering k
Same               -> trie m k a -> Maybe (trie m k a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m k a -> Maybe (trie m k a))
-> trie m k a -> Maybe (trie m k a)
forall a b. (a -> b) -> a -> b
$ DList k
-> st a
-> st b
-> [k]
-> CMap trie m k a
-> CMap trie m k b
-> trie m k a
mk DList k
k' st a
v st b
vr [k]
pre CMap trie m k a
m CMap trie m k b
mr
                  PostFix (Left  [k]
ys) -> trie m k a -> Maybe (trie m k a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m k a -> Maybe (trie m k a))
-> trie m k a -> Maybe (trie m k a)
forall a b. (a -> b) -> a -> b
$ DList k -> trie m k a -> CMap trie m k b -> [k] -> trie m k a
goRight (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k' [k]
xs)
                                                          trie m k a
left' CMap trie m k b
mr    [k]
ys
                  PostFix (Right [k]
ys) -> trie m k a -> Maybe (trie m k a)
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Maybe (trie map k a)
tryNull (trie m k a -> Maybe (trie m k a))
-> trie m k a -> Maybe (trie m k a)
forall a b. (a -> b) -> a -> b
$ DList k -> trie m k a -> trie m k b -> [k] -> trie m k a
goLeft  (DList k -> [k] -> DList k
forall {a}. DList a -> [a] -> DList a
key DList k
k' [k]
pre)
                                                          trie m k a
left' trie m k b
right [k]
ys

      tryNull :: trie map k a -> Maybe (trie map k a)
tryNull trie map k a
t = if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
t then Maybe (trie map k a)
forall a. Maybe a
Nothing else trie map k a -> Maybe (trie map k a)
forall a. a -> Maybe a
Just trie map k a
t

   goLeft DList k
_ trie m k a
_ trie m k b
_ [] = trie m k a
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) c a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> b -> c
f = (forall x. st x -> trie map k x -> trie map k x)
-> (st a -> st b -> st c)
-> trie map k a
-> trie map k b
-> trie map k c
forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> (st a -> st b -> st c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWith ((trie map k x -> st x -> trie map k x)
-> st x -> trie map k x -> trie map k x
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k x -> st x -> trie map k x
forall a b. a -> b -> a
const) ((a -> b -> c) -> st a -> st b -> st c
forall (v :: * -> *) a b c.
Intersectable v a b c =>
(a -> b -> c) -> v a -> v b -> v c
intersectionVals a -> b -> c
f)

-- 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' :: forall (st :: * -> *) c a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> b -> c
f = (forall x. st x -> trie map k x -> trie map k x)
-> (st a -> st b -> st c)
-> trie map k a
-> trie map k b
-> trie map k c
forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> (st a -> st b -> st c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWith st x -> trie map k x -> trie map k x
forall x. st x -> trie map k x -> trie map k x
forall a b. a -> b -> b
seq ((a -> b -> c) -> st a -> st b -> st c
forall (v :: * -> *) a b c.
Intersectable v a b c =>
(a -> b -> c) -> v a -> v b -> v c
intersectionVals' a -> b -> c
f)

genericIntersectionWith :: forall a b c k map st trie.
                           ( Alt st c, Boolable (st c)
                           , Trie trie st map k
                           )
                        => (forall x. st x -> trie map k x -> trie map k x)
                        -> (st a -> st b -> st c)
                        -> trie map k a
                        -> trie map k b
                        -> trie map k c
genericIntersectionWith :: forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> (st a -> st b -> st c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWith forall x. st x -> trie map k x -> trie map k x
seeq = (st a -> st b -> st c)
-> trie map k a -> trie map k b -> trie map k c
forall {a} {y} {x}.
(Boolable (st a), Alt st a) =>
(st y -> st x -> st a)
-> trie map k y -> trie map k x -> trie map k a
go0
 where
   go0 :: (st y -> st x -> st a)
-> trie map k y -> trie map k x -> trie map k a
go0 st y -> st x -> st a
valIsect trie map k y
trl trie map k x
trr =
      let (st y
vl,[k]
prel,CMap trie map k y
ml) = trie map k y -> (st y, [k], CMap trie map k y)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k y
trl
          (st x
vr,[k]
prer,CMap trie map k x
mr) = trie map k x -> (st x, [k], CMap trie map k x)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k x
trr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k y -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k y
ml) [k]
prel [k]
prer of
               DifferedAt [k]
_ [k]
_ [k]
_  -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
               PrefixOrdering k
Same              -> (st y -> st x -> st a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk st y -> st x -> st a
valIsect st y
vl st x
vr [k]
prel CMap trie map k y
ml CMap trie map k x
mr
               PostFix Either [k] [k]
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
                  ([k] -> trie map k a)
-> ([k] -> trie map k a) -> Either [k] [k] -> trie map k a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((st y -> st x -> st a)
-> CMap trie map k x
-> st y
-> CMap trie map k y
-> DList k
-> [k]
-> trie map k a
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
(st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
go       st y -> st x -> st a
valIsect  CMap trie map k x
mr st y
vl CMap trie map k y
ml ([k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
prel))
                         ((st x -> st y -> st a)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k a
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
(st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
go ((st y -> st x -> st a) -> st x -> st y -> st a
forall a b c. (a -> b -> c) -> b -> a -> c
flip st y -> st x -> st a
valIsect) CMap trie map k y
ml st x
vr CMap trie map k x
mr ([k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
prer))
                         Either [k] [k]
remainder

   mapIntersect :: (st y -> st x -> st a)
-> CMap trie map k y -> CMap trie map k x -> CMap trie map k a
mapIntersect st y -> st x -> st a
valIsect =
      (trie map k a -> Bool) -> CMap trie map k a -> CMap trie map k a
forall a. (a -> Bool) -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> Bool) -> m k a -> m k a
Map.filter (Bool -> Bool
not(Bool -> Bool) -> (trie map k a -> Bool) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null) (CMap trie map k a -> CMap trie map k a)
-> (CMap trie map k y -> CMap trie map k x -> CMap trie map k a)
-> CMap trie map k y
-> CMap trie map k x
-> CMap trie map k a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.:
         (trie map k y -> trie map k x -> trie map k a)
-> CMap trie map k y -> CMap trie map k x -> CMap trie map k a
forall a b c. (a -> b -> c) -> map k a -> map k b -> map k c
forall (m :: * -> * -> *) k a b c.
Map m k =>
(a -> b -> c) -> m k a -> m k b -> m k c
Map.intersectionWith ((st y -> st x -> st a)
-> trie map k y -> trie map k x -> trie map k a
go0 st y -> st x -> st a
valIsect)

   mk :: (st y -> st x -> st a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk st y -> st x -> st a
valIsect st y
v st x
v' [k]
p CMap trie map k y
m CMap trie map k x
m' =
      let vi :: st a
vi = st y -> st x -> st a
valIsect st y
v st x
v'
       in st a
vi st a -> trie map k a -> trie map k a
forall x. st x -> trie map k x -> trie map k x
`seeq` (trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie map k a -> trie map k a)
-> (CMap trie map k a -> trie map k a)
-> CMap trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vi [k]
p (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ (st y -> st x -> st a)
-> CMap trie map k y -> CMap trie map k x -> CMap trie map k a
mapIntersect st y -> st x -> st a
valIsect CMap trie map k y
m CMap trie map k x
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)
      -> CMap trie map k y
      -> st x
      -> CMap trie map k x
      -> DList k
      -> [k]
      -> trie map k z
   go :: forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
(st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
go st x -> st y -> st z
valIsect CMap trie map k y
ma st x
v CMap trie map k x
mb DList k
pre (k
x:[k]
xs) =
      case k -> CMap trie map k y -> Maybe (trie map k y)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie map k y
ma of
           Maybe (trie map k y)
Nothing -> trie map k z
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
           Just trie map k y
tr ->
              let (st y
v',[k]
pre',CMap trie map k y
m') = trie map k y -> (st y, [k], CMap trie map k y)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k y
tr
               in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k y -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k y
ma) [k]
xs [k]
pre' of
                       DifferedAt [k]
_ [k]
_ [k]
_   -> trie map k z
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
                       PrefixOrdering k
Same               ->
                          (st x -> st y -> st z)
-> st x
-> st y
-> [k]
-> CMap trie map k x
-> CMap trie map k y
-> trie map k z
forall {a} {y} {x}.
(Boolable (st a), Alt st a) =>
(st y -> st x -> st a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk st x -> st y -> st z
valIsect st x
v st y
v' (DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
pre) CMap trie map k x
mb CMap trie map k y
m'
                       PostFix (Right [k]
ys) ->
                          let nextPre :: DList k
nextPre = DList k
pre DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
ys
                           in (st y -> st x -> st z)
-> CMap trie map k x
-> st y
-> CMap trie map k y
-> DList k
-> [k]
-> trie map k z
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
(st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
go ((st x -> st y -> st z) -> st y -> st x -> st z
forall a b c. (a -> b -> c) -> b -> a -> c
flip st x -> st y -> st z
valIsect) CMap trie map k x
mb st y
v' CMap trie map k y
m' DList k
nextPre [k]
ys
                       PostFix (Left  [k]
ys) ->
                              (st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
(st x -> st y -> st z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
go       st x -> st y -> st z
valIsect  CMap trie map k y
m' st x
v  CMap trie map k x
mb DList k
pre     [k]
ys

   go st x -> st y -> st z
_ CMap trie map k y
_ st x
_ CMap trie map k x
_ DList k
_ [] =
      [Char] -> trie map k z
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) c a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (forall x. st x -> trie map k x -> trie map k x)
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWithKey ((trie map k x -> st x -> trie map k x)
-> st x -> trie map k x -> trie map k x
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k x -> st x -> trie map k x
forall a b. a -> b -> a
const) (a -> b -> c) -> st a -> st b -> st c
forall (v :: * -> *) a b c.
Intersectable v a b c =>
(a -> b -> c) -> v a -> v b -> v c
intersectionVals

-- 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' :: forall (st :: * -> *) c a b (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' = (forall x. st x -> trie map k x -> trie map k x)
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWithKey st x -> trie map k x -> trie map k x
forall x. st x -> trie map k x -> trie map k x
forall a b. a -> b -> b
seq (a -> b -> c) -> st a -> st b -> st c
forall (v :: * -> *) a b c.
Intersectable v a b c =>
(a -> b -> c) -> v a -> v b -> v c
intersectionVals'

genericIntersectionWithKey :: forall a b c k map st trie.
                              (Alt st c, Boolable (st c), Trie trie st map k)
                           => (forall x. st x -> trie map k x -> trie map k x)
                           -> ((a -> b -> c) -> st a -> st b -> st c)
                           -> ([k] -> a -> b -> c)
                           -> trie map k a
                           -> trie map k b
                           -> trie map k c
genericIntersectionWithKey :: forall a b c k (map :: * -> * -> *) (st :: * -> *)
       (trie :: (* -> * -> *) -> * -> * -> *).
(Alt st c, Boolable (st c), Trie trie st map k) =>
(forall x. st x -> trie map k x -> trie map k x)
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
genericIntersectionWithKey forall x. st x -> trie map k x -> trie map k x
seeq = DList k
-> ((a -> b -> c) -> st a -> st b -> st c)
-> ([k] -> a -> b -> c)
-> trie map k a
-> trie map k b
-> trie map k c
forall {a} {y} {x}.
(Boolable (st a), Alt st a) =>
DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> trie map k y
-> trie map k x
-> trie map k a
main DList k
forall a. DList a
DL.empty
 where
   main :: DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> trie map k y
-> trie map k x
-> trie map k a
main DList k
k (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j trie map k y
trl trie map k x
trr =
      let (st y
vl,[k]
prel,CMap trie map k y
ml) = trie map k y -> (st y, [k], CMap trie map k y)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k y
trl
          (st x
vr,[k]
prer,CMap trie map k x
mr) = trie map k x -> (st x, [k], CMap trie map k x)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k x
trr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k y -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k y
ml) [k]
prel [k]
prer of
               DifferedAt [k]
_ [k]
_ [k]
_ -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
               PrefixOrdering k
Same             -> DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk DList k
k (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j st y
vl st x
vr [k]
prel CMap trie map k y
ml CMap trie map k x
mr
               PostFix Either [k] [k]
remainder ->
                  let prel' :: DList k
prel' = [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
prel
                      prer' :: DList k
prer' = [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
prer
                   in ([k] -> trie map k a)
-> ([k] -> trie map k a) -> Either [k] [k] -> trie map k a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                         (DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> CMap trie map k x
-> st y
-> CMap trie map k y
-> DList k
-> [k]
-> trie map k a
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
DList k
-> ((x -> y -> z) -> st x -> st y -> st 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 DList k
k       (y -> x -> a) -> st y -> st x -> st a
valIsect        [k] -> y -> x -> a
j  CMap trie map k x
mr st y
vl CMap trie map k y
ml DList k
prel')
                         (DList k
-> ((x -> y -> a) -> st x -> st y -> st a)
-> ([k] -> x -> y -> a)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k a
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
DList k
-> ((x -> y -> z) -> st x -> st y -> st 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 DList k
k (((y -> x -> a) -> st y -> st x -> st a)
-> (x -> y -> a) -> st x -> st y -> st a
forall x y z.
((x -> y -> z) -> st x -> st y -> st z)
-> (y -> x -> z) -> st y -> st x -> st z
flop (y -> x -> a) -> st y -> st x -> st a
valIsect) ((y -> x -> a) -> x -> y -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip((y -> x -> a) -> x -> y -> a)
-> ([k] -> y -> x -> a) -> [k] -> x -> y -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[k] -> y -> x -> a
j) CMap trie map k y
ml st x
vr CMap trie map k x
mr DList k
prer')
                         Either [k] [k]
remainder

   mk :: DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk DList k
k (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j st y
v st x
v' [k]
p CMap trie map k y
m CMap trie map k x
m' =
      let k' :: DList k
k' = DList k
k DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
p
          vi :: st a
vi = (y -> x -> a) -> st y -> st x -> st a
valIsect ([k] -> y -> x -> a
j ([k] -> y -> x -> a) -> [k] -> y -> x -> a
forall a b. (a -> b) -> a -> b
$ DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
k') st y
v st x
v'
       in st a
vi st a -> trie map k a -> trie map k a
forall x. st x -> trie map k x -> trie map k x
`seeq` (trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie map k a -> trie map k a)
-> (CMap trie map k a -> trie map k a)
-> CMap trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
vi [k]
p (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$
                                    DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> CMap trie map k y
-> CMap trie map k x
-> CMap trie map k a
mapIntersect DList k
k' (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j CMap trie map k y
m CMap trie map k x
m')

   mapIntersect :: DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> CMap trie map k y
-> CMap trie map k x
-> CMap trie map k a
mapIntersect DList k
k (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j =
      (trie map k a -> Bool) -> CMap trie map k a -> CMap trie map k a
forall a. (a -> Bool) -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> Bool) -> m k a -> m k a
Map.filter (Bool -> Bool
not(Bool -> Bool) -> (trie map k a -> Bool) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null) (CMap trie map k a -> CMap trie map k a)
-> (CMap trie map k y -> CMap trie map k x -> CMap trie map k a)
-> CMap trie map k y
-> CMap trie map k x
-> CMap trie map k a
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.:
         (k -> trie map k y -> trie map k x -> trie map k a)
-> CMap trie map k y -> CMap trie map k x -> CMap trie map k a
forall a b c. (k -> a -> b -> c) -> map k a -> map k b -> map k c
forall (m :: * -> * -> *) k a b c.
Map m k =>
(k -> a -> b -> c) -> m k a -> m k b -> m k c
Map.intersectionWithKey (\k
x -> DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> trie map k y
-> trie map k x
-> trie map k a
main (DList k
k DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
x) (y -> x -> a) -> st y -> st x -> st a
valIsect [k] -> y -> x -> a
j)

   flop :: ((x -> y -> z) -> st x -> st y -> st z)
         -> ((y -> x -> z) -> st y -> st x -> st z)
   flop :: forall x y z.
((x -> y -> z) -> st x -> st y -> st z)
-> (y -> x -> z) -> st y -> st x -> st z
flop (x -> y -> z) -> st x -> st y -> st z
f = (st x -> st y -> st z) -> st y -> st x -> st z
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((st x -> st y -> st z) -> st y -> st x -> st z)
-> ((y -> x -> z) -> st x -> st y -> st z)
-> (y -> x -> z)
-> st y
-> st x
-> st z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> y -> z) -> st x -> st y -> st z
f ((x -> y -> z) -> st x -> st y -> st z)
-> ((y -> x -> z) -> x -> y -> z)
-> (y -> x -> z)
-> st x
-> st y
-> st z
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (y -> x -> z) -> x -> y -> z
forall a b c. (a -> b -> c) -> b -> a -> c
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)
      -> ([k] -> x -> y -> z)
      -> CMap trie map k y
      -> st x
      -> CMap trie map k x
      -> DList k
      -> [k]
      -> trie map k z
   go :: forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
DList k
-> ((x -> y -> z) -> st x -> st y -> st 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 DList k
k (x -> y -> z) -> st x -> st y -> st z
valIsect [k] -> x -> y -> z
j CMap trie map k y
ma st x
v CMap trie map k x
mb DList k
pre (k
x:[k]
xs) =
      case k -> CMap trie map k y -> Maybe (trie map k y)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
x CMap trie map k y
ma of
           Maybe (trie map k y)
Nothing -> trie map k z
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
           Just trie map k y
tr ->
              let (st y
v',[k]
pre',CMap trie map k y
m') = trie map k y -> (st y, [k], CMap trie map k y)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k y
tr
               in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k y -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k y
ma) [k]
xs [k]
pre' of
                       DifferedAt [k]
_ [k]
_ [k]
_   -> trie map k z
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
                       PrefixOrdering k
Same               ->
                          DList k
-> ((x -> y -> z) -> st x -> st y -> st z)
-> ([k] -> x -> y -> z)
-> st x
-> st y
-> [k]
-> CMap trie map k x
-> CMap trie map k y
-> trie map k z
forall {a} {y} {x}.
(Boolable (st a), Alt st a) =>
DList k
-> ((y -> x -> a) -> st y -> st x -> st a)
-> ([k] -> y -> x -> a)
-> st y
-> st x
-> [k]
-> CMap trie map k y
-> CMap trie map k x
-> trie map k a
mk DList k
k (x -> y -> z) -> st x -> st y -> st z
valIsect [k] -> x -> y -> z
j st x
v st y
v' (DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
pre) CMap trie map k x
mb CMap trie map k y
m'
                       PostFix (Right [k]
ys) ->
                          let nextPre :: DList k
nextPre = DList k
pre DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
ys
                           in DList k
-> ((y -> x -> z) -> st y -> st x -> st z)
-> ([k] -> y -> x -> z)
-> CMap trie map k x
-> st y
-> CMap trie map k y
-> DList k
-> [k]
-> trie map k z
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
DList k
-> ((x -> y -> z) -> st x -> st y -> st 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 DList k
k (((x -> y -> z) -> st x -> st y -> st z)
-> (y -> x -> z) -> st y -> st x -> st z
forall x y z.
((x -> y -> z) -> st x -> st y -> st z)
-> (y -> x -> z) -> st y -> st x -> st z
flop (x -> y -> z) -> st x -> st y -> st z
valIsect) ((x -> y -> z) -> y -> x -> z
forall a b c. (a -> b -> c) -> b -> a -> c
flip((x -> y -> z) -> y -> x -> z)
-> ([k] -> x -> y -> z) -> [k] -> y -> x -> z
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[k] -> x -> y -> z
j) CMap trie map k x
mb st y
v' CMap trie map k y
m' DList k
nextPre [k]
ys
                       PostFix (Left  [k]
ys) ->
                              DList k
-> ((x -> y -> z) -> st x -> st y -> st z)
-> ([k] -> x -> y -> z)
-> CMap trie map k y
-> st x
-> CMap trie map k x
-> DList k
-> [k]
-> trie map k z
forall z x y.
(Alt st z, Boolable (st z), Trie trie st map k) =>
DList k
-> ((x -> y -> z) -> st x -> st y -> st 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 DList k
k        (x -> y -> z) -> st x -> st y -> st z
valIsect       [k] -> x -> y -> z
j  CMap trie map k y
m' st x
v  CMap trie map k x
mb DList k
pre     [k]
ys

   go DList k
_ (x -> y -> z) -> st x -> st y -> st z
_ [k] -> x -> y -> z
_ CMap trie map k y
_ st x
_ CMap trie map k x
_ DList k
_ [] =
      [Char] -> trie map k z
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
([k] -> a -> Bool) -> trie map k a -> trie map k a
filterWithKey [k] -> a -> Bool
p = [([k], a)] -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[([k], a)] -> trie map k a
fromList ([([k], a)] -> trie map k a)
-> (trie map k a -> [([k], a)]) -> trie map k a -> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([k], a) -> Bool) -> [([k], a)] -> [([k], a)]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter (([k] -> a -> Bool) -> ([k], a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> Bool
p) ([([k], a)] -> [([k], a)])
-> (trie map k a -> [([k], a)]) -> trie map k a -> [([k], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k] -> a -> Bool
p = ([([k], a)] -> trie map k a)
-> ([([k], a)], [([k], a)]) -> (trie map k a, trie map k a)
forall a b. (a -> b) -> (a, a) -> (b, b)
both [([k], a)] -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[([k], a)] -> trie map k a
fromList (([([k], a)], [([k], a)]) -> (trie map k a, trie map k a))
-> (trie map k a -> ([([k], a)], [([k], a)]))
-> trie map k a
-> (trie map k a, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([k], a) -> Bool) -> [([k], a)] -> ([([k], a)], [([k], a)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (([k] -> a -> Bool) -> ([k], a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> Bool
p) ([([k], a)] -> ([([k], a)], [([k], a)]))
-> (trie map k a -> [([k], a)])
-> trie map k a
-> ([([k], a)], [([k], a)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2.
(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 [([k2], a)] -> trie map k2 a
fromlist [k1] -> [k2]
f = [([k2], a)] -> trie map k2 a
fromlist ([([k2], a)] -> trie map k2 a)
-> (trie map k1 a -> [([k2], a)]) -> trie map k1 a -> trie map k2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([k1], a) -> ([k2], a)) -> [([k1], a)] -> [([k2], a)]
forall a b. (a -> b) -> [a] -> [b]
map (([k1] -> [k2]) -> ([k1], a) -> ([k2], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [k1] -> [k2]
f) ([([k1], a)] -> [([k2], a)])
-> (trie map k1 a -> [([k1], a)]) -> trie map k1 a -> [([k2], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k1 a -> [([k1], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2.
(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 = (() -> trie map k2 a -> trie map k2 a)
-> ([k2] -> ())
-> ((a -> a -> a)
    -> trie map k2 a -> trie map k2 a -> trie map k2 a)
-> (a -> a -> a)
-> (k1 -> k2)
-> trie map k1 a
-> trie map k2 a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2 f.
(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 ((trie map k2 a -> () -> trie map k2 a)
-> () -> trie map k2 a -> trie map k2 a
forall a b c. (a -> b -> c) -> b -> a -> c
flip trie map k2 a -> () -> trie map k2 a
forall a b. a -> b -> a
const) (() -> [k2] -> ()
forall a b. a -> b -> a
const ()) (a -> a -> a) -> trie map k2 a -> trie map k2 a -> trie map k2 a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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

-- 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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2.
(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' =
   (() -> trie map k2 a -> trie map k2 a)
-> ([k2] -> ())
-> ((a -> a -> a)
    -> trie map k2 a -> trie map k2 a -> trie map k2 a)
-> (a -> a -> a)
-> (k1 -> k2)
-> trie map k1 a
-> trie map k2 a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2 f.
(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
      () -> trie map k2 a -> trie map k2 a
forall a b. a -> b -> b
seq
      (\[k2]
xs -> if [k2] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Prelude.null [k2]
xs then () else (k2 -> k2 -> k2) -> [k2] -> k2
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' k2 -> k2 -> k2
forall a b. a -> b -> b
seq [k2]
xs k2 -> () -> ()
forall a b. a -> b -> b
`seq` ())
      (a -> a -> a) -> trie map k2 a -> trie map k2 a -> trie map k2 a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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'

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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k1 k2 f.
(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 () -> trie map k2 a -> trie map k2 a
seeq [k2] -> ()
listSeq f -> trie map k2 a -> trie map k2 a -> trie map k2 a
unionW f
j k1 -> k2
f = trie map k1 a -> trie map k2 a
forall {trie :: (* -> * -> *) -> * -> * -> *} {map :: * -> * -> *}.
Trie trie st map k1 =>
trie map k1 a -> trie map k2 a
go
 where
   go :: trie map k1 a -> trie map k2 a
go trie map k1 a
tr =
      let (st a
v,[k1]
p,CMap trie map k1 a
m) = trie map k1 a -> (st a, [k1], CMap trie map k1 a)
forall a. trie map k1 a -> (st a, [k1], CMap trie map k1 a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k1 a
tr
          p' :: [k2]
p'      = (k1 -> k2) -> [k1] -> [k2]
forall a b. (a -> b) -> [a] -> [b]
map k1 -> k2
f [k1]
p
       in [k2] -> ()
listSeq [k2]
p' () -> trie map k2 a -> trie map k2 a
`seeq`
             (st a -> [k2] -> CMap trie map k2 a -> trie map k2 a
forall a. st a -> [k2] -> CMap trie map k2 a -> trie map k2 a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k2]
p' (CMap trie map k2 a -> trie map k2 a)
-> CMap trie map k2 a -> trie map k2 a
forall a b. (a -> b) -> a -> b
$
                 (trie map k2 a -> trie map k2 a -> trie map k2 a)
-> [(k2, trie map k2 a)] -> CMap trie map k2 a
forall a. (a -> a -> a) -> [(k2, a)] -> map k2 a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a -> a) -> [(k, a)] -> m k a
Map.fromListKVWith (f -> trie map k2 a -> trie map k2 a -> trie map k2 a
unionW f
j) ([(k2, trie map k2 a)] -> CMap trie map k2 a)
-> (CMap trie map k1 a -> [(k2, trie map k2 a)])
-> CMap trie map k1 a
-> CMap trie map k2 a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k1, trie map k1 a) -> (k2, trie map k2 a))
-> [(k1, trie map k1 a)] -> [(k2, trie map k2 a)]
forall a b. (a -> b) -> [a] -> [b]
map (k1 -> k2
f (k1 -> k2)
-> (trie map k1 a -> trie map k2 a)
-> (k1, trie map k1 a)
-> (k2, trie map k2 a)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** trie map k1 a -> trie map k2 a
go) ([(k1, trie map k1 a)] -> [(k2, trie map k2 a)])
-> (CMap trie map k1 a -> [(k1, trie map k1 a)])
-> CMap trie map k1 a
-> [(k2, trie map k2 a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k1 a -> [(k1, trie map k1 a)]
forall a. map k1 a -> [(k1, a)]
forall (m :: * -> * -> *) k a. Map m k => m k a -> [(k, a)]
Map.toListKV (CMap trie map k1 a -> CMap trie map k2 a)
-> CMap trie map k1 a -> CMap trie map k2 a
forall a b. (a -> b) -> a -> b
$ CMap trie map k1 a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldrWithKey [k] -> a -> b -> b
f b
x = (([k], a) -> b -> b) -> b -> [([k], a)] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldrAscWithKey [k] -> a -> b -> b
f b
x = (([k], a) -> b -> b) -> b -> [([k], a)] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldrDescWithKey [k] -> a -> b -> b
f b
x = (([k], a) -> b -> b) -> b -> [([k], a)] -> b
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
toDescList

-- O(n m)
foldlWithKey :: (Boolable (st a), Trie trie st map k)
             => ([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlWithKey :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlWithKey [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlAscWithKey [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlDescWithKey [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
toDescList

-- O(n m)
foldlWithKey' :: (Boolable (st a), Trie trie st map k)
            => ([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlWithKey' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlWithKey' [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlAscWithKey' [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k b.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
([k] -> a -> b -> b) -> b -> trie map k a -> b
foldlDescWithKey' [k] -> a -> b -> b
f b
x = (b -> ([k], a) -> b) -> b -> [([k], a)] -> b
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> b -> b) -> b -> ([k], a) -> b)
-> (([k], a) -> b -> b) -> b -> ([k], a) -> b
forall a b. (a -> b) -> a -> b
$ ([k] -> a -> b -> b) -> ([k], a) -> b -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [k] -> a -> b -> b
f) b
x ([([k], a)] -> b)
-> (trie map k a -> [([k], a)]) -> trie map k a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
toDescList

-- * Conversion between lists

-- O(n m)
toList :: (Boolable (st a), Trie trie st map k) => trie map k a -> [([k],a)]
toList :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> [([k], a)]
toList = (CMap trie map k a -> [(k, trie map k a)])
-> (([k], a) -> DList ([k], a) -> DList ([k], a))
-> trie map k a
-> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 CMap trie map k a -> [(k, trie map k a)]
forall a. map k a -> [(k, a)]
forall (m :: * -> * -> *) k a. Map m k => m k a -> [(k, a)]
Map.toListKV ([k], a) -> DList ([k], a) -> DList ([k], a)
forall a. a -> DList a -> DList a
DL.cons

-- O(n m)
toAscList :: (Boolable (st a), Trie trie st map k, OrdMap map k)
          => trie map k a -> [([k],a)]
toAscList :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
toAscList = (CMap trie map k a -> [(k, trie map k a)])
-> (([k], a) -> DList ([k], a) -> DList ([k], a))
-> trie map k a
-> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 CMap trie map k a -> [(k, trie map k a)]
forall a. map k a -> [(k, a)]
forall (m :: * -> * -> *) k a. OrdMap m k => m k a -> [(k, a)]
Map.toAscList ([k], a) -> DList ([k], a) -> DList ([k], a)
forall a. a -> DList a -> DList a
DL.cons

-- O(n m)
toDescList :: (Boolable (st a), Trie trie st map k, OrdMap map k)
           => trie map k a -> [([k],a)]
toDescList :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> [([k], a)]
toDescList = (CMap trie map k a -> [(k, trie map k a)])
-> (([k], a) -> DList ([k], a) -> DList ([k], a))
-> trie map k a
-> [([k], a)]
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 ([(k, trie map k a)] -> [(k, trie map k a)]
forall a. [a] -> [a]
reverse ([(k, trie map k a)] -> [(k, trie map k a)])
-> (CMap trie map k a -> [(k, trie map k a)])
-> CMap trie map k a
-> [(k, trie map k a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> [(k, trie map k a)]
forall a. map k a -> [(k, a)]
forall (m :: * -> * -> *) k a. OrdMap m k => m k a -> [(k, a)]
Map.toAscList) ((DList ([k], a) -> ([k], a) -> DList ([k], a))
-> ([k], a) -> DList ([k], a) -> DList ([k], a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip DList ([k], a) -> ([k], a) -> DList ([k], a)
forall a. DList a -> a -> DList a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 CMap trie map k a -> [(k, trie map k a)]
tolist ([k], a) -> DList ([k], a) -> DList ([k], a)
add = DList ([k], a) -> [([k], a)]
forall a. DList a -> [a]
DL.toList (DList ([k], a) -> [([k], a)])
-> (trie map k a -> DList ([k], a)) -> trie map k a -> [([k], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList k -> trie map k a -> DList ([k], a)
go DList k
forall a. DList a
DL.empty
 where
   go :: DList k -> trie map k a -> DList ([k], a)
go DList k
l trie map k a
tr =
      let (st a
v,[k]
p,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
          l' :: DList k
l'      = DList k
l DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
p
          xs :: DList ([k], a)
xs      =
             [DList ([k], a)] -> DList ([k], a)
forall a. [DList a] -> DList a
DL.concat ([DList ([k], a)] -> DList ([k], a))
-> (CMap trie map k a -> [DList ([k], a)])
-> CMap trie map k a
-> DList ([k], a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             ((k, trie map k a) -> DList ([k], a))
-> [(k, trie map k a)] -> [DList ([k], a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k
x,trie map k a
t) -> DList k -> trie map k a -> DList ([k], a)
go (DList k
l' DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
x) trie map k a
t) ([(k, trie map k a)] -> [DList ([k], a)])
-> (CMap trie map k a -> [(k, trie map k a)])
-> CMap trie map k a
-> [DList ([k], a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
             CMap trie map k a -> [(k, trie map k a)]
tolist (CMap trie map k a -> DList ([k], a))
-> CMap trie map k a -> DList ([k], a)
forall a b. (a -> b) -> a -> b
$ CMap trie map k a
m
       in if st a -> Bool
forall b. Boolable b => b -> Bool
hasValue st a
v
             then ([k], a) -> DList ([k], a) -> DList ([k], a)
add (DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
l', st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap st a
v) DList ([k], a)
xs
             else                              DList ([k], a)
xs

-- O(n m)
fromList :: (Alt st a, Boolable (st a), Trie trie st map k)
         => [([k],a)] -> trie map k a
fromList :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[([k], a)] -> trie map k a
fromList = (a -> a -> a) -> [([k], a)] -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(a -> a -> a) -> [([k], a)] -> trie map k a
fromListWith a -> a -> a
forall a b. a -> b -> a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(a -> a -> a) -> [([k], a)] -> trie map k a
fromListWith a -> a -> a
f = (trie map k a -> ([k], a) -> trie map k a)
-> trie map k a -> [([k], a)] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([k], a) -> trie map k a -> trie map k a)
-> trie map k a -> ([k], a) -> trie map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> trie map k a -> trie map k a)
 -> trie map k a -> ([k], a) -> trie map k a)
-> (([k] -> a -> trie map k a -> trie map k a)
    -> ([k], a) -> trie map k a -> trie map k a)
-> ([k] -> a -> trie map k a -> trie map k a)
-> trie map k a
-> ([k], a)
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([k] -> a -> trie map k a -> trie map k a)
-> ([k], a) -> trie map k a -> trie map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([k] -> a -> trie map k a -> trie map k a)
 -> trie map k a -> ([k], a) -> trie map k a)
-> ([k] -> a -> trie map k a -> trie map k a)
-> trie map k a
-> ([k], a)
-> trie map k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 a -> a -> a
f) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
(a -> a -> a) -> [([k], a)] -> trie map k a
fromListWith' a -> a -> a
f = (trie map k a -> ([k], a) -> trie map k a)
-> trie map k a -> [([k], a)] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((([k], a) -> trie map k a -> trie map k a)
-> trie map k a -> ([k], a) -> trie map k a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((([k], a) -> trie map k a -> trie map k a)
 -> trie map k a -> ([k], a) -> trie map k a)
-> (([k] -> a -> trie map k a -> trie map k a)
    -> ([k], a) -> trie map k a -> trie map k a)
-> ([k] -> a -> trie map k a -> trie map k a)
-> trie map k a
-> ([k], a)
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([k] -> a -> trie map k a -> trie map k a)
-> ([k], a) -> trie map k a -> trie map k a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (([k] -> a -> trie map k a -> trie map k a)
 -> trie map k a -> ([k], a) -> trie map k a)
-> ([k] -> a -> trie map k a -> trie map k a)
-> trie map k a
-> ([k], a)
-> trie map k a
forall a b. (a -> b) -> a -> b
$ (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' a -> a -> a
f) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
([k] -> a -> a -> a) -> [([k], a)] -> trie map k a
fromListWithKey [k] -> a -> a -> a
f = (trie map k a -> ([k], a) -> trie map k a)
-> trie map k a -> [([k], a)] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\trie map k a
tr ([k]
k,a
v) -> (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 ([k] -> a -> a -> a
f [k]
k) [k]
k a
v trie map k a
tr) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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' :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
([k] -> a -> a -> a) -> [([k], a)] -> trie map k a
fromListWithKey' [k] -> a -> a -> a
f = (trie map k a -> ([k], a) -> trie map k a)
-> trie map k a -> [([k], a)] -> trie map k a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\trie map k a
tr ([k]
k,a
v) -> (a -> a -> a) -> [k] -> a -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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' ([k] -> a -> a -> a
f [k]
k) [k]
k a
v trie map k a
tr) trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (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)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 (st a -> Bool
forall b. Boolable b => b -> Bool
hasValue(st a -> Bool) -> (trie map k a -> st a) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.trie map k a -> st a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> st a
tVal) ((Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a, b) -> a
fst ((Maybe (k, trie map k a), CMap trie map k a)
 -> Maybe (k, trie map k a))
-> (CMap trie map k a
    -> (Maybe (k, trie map k a), CMap trie map k a))
-> CMap trie map k a
-> Maybe (k, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> (Maybe (k, trie map k a), CMap trie map k a)
forall a. map k a -> (Maybe (k, a), map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> (Maybe (k, a), m k a)
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 = (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)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 (CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null(CMap trie map k a -> Bool)
-> (trie map k a -> CMap trie map k a) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.trie map k a -> CMap trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap) ((Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a, b) -> a
fst ((Maybe (k, trie map k a), CMap trie map k a)
 -> Maybe (k, trie map k a))
-> (CMap trie map k a
    -> (Maybe (k, trie map k a), CMap trie map k a))
-> CMap trie map k a
-> Maybe (k, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> (Maybe (k, trie map k a), CMap trie map k a)
forall a. map k a -> (Maybe (k, a), map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> (Maybe (k, a), m k a)
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 trie map k a -> Bool
_        CMap trie map k a -> Maybe (k, trie map k a)
_       trie map k a
tr_ | trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr_ = (Maybe ([k], a)
forall a. Maybe a
Nothing, trie map k a
tr_)
minMaxView trie map k a -> Bool
isWanted CMap trie map k a -> Maybe (k, trie map k a)
mapView trie map k a
tr_ = (([k], a) -> Maybe ([k], a))
-> (([k], a), trie map k a) -> (Maybe ([k], a), trie map k a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k], a) -> Maybe ([k], a)
forall a. a -> Maybe a
Just (trie map k a -> (([k], a), trie map k a)
go trie map k a
tr_)
 where
   go :: trie map k a -> (([k], a), trie map k a)
go trie map k a
tr =
      let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in if trie map k a -> Bool
isWanted trie map k a
tr
             then (([k]
pre, st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap st a
v), st a -> [k] -> CMap trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
safeMkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pre CMap trie map k a
m)

             else let (k
k,      trie map k a
tr')  = Maybe (k, trie map k a) -> (k, trie map k a)
forall a. HasCallStack => Maybe a -> a
fromJust (CMap trie map k a -> Maybe (k, trie map k a)
mapView CMap trie map k a
m)
                      (([k], a)
minMax, trie map k a
tr'') = trie map k a -> (([k], a), trie map k a)
go trie map k a
tr'
                   in ( ([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
k) ([k], a)
minMax
                      , st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre (CMap trie map k a -> trie map k a)
-> CMap trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr''
                                          then k -> CMap trie map k a -> CMap trie map k a
forall a. k -> map k a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> m k a
Map.delete              k
k CMap trie map k a
m
                                          else (trie map k a -> trie map k a)
-> k -> CMap trie map k a -> CMap trie map k a
forall a. (a -> a) -> k -> map k a -> map k a
forall (m :: * -> * -> *) k a.
Map m k =>
(a -> a) -> k -> m k a -> m k a
Map.adjust (trie map k a -> trie map k a -> trie map k a
forall a b. a -> b -> a
const trie map k a
tr'') k
k CMap trie map k a
m
                      )

-- O(m)
findMin :: (Boolable (st a), Trie trie st map k, OrdMap map k)
        => trie map k a -> Maybe ([k], a)
findMin :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMin = (trie map k a -> Bool)
-> (CMap trie map k a -> Maybe (k, trie map k a))
-> trie map k a
-> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 (st a -> Bool
forall b. Boolable b => b -> Bool
hasValue (st a -> Bool) -> (trie map k a -> st a) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> st a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> st a
tVal) ((Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a, b) -> a
fst ((Maybe (k, trie map k a), CMap trie map k a)
 -> Maybe (k, trie map k a))
-> (CMap trie map k a
    -> (Maybe (k, trie map k a), CMap trie map k a))
-> CMap trie map k a
-> Maybe (k, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> (Maybe (k, trie map k a), CMap trie map k a)
forall a. map k a -> (Maybe (k, a), map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> (Maybe (k, a), m k a)
Map.minViewWithKey)

-- O(m)
findMax :: (Boolable (st a), Trie trie st map k, OrdMap map k)
        => trie map k a -> Maybe ([k], a)
findMax :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMax = (trie map k a -> Bool)
-> (CMap trie map k a -> Maybe (k, trie map k a))
-> trie map k a
-> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 (CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null (CMap trie map k a -> Bool)
-> (trie map k a -> CMap trie map k a) -> trie map k a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> CMap trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap) ((Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a, b) -> a
fst ((Maybe (k, trie map k a), CMap trie map k a)
 -> Maybe (k, trie map k a))
-> (CMap trie map k a
    -> (Maybe (k, trie map k a), CMap trie map k a))
-> CMap trie map k a
-> Maybe (k, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> (Maybe (k, trie map k a), CMap trie map k a)
forall a. map k a -> (Maybe (k, a), map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> (Maybe (k, a), m k a)
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 trie map k a -> Bool
_        CMap trie map k a -> Maybe (k, trie map k a)
_       trie map k a
tr_ | trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr_ = Maybe ([k], a)
forall a. Maybe a
Nothing
findMinMax trie map k a -> Bool
isWanted CMap trie map k a -> Maybe (k, trie map k a)
mapView trie map k a
tr_ = ([k], a) -> Maybe ([k], a)
forall a. a -> Maybe a
Just (DList k -> trie map k a -> ([k], a)
go DList k
forall a. DList a
DL.empty trie map k a
tr_)
 where
   go :: DList k -> trie map k a -> ([k], a)
go DList k
xs trie map k a
tr =
      let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
          xs' :: DList k
xs'       = DList k
xs DList k -> DList k -> DList k
forall a. DList a -> DList a -> DList a
`DL.append` [k] -> DList k
forall a. [a] -> DList a
DL.fromList [k]
pre
       in if trie map k a -> Bool
isWanted trie map k a
tr
             then (DList k -> [k]
forall a. DList a -> [a]
DL.toList DList k
xs', st a -> a
forall a. st a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap st a
v)
             else let (k
k, trie map k a
tr') = Maybe (k, trie map k a) -> (k, trie map k a)
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (k, trie map k a) -> (k, trie map k a))
-> (CMap trie map k a -> Maybe (k, trie map k a))
-> CMap trie map k a
-> (k, trie map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CMap trie map k a -> Maybe (k, trie map k a)
mapView (CMap trie map k a -> (k, trie map k a))
-> CMap trie map k a -> (k, trie map k a)
forall a b. (a -> b) -> a -> b
$ CMap trie map k a
m
                   in DList k -> trie map k a -> ([k], a)
go (DList k
xs' DList k -> k -> DList k
forall a. DList a -> a -> DList a
`DL.snoc` k
k) trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> trie map k a
deleteMin = (Maybe ([k], a), trie map k a) -> trie map k a
forall a b. (a, b) -> b
snd ((Maybe ([k], a), trie map k a) -> trie map k a)
-> (trie map k a -> (Maybe ([k], a), trie map k a))
-> trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> (Maybe ([k], a), trie map k a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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

-- 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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> trie map k a
deleteMax = (Maybe ([k], a), trie map k a) -> trie map k a
forall a b. (a, b) -> b
snd ((Maybe ([k], a), trie map k a) -> trie map k a)
-> (trie map k a -> (Maybe ([k], a), trie map k a))
-> trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. trie map k a -> (Maybe ([k], a), trie map k a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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

-- 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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k]
xs trie map k a
tr = let (trie map k a
l,st a
_,trie map k a
g) = [k] -> trie map k a -> (trie map k a, st a, trie map k a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k]
xs trie map k a
tr in (trie map k a
l,trie map k a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k]
xs trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
            PrefixOrdering k
Same                     -> (trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty, st a
v, st a -> [k] -> CMap trie map k a -> trie map k a
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pre CMap trie map k a
m)
            DifferedAt [k]
_ (k
p:[k]
_) (k
x:[k]
_) ->
               case CMap trie map k a -> k -> k -> Ordering
forall a. map k a -> k -> k -> Ordering
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> k -> k -> Ordering
Map.ordCmp CMap trie map k a
m k
p k
x of
                    Ordering
LT -> (trie map k a
tr, st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty)
                    Ordering
GT -> (trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty, st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, trie map k a
tr)
                    Ordering
EQ -> (trie map k a, st a, trie map k a)
forall {a}. a
can'tHappen

            PostFix (Left  [k]
_)      -> (trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty, st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, trie map k a
tr)
            PostFix (Right (k
y:[k]
ys)) ->
               let (CMap trie map k a
ml, Maybe (trie map k a)
maybeTr, CMap trie map k a
mg) = k
-> CMap trie map k a
-> (CMap trie map k a, Maybe (trie map k a), CMap trie map k a)
forall a. k -> map k a -> (map k a, Maybe a, map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
k -> m k a -> (m k a, Maybe a, m k a)
Map.splitLookup k
y CMap trie map k a
m
                in case Maybe (trie map k a)
maybeTr of
                        -- Prefix goes in left side of split since it's shorter
                        -- than the given key and thus lesser
                        Maybe (trie map k a)
Nothing  -> (st a -> [k] -> CMap trie map k a -> trie map k a
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
v [k]
pre CMap trie map k a
ml, st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty, st a -> [k] -> CMap trie map k a -> trie map k a
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pre CMap trie map k a
mg)
                        Just trie map k a
tr' ->
                           let (trie map k a
tl, st a
v', trie map k a
tg) = [k] -> trie map k a -> (trie map k a, st a, trie map k a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(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 [k]
ys trie map k a
tr'
                               ml' :: CMap trie map k a
ml' = if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tl then CMap trie map k a
ml else k -> trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. k -> a -> map k a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a -> m k a
Map.insert k
y trie map k a
tl CMap trie map k a
ml
                               mg' :: CMap trie map k a
mg' = if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tg then CMap trie map k a
mg else k -> trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. k -> a -> map k a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a -> m k a
Map.insert k
y trie map k a
tg CMap trie map k a
mg
                            in (st a -> [k] -> CMap trie map k a -> trie map k a
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
v [k]
pre CMap trie map k a
ml', st a
v', st a -> [k] -> CMap trie map k a -> trie map k a
forall {st :: * -> *} {a} {trie :: (* -> * -> *) -> * -> * -> *}
       {map :: * -> * -> *} {k}.
(Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [k]
pre CMap trie map k a
mg')
            PrefixOrdering k
_ -> (trie map k a, st a, trie map k a)
forall {a}. a
can'tHappen
 where
   mk :: st a -> [k] -> CMap trie map k a -> trie map k a
mk st a
v [k]
pre = trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie map k a -> trie map k a)
-> (CMap trie map k a -> trie map k a)
-> CMap trie map k a
-> trie map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre
   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
findPredecessor [k]
_   trie map k a
tr | trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr = Maybe ([k], a)
forall a. Maybe a
Nothing
findPredecessor [k]
xs_ trie map k a
tr_          = [k] -> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
go [k]
xs_ trie map k a
tr_
 where
   go :: [k] -> trie map k a -> Maybe ([k], a)
go [k]
xs trie map k a
tr =
      let (w a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (w a, [k], CMap trie map k a)
forall a. trie map k a -> (w a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
               PrefixOrdering k
Same             -> Maybe ([k], a)
forall a. Maybe a
Nothing
               PostFix (Left [k]
_) -> Maybe ([k], a)
forall a. Maybe a
Nothing

               DifferedAt [k]
_ (k
p:[k]
_) (k
x:[k]
_) ->
                  case CMap trie map k a -> k -> k -> Ordering
forall a. map k a -> k -> k -> Ordering
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> k -> k -> Ordering
Map.ordCmp CMap trie map k a
m k
p k
x of
                       Ordering
LT -> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMax trie map k a
tr
                       Ordering
GT -> Maybe ([k], a)
forall a. Maybe a
Nothing
                       Ordering
EQ -> Maybe ([k], a)
forall {a}. a
can'tHappen

               -- See comment in non-Patricia version for explanation of
               -- algorithm
               PostFix (Right (k
y:[k]
ys)) ->
                  let predecessor :: Maybe (k, trie map k a)
predecessor = k -> CMap trie map k a -> Maybe (k, trie map k a)
forall a. k -> map k a -> Maybe (k, a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
k -> m k a -> Maybe (k, a)
Map.findPredecessor k
y CMap trie map k a
m
                   in (([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
y)(([k], a) -> ([k], a)) -> Maybe ([k], a) -> Maybe ([k], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
y CMap trie map k a
m Maybe (trie map k a)
-> (trie map k a -> Maybe ([k], a)) -> Maybe ([k], a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [k] -> trie map k a -> Maybe ([k], a)
go [k]
ys))
                      Maybe ([k], a) -> Maybe ([k], a) -> Maybe ([k], a)
forall (a :: * -> *) x. Alt a x => a x -> a x -> a x
<|>
                      case Maybe (k, trie map k a)
predecessor of
                           Maybe (k, trie map k a)
Nothing         ->
                              if w a -> Bool
forall b. Boolable b => b -> Bool
hasValue w a
v
                                 then ([k], a) -> Maybe ([k], a)
forall a. a -> Maybe a
Just ([k]
pre, w a -> a
forall a. w a -> a
forall (w :: * -> *) a. Unwrappable w => w a -> a
unwrap w a
v)
                                 else Maybe ([k], a)
forall a. Maybe a
Nothing
                           Just (k
best,trie map k a
btr) ->
                              ([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
best) (([k], a) -> ([k], a)) -> Maybe ([k], a) -> Maybe ([k], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMax trie map k a
btr
               PrefixOrdering k
_ -> Maybe ([k], a)
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ListTrie.Patricia.Base.findPredecessor :: internal error"

-- O(m)
findSuccessor :: forall trie map st k a .
                 (Boolable (st a), Trie trie st map k, OrdMap map k)
              => [k] -> trie map k a -> Maybe ([k], a)
findSuccessor :: forall (trie :: (* -> * -> *) -> * -> * -> *) (map :: * -> * -> *)
       (st :: * -> *) k a.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
findSuccessor [k]
_   trie map k a
tr | trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr = Maybe ([k], a)
forall a. Maybe a
Nothing
findSuccessor [k]
xs_ trie map k a
tr_          = [k] -> trie map k a -> Maybe ([k], a)
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
go [k]
xs_ trie map k a
tr_
 where
   go :: (Boolable (st a), Trie trie st map k, OrdMap map k)
      => [k] -> trie map k a -> Maybe ([k], a)
   go :: (Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
go [k]
xs trie map k a
tr =
      let (st a
_,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
       in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
               PrefixOrdering k
Same -> do (k
k,trie map k a
t) <- (Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a, b) -> a
fst ((Maybe (k, trie map k a), CMap trie map k a)
 -> Maybe (k, trie map k a))
-> (Maybe (k, trie map k a), CMap trie map k a)
-> Maybe (k, trie map k a)
forall a b. (a -> b) -> a -> b
$ CMap trie map k a -> (Maybe (k, trie map k a), CMap trie map k a)
forall a. map k a -> (Maybe (k, a), map k a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> (Maybe (k, a), m k a)
Map.minViewWithKey CMap trie map k a
m
                          ([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
k) (([k], a) -> ([k], a)) -> Maybe ([k], a) -> Maybe ([k], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMin trie map k a
t

               DifferedAt [k]
_ (k
p:[k]
_) (k
x:[k]
_) ->
                  case CMap trie map k a -> k -> k -> Ordering
forall a. map k a -> k -> k -> Ordering
forall (m :: * -> * -> *) k a.
OrdMap m k =>
m k a -> k -> k -> Ordering
Map.ordCmp CMap trie map k a
m k
p k
x of
                       Ordering
LT -> Maybe ([k], a)
forall a. Maybe a
Nothing
                       Ordering
GT -> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMin trie map k a
tr
                       Ordering
EQ -> Maybe ([k], a)
forall {a}. a
can'tHappen

               PostFix (Left [k]
_)       -> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMin trie map k a
tr
               PostFix (Right (k
y:[k]
ys)) ->
                  let successor :: Maybe (k, trie map k a)
successor = k -> CMap trie map k a -> Maybe (k, trie map k a)
forall a. k -> map k a -> Maybe (k, a)
forall (m :: * -> * -> *) k a.
OrdMap m k =>
k -> m k a -> Maybe (k, a)
Map.findSuccessor k
y CMap trie map k a
m
                   in (([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
y)(([k], a) -> ([k], a)) -> Maybe ([k], a) -> Maybe ([k], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>(k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
y CMap trie map k a
m Maybe (trie map k a)
-> (trie map k a -> Maybe ([k], a)) -> Maybe ([k], a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [k] -> trie map k a -> Maybe ([k], a)
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
[k] -> trie map k a -> Maybe ([k], a)
go [k]
ys))
                      Maybe ([k], a) -> Maybe ([k], a) -> Maybe ([k], a)
forall (a :: * -> *) x. Alt a x => a x -> a x -> a x
<|>
                      (Maybe (k, trie map k a)
successor Maybe (k, trie map k a)
-> ((k, trie map k a) -> Maybe ([k], a)) -> Maybe ([k], a)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(k
best,trie map k a
btr) ->
                         ([k] -> [k]) -> ([k], a) -> ([k], a)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
best) (([k], a) -> ([k], a)) -> Maybe ([k], a) -> Maybe ([k], a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> trie map k a -> Maybe ([k], a)
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k, OrdMap map k) =>
trie map k a -> Maybe ([k], a)
findMin trie map k a
btr)

               PrefixOrdering k
_ -> Maybe ([k], a)
forall {a}. a
can'tHappen

   can'tHappen :: a
can'tHappen =
      [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Data.ListTrie.Patricia.Base.findSuccessor :: internal error"

-- * Trie-only operations

-- O(s)
lookupPrefix :: (Alt st a, Boolable (st a), Trie trie st map k)
             => [k] -> trie map k a -> trie map k a
lookupPrefix :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
lookupPrefix [k]
xs trie map k a
tr =
   let (st a
_,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
            DifferedAt [k]
_ [k]
_ [k]
_       -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
            PrefixOrdering k
Same                   -> trie map k a
tr
            PostFix (Left [k]
_)       -> trie map k a
tr
            PostFix (Right (k
y:[k]
ys)) ->
               case k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
y CMap trie map k a
m of
                    Maybe (trie map k a)
Nothing  -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
                    Just trie map k a
tr' -> let tr'' :: trie map k a
tr''         = [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
lookupPrefix [k]
ys trie map k a
tr'
                                    (st a
v',[k]
pre',CMap trie map k a
m') = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr''
                                 in if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr''
                                       then trie map k a
tr''
                                       else st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' ([k]
pre [k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++ k
y k -> [k] -> [k]
forall a. a -> [a] -> [a]
: [k]
pre') CMap trie map k a
m'
            PrefixOrdering k
_ ->
               [Char] -> trie map k a
forall a. HasCallStack => [Char] -> a
error
                  [Char]
"Data.ListTrie.Patricia.Base.lookupPrefix :: internal error"

-- O(s)
addPrefix :: (Alt st a, Trie trie st map k)
          => [k] -> trie map k a -> trie map k a
addPrefix :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
addPrefix [k]
xs trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v ([k]
xs [k] -> [k] -> [k]
forall a. [a] -> [a] -> [a]
++ [k]
pre) CMap trie map k a
m

-- O(s)
deletePrefix :: (Alt st a, Boolable (st a), Trie trie st map k)
             => [k] -> trie map k a -> trie map k a
deletePrefix :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
deletePrefix [k]
xs trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
            PrefixOrdering k
Same                   -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [] CMap trie map k a
m)
            PostFix (Left [k]
ys)      -> st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
ys CMap trie map k a
m
            DifferedAt [k]
_ [k]
_ [k]
_       -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
            PostFix (Right (k
y:[k]
ys)) ->
               case k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
y CMap trie map k a
m of
                    Maybe (trie map k a)
Nothing  -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
                    Just trie map k a
tr' -> [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
deletePrefix [k]
ys trie map k a
tr'

            PrefixOrdering k
_ ->
               [Char] -> trie map k a
forall a. HasCallStack => [Char] -> a
error
                  [Char]
"Data.ListTrie.Patricia.Base.deletePrefix :: internal error"

-- O(s)
deleteSuffixes :: (Alt st a, Boolable (st a), Trie trie st map k)
               => [k] -> trie map k a -> trie map k a
deleteSuffixes :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
deleteSuffixes [k]
xs trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case (k -> k -> Bool) -> [k] -> [k] -> PrefixOrdering k
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (CMap trie map k a -> k -> k -> Bool
forall a. map k a -> k -> k -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> k -> k -> Bool
Map.eqCmp CMap trie map k a
m) [k]
pre [k]
xs of
            DifferedAt [k]
_ [k]
_ [k]
_       -> trie map k a
tr
            PrefixOrdering k
Same                   -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
            PostFix (Left [k]
_)       -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
            PostFix (Right (k
y:[k]
ys)) ->
               case k -> CMap trie map k a -> Maybe (trie map k a)
forall a. k -> map k a -> Maybe a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> Maybe a
Map.lookup k
y CMap trie map k a
m of
                    Maybe (trie map k a)
Nothing  -> trie map k a
tr
                    Just trie map k a
tr' ->
                       let tr'' :: trie map k a
tr'' = [k] -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
[k] -> trie map k a -> trie map k a
deleteSuffixes [k]
ys trie map k a
tr'
                        in if trie map k a -> Bool
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> Bool
null trie map k a
tr''
                              then trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress(trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre (k -> CMap trie map k a -> CMap trie map k a
forall a. k -> map k a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> m k a -> m k a
Map.delete k
y CMap trie map k a
m)
                              else st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre (k -> trie map k a -> CMap trie map k a -> CMap trie map k a
forall a. k -> a -> map k a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a -> m k a
Map.insert k
y trie map k a
tr'' CMap trie map k a
m)

            PrefixOrdering k
_ ->
               [Char] -> trie map k a
forall a. HasCallStack => [Char] -> a
error
                  [Char]
"Data.ListTrie.Patricia.Base.deleteSuffixes :: 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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
trie map k a -> ([k], st a, trie map k a)
splitPrefix trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in ([k]
pre, st a
v, trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
forall (a :: * -> *) x. Alt a x => a x
altEmpty [] CMap trie map k a
m)

-- O(1)
children :: Trie trie st map k => trie map k a -> CMap trie map k a
children :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
children = trie map k a -> CMap trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
tMap

-- O(1)
children1 :: Trie trie st map k => trie map k a -> CMap trie map k a
children1 :: forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> CMap trie map k a
children1 trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case [k]
pre of
            []   -> CMap trie map k a
m
            k
p:[k]
ps -> k -> trie map k a -> CMap trie map k a
forall a. k -> a -> map k a
forall (m :: * -> * -> *) k a. Map m k => k -> a -> m k a
Map.singleton k
p (st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
ps CMap trie map k a
m)

-- * Visualization

-- O(n m)
showTrieWith :: (Show k, Trie trie st map k)
             => (st a -> ShowS) -> trie map k a -> ShowS
showTrieWith :: forall k (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) a.
(Show k, Trie trie st map k) =>
(st a -> ShowS) -> trie map k a -> ShowS
showTrieWith = Int -> (st a -> ShowS) -> trie map k a -> ShowS
forall {trie :: (* -> * -> *) -> * -> * -> *} {st :: * -> *}
       {m :: * -> * -> *} {a} {a}.
(Trie trie st m a, Show a) =>
Int -> (st a -> ShowS) -> trie m a a -> ShowS
go Int
0
 where
   go :: Int -> (st a -> ShowS) -> trie m a a -> ShowS
go Int
indent st a -> ShowS
f trie m a a
tr =
      let (st a
v,[a]
pre,CMap trie m a a
m) = trie m a a -> (st a, [a], CMap trie m a a)
forall a. trie m a a -> (st a, [a], CMap trie m a a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie m a a
tr
          spre :: ShowS
spre      = [a] -> ShowS
forall a. Show a => a -> ShowS
shows [a]
pre
          lpre :: Int
lpre      = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ShowS
spre [])
          sv :: ShowS
sv        = st a -> ShowS
f st a
v
          lv :: Int
lv        = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ShowS
sv [])
       in ShowS
spre ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sv ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id ([ShowS] -> ShowS)
-> ([Bool -> ShowS] -> [ShowS]) -> [Bool -> ShowS] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> (Bool -> ShowS) -> ShowS)
-> [Bool] -> [Bool -> ShowS] -> [ShowS]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (((Bool -> ShowS) -> Bool -> ShowS)
-> Bool -> (Bool -> ShowS) -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Bool -> ShowS) -> Bool -> ShowS
forall a b. (a -> b) -> a -> b
($)) (Bool
False Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True) ([Bool -> ShowS] -> ShowS) -> [Bool -> ShowS] -> ShowS
forall a b. (a -> b) -> a -> b
$
              ((a, trie m a a) -> Bool -> ShowS)
-> [(a, trie m a a)] -> [Bool -> ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,trie m a a
t) -> \Bool
b -> let sk :: ShowS
sk = a -> ShowS
forall a. Show a => a -> ShowS
shows a
k
                                       lk :: Int
lk = [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ShowS
sk [])
                                       i :: Int
i  = Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lpre Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lv Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
                                    in (if Bool
b
                                           then Char -> ShowS
showChar Char
'\n'
                                              ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString (Int -> Char -> [Char]
forall a. Int -> a -> [a]
replicate Int
i Char
' ')
                                           else ShowS
forall a. a -> a
id)
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ShowS
showString [Char]
"-> "
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
sk ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                                     ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> (st a -> ShowS) -> trie m a a -> ShowS
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lk Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) st a -> ShowS
f trie m a a
t)
                  (CMap trie m a a -> [(a, trie m a a)]
forall a. m a a -> [(a, a)]
forall (m :: * -> * -> *) k a. Map m k => m k a -> [(k, a)]
Map.toListKV CMap trie m a a
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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Boolable (st a), Trie trie st map k) =>
st a -> [k] -> CMap trie map k a -> trie map k a
safeMkTrie st a
v [k]
p CMap trie map k a
m =
   if st a -> Bool
forall b. Boolable b => b -> Bool
noValue st a
v Bool -> Bool -> Bool
&& CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie map k a
m
      then trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Alt st a, Trie trie st map k) =>
trie map k a
empty
      else st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
p CMap trie map k a
m

prepend :: [a] -> a -> [a] -> [a]
prepend :: forall a. [a] -> a -> [a] -> [a]
prepend [a]
prefix a
key = ([a]
prefix[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
keya -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

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 :: forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes = [a] -> (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall {a}.
[a] -> (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
go []
 where
   go :: [a] -> (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
go [a]
_ a -> a -> Bool
_ [] [] = PrefixOrdering a
forall a. PrefixOrdering a
Same
   go [a]
_ a -> a -> Bool
_ [] [a]
xs = Either [a] [a] -> PrefixOrdering a
forall a. Either [a] [a] -> PrefixOrdering a
PostFix ([a] -> Either [a] [a]
forall a b. b -> Either a b
Right [a]
xs)
   go [a]
_ a -> a -> Bool
_ [a]
xs [] = Either [a] [a] -> PrefixOrdering a
forall a. Either [a] [a] -> PrefixOrdering a
PostFix ([a] -> Either [a] [a]
forall a b. a -> Either a b
Left  [a]
xs)

   go [a]
samePart a -> a -> Bool
(===) xs :: [a]
xs@(a
a:[a]
as) ys :: [a]
ys@(a
b:[a]
bs) =
      if a
a a -> a -> Bool
=== a
b
         then [a] -> (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
go (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
samePart) a -> a -> Bool
(===) [a]
as [a]
bs
         else [a] -> [a] -> [a] -> PrefixOrdering a
forall a. [a] -> [a] -> [a] -> PrefixOrdering a
DifferedAt ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
samePart) [a]
xs [a]
ys

-- Exported for Eq/Ord instances
eqComparePrefixes :: (a -> a -> Bool) -> [a] -> [a] -> Bool
eqComparePrefixes :: forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
eqComparePrefixes a -> a -> Bool
eq [a]
xs [a]
ys = case (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes a -> a -> Bool
eq [a]
xs [a]
ys of
                                  PrefixOrdering a
Same -> Bool
True
                                  PrefixOrdering a
_    -> Bool
False

ordComparePrefixes :: (a -> a -> Ordering) -> [a] -> [a] -> Ordering
ordComparePrefixes :: forall a. (a -> a -> Ordering) -> [a] -> [a] -> Ordering
ordComparePrefixes a -> a -> Ordering
ord [a]
xs [a]
ys =
   case (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
forall a. (a -> a -> Bool) -> [a] -> [a] -> PrefixOrdering a
comparePrefixes (\a
x a
y -> a -> a -> Ordering
ord a
x a
y Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ) [a]
xs [a]
ys of
        PrefixOrdering a
Same                     -> Ordering
EQ
        PostFix Either [a] [a]
r                -> ([a] -> Ordering)
-> ([a] -> Ordering) -> Either [a] [a] -> Ordering
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Ordering -> [a] -> Ordering
forall a b. a -> b -> a
const Ordering
GT) (Ordering -> [a] -> Ordering
forall a b. a -> b -> a
const Ordering
LT) Either [a] [a]
r
        DifferedAt [a]
_ (a
x:[a]
_) (a
y:[a]
_) -> a -> a -> Ordering
ord a
x a
y
        PrefixOrdering a
_                        -> [Char] -> Ordering
forall a. HasCallStack => [Char] -> a
error
           [Char]
"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 :: forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress trie map k a
tr =
   let (st a
v,[k]
pre,CMap trie map k a
m) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr
    in case CMap trie map k a -> Maybe (k, trie map k a)
forall a. map k a -> Maybe (k, a)
forall (m :: * -> * -> *) k a. Map m k => m k a -> Maybe (k, a)
Map.singletonView CMap trie map k a
m of

          -- We can compress the trie if there is only one child
          Just (k
x, trie map k a
tr')
             -- If the parent is empty, we can collapse it into the child
             | st a -> Bool
forall b. Boolable b => b -> Bool
noValue st a
v -> trie map k a -> trie map k a
forall (st :: * -> *) a (trie :: (* -> * -> *) -> * -> * -> *)
       (map :: * -> * -> *) k.
(Boolable (st a), Trie trie st map k) =>
trie map k a -> trie map k a
tryCompress (trie map k a -> trie map k a) -> trie map k a -> trie map k a
forall a b. (a -> b) -> a -> b
$ st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v' ([k] -> k -> [k] -> [k]
forall a. [a] -> a -> [a] -> [a]
prepend [k]
pre k
x [k]
pre') CMap trie map k a
subM

             -- If the parent is full and the child is empty and childless, the
             -- child is irrelevant
             | st a -> Bool
forall b. Boolable b => b -> Bool
noValue st a
v' Bool -> Bool -> Bool
&& CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie map k a
subM -> st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [k]
pre CMap trie map k a
subM
           where
             (st a
v',[k]
pre',CMap trie map k a
subM) = trie map k a -> (st a, [k], CMap trie map k a)
forall a. trie map k a -> (st a, [k], CMap trie map k a)
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
trie map k a -> (st a, [k], CMap trie map k a)
tParts trie map k a
tr'

          -- If the trie is empty, make sure the prefix is as well.
          --
          -- This case can arise in 'intersectionWith', at least.
          Maybe (k, trie map k a)
Nothing | st a -> Bool
forall b. Boolable b => b -> Bool
noValue st a
v Bool -> Bool -> Bool
&& CMap trie map k a -> Bool
forall a. map k a -> Bool
forall (m :: * -> * -> *) k a. Map m k => m k a -> Bool
Map.null CMap trie map k a
m -> st a -> [k] -> CMap trie map k a -> trie map k a
forall a. st a -> [k] -> CMap trie map k a -> trie map k a
forall (trie :: (* -> * -> *) -> * -> * -> *) (st :: * -> *)
       (map :: * -> * -> *) k a.
Trie trie st map k =>
st a -> [k] -> CMap trie map k a -> trie map k a
mkTrie st a
v [] CMap trie map k a
m

          -- Otherwise, leave it unchanged.
          Maybe (k, trie map k a)
_ -> trie map k a
tr