{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Data.Trie.Map.Hidden(
  -- * Types
  TMap(..),
  -- * Queries
  match,
  lookup,
  member, notMember,
  null, count,
  keys, elems,
  -- * Construction
  empty, just,
  singleton,

  -- * Single item modification
  insertWith, insert,
  deleteWith, delete,

  adjust, revise, update, alter,

  -- * Combine
  union, unionWith,
  intersection, intersectionWith,
  difference, differenceWith,
  appendWith,

  -- * Conversion
  toList, fromList, fromListWith,
  toAscList, fromAscList, fromAscListWith,
  toMap, fromMap,
  keysTSet, fromTSet,

  -- * Parsing
  toParser, toParser_, toParser__,

  -- * Traversing with keys
  traverseWithKey, mapWithKey, foldMapWithKey, foldrWithKey,

  -- * Internals
  Node(..),
  foldTMap,
)
where

import           Prelude                hiding (lookup, null)

import           Data.Semigroup

import           Control.Applicative    hiding (empty)
import qualified Control.Applicative    as Ap (empty)
import           Control.Monad

import qualified Data.Foldable          as F
import qualified Data.List              as List (foldl')
import qualified Data.List.NonEmpty     as NE
import           Data.Map.Strict        (Map)
import qualified Data.Map.Strict        as Map
import           Data.Maybe             (fromMaybe, isJust, isNothing)

import           Data.Trie.Set.Internal (TSet (..))
import qualified Data.Trie.Set.Internal as TSet

import           Control.DeepSeq
import           Data.Functor.Classes
import qualified GHC.Exts
import           Text.Show (showListWith)

import Data.Functor.WithIndex
import Data.Foldable.WithIndex
import Data.Traversable.WithIndex

import Data.Hashable.Lifted
import Data.Hashable
import Witherable
import Data.These (These(..))
import Data.Zip (Zip(..))
import Data.Align ( Align(..), Semialign(..) )
import Data.Matchable

data Node c a r = Node !(Maybe a) !(Map c r)
  deriving (Int -> Node c a r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c a r.
(Show a, Show c, Show r) =>
Int -> Node c a r -> ShowS
forall c a r. (Show a, Show c, Show r) => [Node c a r] -> ShowS
forall c a r. (Show a, Show c, Show r) => Node c a r -> String
showList :: [Node c a r] -> ShowS
$cshowList :: forall c a r. (Show a, Show c, Show r) => [Node c a r] -> ShowS
show :: Node c a r -> String
$cshow :: forall c a r. (Show a, Show c, Show r) => Node c a r -> String
showsPrec :: Int -> Node c a r -> ShowS
$cshowsPrec :: forall c a r.
(Show a, Show c, Show r) =>
Int -> Node c a r -> ShowS
Show, Node c a r -> Node c a r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a r.
(Eq a, Eq c, Eq r) =>
Node c a r -> Node c a r -> Bool
/= :: Node c a r -> Node c a r -> Bool
$c/= :: forall c a r.
(Eq a, Eq c, Eq r) =>
Node c a r -> Node c a r -> Bool
== :: Node c a r -> Node c a r -> Bool
$c== :: forall c a r.
(Eq a, Eq c, Eq r) =>
Node c a r -> Node c a r -> Bool
Eq, Node c a r -> Node c a r -> Bool
Node c a r -> Node c a r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {c} {a} {r}. (Ord a, Ord c, Ord r) => Eq (Node c a r)
forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Bool
forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Ordering
forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Node c a r
min :: Node c a r -> Node c a r -> Node c a r
$cmin :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Node c a r
max :: Node c a r -> Node c a r -> Node c a r
$cmax :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Node c a r
>= :: Node c a r -> Node c a r -> Bool
$c>= :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Bool
> :: Node c a r -> Node c a r -> Bool
$c> :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Bool
<= :: Node c a r -> Node c a r -> Bool
$c<= :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Bool
< :: Node c a r -> Node c a r -> Bool
$c< :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Bool
compare :: Node c a r -> Node c a r -> Ordering
$ccompare :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Ordering
Ord, forall a b. a -> Node c a b -> Node c a a
forall a b. (a -> b) -> Node c a a -> Node c a b
forall c a a b. a -> Node c a b -> Node c a a
forall c a a b. (a -> b) -> Node c a a -> Node c a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Node c a b -> Node c a a
$c<$ :: forall c a a b. a -> Node c a b -> Node c a a
fmap :: forall a b. (a -> b) -> Node c a a -> Node c a b
$cfmap :: forall c a a b. (a -> b) -> Node c a a -> Node c a b
Functor, forall a. Node c a a -> Bool
forall m a. Monoid m => (a -> m) -> Node c a a -> m
forall a b. (a -> b -> b) -> b -> Node c a a -> b
forall c a a. Eq a => a -> Node c a a -> Bool
forall c a a. Num a => Node c a a -> a
forall c a a. Ord a => Node c a a -> a
forall c a m. Monoid m => Node c a m -> m
forall c a a. Node c a a -> Bool
forall c a a. Node c a a -> Int
forall c a a. Node c a a -> [a]
forall c a a. (a -> a -> a) -> Node c a a -> a
forall c a m a. Monoid m => (a -> m) -> Node c a a -> m
forall c a b a. (b -> a -> b) -> b -> Node c a a -> b
forall c a a b. (a -> b -> b) -> b -> Node c a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Node c a a -> a
$cproduct :: forall c a a. Num a => Node c a a -> a
sum :: forall a. Num a => Node c a a -> a
$csum :: forall c a a. Num a => Node c a a -> a
minimum :: forall a. Ord a => Node c a a -> a
$cminimum :: forall c a a. Ord a => Node c a a -> a
maximum :: forall a. Ord a => Node c a a -> a
$cmaximum :: forall c a a. Ord a => Node c a a -> a
elem :: forall a. Eq a => a -> Node c a a -> Bool
$celem :: forall c a a. Eq a => a -> Node c a a -> Bool
length :: forall a. Node c a a -> Int
$clength :: forall c a a. Node c a a -> Int
null :: forall a. Node c a a -> Bool
$cnull :: forall c a a. Node c a a -> Bool
toList :: forall a. Node c a a -> [a]
$ctoList :: forall c a a. Node c a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Node c a a -> a
$cfoldl1 :: forall c a a. (a -> a -> a) -> Node c a a -> a
foldr1 :: forall a. (a -> a -> a) -> Node c a a -> a
$cfoldr1 :: forall c a a. (a -> a -> a) -> Node c a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Node c a a -> b
$cfoldl' :: forall c a b a. (b -> a -> b) -> b -> Node c a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Node c a a -> b
$cfoldl :: forall c a b a. (b -> a -> b) -> b -> Node c a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Node c a a -> b
$cfoldr' :: forall c a a b. (a -> b -> b) -> b -> Node c a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Node c a a -> b
$cfoldr :: forall c a a b. (a -> b -> b) -> b -> Node c a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Node c a a -> m
$cfoldMap' :: forall c a m a. Monoid m => (a -> m) -> Node c a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Node c a a -> m
$cfoldMap :: forall c a m a. Monoid m => (a -> m) -> Node c a a -> m
fold :: forall m. Monoid m => Node c a m -> m
$cfold :: forall c a m. Monoid m => Node c a m -> m
Foldable, forall c a. Functor (Node c a)
forall c a. Foldable (Node c a)
forall c a (m :: * -> *) a.
Monad m =>
Node c a (m a) -> m (Node c a a)
forall c a (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
forall c a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
forall c a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a a -> f (Node c a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a a -> f (Node c a b)
sequence :: forall (m :: * -> *) a. Monad m => Node c a (m a) -> m (Node c a a)
$csequence :: forall c a (m :: * -> *) a.
Monad m =>
Node c a (m a) -> m (Node c a a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
$cmapM :: forall c a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
$csequenceA :: forall c a (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a a -> f (Node c a b)
$ctraverse :: forall c a (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a a -> f (Node c a b)
Traversable)

instance (Eq c, Eq a) => Eq1 (Node c a) where
  liftEq :: forall a b. (a -> b -> Bool) -> Node c a a -> Node c a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)

instance (Ord c, Ord a) => Ord1 (Node c a) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Node c a a -> Node c a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare

instance Eq c => Eq2 (Node c) where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Node c a c -> Node c b d -> Bool
liftEq2 a -> b -> Bool
eqA c -> d -> Bool
eqR (Node Maybe a
a1 Map c c
e1) (Node Maybe b
a2 Map c d
e2) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eqA Maybe a
a1 Maybe b
a2 Bool -> Bool -> Bool
&& forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
eqR Map c c
e1 Map c d
e2

instance Ord c => Ord2 (Node c) where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Node c a c -> Node c b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpA c -> d -> Ordering
cmpR (Node Maybe a
a1 Map c c
e1) (Node Maybe b
a2 Map c d
e2) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmpA Maybe a
a1 Maybe b
a2 forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
cmpR Map c c
e1 Map c d
e2

instance (NFData c, NFData a, NFData r) => NFData (Node c a r) where
  rnf :: Node c a r -> ()
rnf (Node Maybe a
a Map c r
e) = forall a. NFData a => a -> ()
rnf Maybe a
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Map c r
e

-- | Mapping from @[c]@ to @a@ implemented as a trie.
--   This type serves the almost same purpose of @Map [c] a@,
--   but can be looked up more efficiently.
newtype TMap c a = TMap { forall c a. TMap c a -> Node c a (TMap c a)
getNode :: Node c a (TMap c a) }
  deriving (TMap c a -> TMap c a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a. (Eq a, Eq c) => TMap c a -> TMap c a -> Bool
/= :: TMap c a -> TMap c a -> Bool
$c/= :: forall c a. (Eq a, Eq c) => TMap c a -> TMap c a -> Bool
== :: TMap c a -> TMap c a -> Bool
$c== :: forall c a. (Eq a, Eq c) => TMap c a -> TMap c a -> Bool
Eq, TMap c a -> TMap c a -> Bool
TMap c a -> TMap c a -> Ordering
TMap c a -> TMap c a -> TMap c a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {c} {a}. (Ord a, Ord c) => Eq (TMap c a)
forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Bool
forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Ordering
forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> TMap c a
min :: TMap c a -> TMap c a -> TMap c a
$cmin :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> TMap c a
max :: TMap c a -> TMap c a -> TMap c a
$cmax :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> TMap c a
>= :: TMap c a -> TMap c a -> Bool
$c>= :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Bool
> :: TMap c a -> TMap c a -> Bool
$c> :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Bool
<= :: TMap c a -> TMap c a -> Bool
$c<= :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Bool
< :: TMap c a -> TMap c a -> Bool
$c< :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Bool
compare :: TMap c a -> TMap c a -> Ordering
$ccompare :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Ordering
Ord)

instance Show2 TMap where
  liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> TMap a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
showListC Int -> b -> ShowS
showspA [b] -> ShowS
_ Int
p TMap a b
t = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (forall a b. (a -> ShowS) -> (b -> ShowS) -> (a, b) -> ShowS
showPairWith [a] -> ShowS
showListC (Int -> b -> ShowS
showspA Int
0)) (forall c a. TMap c a -> [([c], a)]
toList TMap a b
t)

showPairWith :: (a -> ShowS) -> (b -> ShowS) -> (a,b) -> ShowS
showPairWith :: forall a b. (a -> ShowS) -> (b -> ShowS) -> (a, b) -> ShowS
showPairWith a -> ShowS
showsA b -> ShowS
showsB = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 (forall a b. a -> b -> a
const a -> ShowS
showsA) (forall a. (a -> ShowS) -> [a] -> ShowS
showListWith a -> ShowS
showsA) (forall a b. a -> b -> a
const b -> ShowS
showsB) (forall a. (a -> ShowS) -> [a] -> ShowS
showListWith b -> ShowS
showsB) Int
0

instance Show c => Show1 (TMap c) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TMap c a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

instance (Show c, Show a) => Show (TMap c a) where
  showsPrec :: Int -> TMap c a -> ShowS
showsPrec = forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2

instance (NFData c, NFData a) => NFData (TMap c a) where
  rnf :: TMap c a -> ()
rnf (TMap Node c a (TMap c a)
node) = forall a. NFData a => a -> ()
rnf Node c a (TMap c a)
node

instance (Eq c) => Eq1 (TMap c) where
  liftEq :: forall a b. (a -> b -> Bool) -> TMap c a -> TMap c b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)

instance Eq2 TMap where
  liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> TMap a c -> TMap b d -> Bool
liftEq2 a -> b -> Bool
eqC c -> d -> Bool
eqA = TMap a c -> TMap b d -> Bool
go
    where
      go :: TMap a c -> TMap b d -> Bool
go (TMap (Node Maybe c
ma1 Map a (TMap a c)
e1)) (TMap (Node Maybe d
ma2 Map b (TMap b d)
e2)) =
        forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
eqA Maybe c
ma1 Maybe d
ma2 Bool -> Bool -> Bool
&&
        forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eqC TMap a c -> TMap b d -> Bool
go Map a (TMap a c)
e1 Map b (TMap b d)
e2

instance (Ord c) => Ord1 (TMap c) where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> TMap c a -> TMap c b -> Ordering
liftCompare a -> b -> Ordering
cmp (TMap Node c a (TMap c a)
m1) (TMap Node c b (TMap c b)
m2) = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
cmp) Node c a (TMap c a)
m1 Node c b (TMap c b)
m2

instance Ord2 TMap where
  liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> TMap a c -> TMap b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpC c -> d -> Ordering
cmpA = TMap a c -> TMap b d -> Ordering
go
    where
      go :: TMap a c -> TMap b d -> Ordering
go (TMap (Node Maybe c
ma1 Map a (TMap a c)
e1)) (TMap (Node Maybe d
ma2 Map b (TMap b d)
e2)) =
        forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
cmpA Maybe c
ma1 Maybe d
ma2 forall a. Semigroup a => a -> a -> a
<>
        forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmpC TMap a c -> TMap b d -> Ordering
go Map a (TMap a c)
e1 Map b (TMap b d)
e2

instance (Ord c) => GHC.Exts.IsList (TMap c a) where
  type Item (TMap c a) = ([c],a)
  fromList :: [Item (TMap c a)] -> TMap c a
fromList = forall c a. Ord c => [([c], a)] -> TMap c a
fromList
  toList :: TMap c a -> [Item (TMap c a)]
toList = forall c a. TMap c a -> [([c], a)]
toList

instance Hashable2 TMap where
  liftHashWithSalt2 :: forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> TMap a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashC Int -> b -> Int
hashA = Int -> TMap a b -> Int
hashT
    where
      hashMA :: Int -> Maybe b -> Int
hashMA = forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> b -> Int
hashA
      hashEdges :: Int -> Map a (TMap a b) -> Int
hashEdges = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashC Int -> TMap a b -> Int
hashT
      hashT :: Int -> TMap a b -> Int
hashT Int
s (TMap (Node Maybe b
ma Map a (TMap a b)
e)) = Int
s Int -> Maybe b -> Int
`hashMA` Maybe b
ma Int -> Map a (TMap a b) -> Int
`hashEdges` Map a (TMap a b)
e

instance Hashable c => Hashable1 (TMap c) where
  liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> TMap c a -> Int
liftHashWithSalt = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 forall a. Hashable a => Int -> a -> Int
hashWithSalt

instance (Hashable c, Hashable a) => Hashable (TMap c a) where
  hashWithSalt :: Int -> TMap c a -> Int
hashWithSalt = forall (f :: * -> * -> *) a b.
(Hashable2 f, Hashable a, Hashable b) =>
Int -> f a b -> Int
hashWithSalt2

instance FunctorWithIndex [c] (TMap c) where
  imap :: forall a b. ([c] -> a -> b) -> TMap c a -> TMap c b
imap = forall c a b. ([c] -> a -> b) -> TMap c a -> TMap c b
mapWithKey

instance FoldableWithIndex [c] (TMap c) where
  ifoldr :: forall a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
ifoldr = forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey

instance TraversableWithIndex [c] (TMap c) where
  itraverse :: forall (f :: * -> *) a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
itraverse = forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey

instance Ord c => Filterable (TMap c) where
  mapMaybe :: forall a b. (a -> Maybe b) -> TMap c a -> TMap c b
mapMaybe a -> Maybe b
f = TMap c a -> TMap c b
go
    where
      go :: TMap c a -> TMap c b
go (TMap (Node Maybe a
ma Map c (TMap c a)
edges)) =
        forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe b
f) (forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMap c a -> TMap c b
go) Map c (TMap c a)
edges))

instance Ord c => Witherable (TMap c) where
  wither :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> TMap c a -> f (TMap c b)
wither a -> f (Maybe b)
f = TMap c a -> f (TMap c b)
go
    where
      go :: TMap c a -> f (TMap c b)
go (TMap (Node Maybe a
ma Map c (TMap c a)
edges)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c a. Node c a (TMap c a) -> TMap c a
TMap forall a b. (a -> b) -> a -> b
$
        forall c a r. Maybe a -> Map c r -> Node c a r
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither a -> f (Maybe b)
f Maybe a
ma forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMap c a -> f (TMap c b)
go) Map c (TMap c a)
edges

instance Ord c => FilterableWithIndex [c] (TMap c) where
  imapMaybe :: forall a b. ([c] -> a -> Maybe b) -> TMap c a -> TMap c b
imapMaybe [c] -> a -> Maybe b
f (TMap (Node Maybe a
ma Map c (TMap c a)
edges)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe b
mb Map c (TMap c b)
edges')
    where
      mb :: Maybe b
mb = Maybe a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [c] -> a -> Maybe b
f []
      edges' :: Map c (TMap c b)
edges' = forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (\c
c TMap c a
t -> forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap forall a b. (a -> b) -> a -> b
$ forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe ([c] -> a -> Maybe b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cforall a. a -> [a] -> [a]
:)) TMap c a
t) Map c (TMap c a)
edges

instance Ord c => WitherableWithIndex [c] (TMap c) where
  iwither :: forall (f :: * -> *) a b.
Applicative f =>
([c] -> a -> f (Maybe b)) -> TMap c a -> f (TMap c b)
iwither [c] -> a -> f (Maybe b)
f (TMap (Node Maybe a
ma Map c (TMap c a)
edges)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall c a r. Maybe a -> Map c r -> Node c a r
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe b)
mb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (Map c (TMap c b))
edges')
    where
      mb :: f (Maybe b)
mb = forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither ([c] -> a -> f (Maybe b)
f []) Maybe a
ma
      edges' :: f (Map c (TMap c b))
edges' = forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither c -> TMap c a -> f (Maybe (TMap c b))
child Map c (TMap c a)
edges
      child :: c -> TMap c a -> f (Maybe (TMap c b))
child c
c TMap c a
t = forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
iwither ([c] -> a -> f (Maybe b)
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c forall a. a -> [a] -> [a]
:)) TMap c a
t

instance Ord c => Semialign (TMap c) where
  align :: forall a b. TMap c a -> TMap c b -> TMap c (These a b)
align (TMap (Node Maybe a
ma Map c (TMap c a)
e1)) (TMap (Node Maybe b
mb Map c (TMap c b)
e2)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe (These a b)
mc Map c (TMap c (These a b))
e')
    where
      mc :: Maybe (These a b)
mc = forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Maybe a
ma Maybe b
mb
      e' :: Map c (TMap c (These a b))
e' = forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith forall {f :: * -> *} {a} {b}.
Semialign f =>
These (f a) (f b) -> f (These a b)
subtree Map c (TMap c a)
e1 Map c (TMap c b)
e2
      subtree :: These (f a) (f b) -> f (These a b)
subtree (This f a
t1) = forall a b. a -> These a b
This forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
t1
      subtree (That f b
t2) = forall a b. b -> These a b
That forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
t2
      subtree (These f a
t1 f b
t2) = forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align f a
t1 f b
t2

instance (Ord c) => Align (TMap c) where
  nil :: forall a. TMap c a
nil = forall c a. TMap c a
empty

instance (Ord c) => Zip (TMap c) where
  zipWith :: forall a b c. (a -> b -> c) -> TMap c a -> TMap c b -> TMap c c
zipWith a -> b -> c
op = forall c a b r.
Ord c =>
(a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r
intersectionWith (\a
a b
b -> forall a. a -> Maybe a
Just (a -> b -> c
op a
a b
b))

instance (Eq c) => Matchable (TMap c) where
  zipMatchWith :: forall a b c.
(a -> b -> Maybe c) -> TMap c a -> TMap c b -> Maybe (TMap c c)
zipMatchWith a -> b -> Maybe c
f = TMap c a -> TMap c b -> Maybe (TMap c c)
go
    where
      go :: TMap c a -> TMap c b -> Maybe (TMap c c)
go (TMap (Node Maybe a
ma Map c (TMap c a)
e1)) (TMap (Node Maybe b
mb Map c (TMap c b)
e2)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall c a r. Maybe a -> Map c r -> Node c a r
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe c)
mc forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Map c (TMap c c))
e')
        where
          mc :: Maybe (Maybe c)
mc = forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith a -> b -> Maybe c
f Maybe a
ma Maybe b
mb
          e' :: Maybe (Map c (TMap c c))
e' = forall (t :: * -> *) a b c.
Matchable t =>
(a -> b -> Maybe c) -> t a -> t b -> Maybe (t c)
zipMatchWith TMap c a -> TMap c b -> Maybe (TMap c c)
go Map c (TMap c a)
e1 Map c (TMap c b)
e2

-- * Queries

-- | Perform partial matching against a @TMap@.
--
--   @match xs tmap@ returns two values. The first value is the result of
--   'lookup'. The second is another @TMap@ for all keys which contain @xs@ as their prefix.
--   The keys of the returned map do not contain the common prefix @xs@.
--
--   ===== Example
--
--   >>> let x = 'fromList' [("ham", 1), ("bacon", 2), ("hamburger", 3)]
--   >>> match "ham" x
--   (Just 1,fromList [("",1),("burger",3)])
match :: (Ord c) => [c] -> TMap c a -> (Maybe a, TMap c a)
match :: forall c a. Ord c => [c] -> TMap c a -> (Maybe a, TMap c a)
match []     t :: TMap c a
t@(TMap (Node Maybe a
ma Map c (TMap c a)
_)) = (Maybe a
ma, TMap c a
t)
match (c
c:[c]
cs)   (TMap (Node Maybe a
_  Map c (TMap c a)
e)) =
  case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c Map c (TMap c a)
e of
    Maybe (TMap c a)
Nothing -> (forall a. Maybe a
Nothing, forall c a. TMap c a
empty)
    Just TMap c a
t' -> forall c a. Ord c => [c] -> TMap c a -> (Maybe a, TMap c a)
match [c]
cs TMap c a
t'

-- | @lookup xs tmap@ returns @Just a@ if @tmap@ contains mapping
--   from @xs@ to @a@, and returns @Nothing@ if not.
lookup :: (Ord c) => [c] -> TMap c a -> Maybe a
lookup :: forall c a. Ord c => [c] -> TMap c a -> Maybe a
lookup [c]
cs = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Ord c => [c] -> TMap c a -> (Maybe a, TMap c a)
match [c]
cs

member, notMember :: (Ord c) => [c] -> TMap c a -> Bool
member :: forall c a. Ord c => [c] -> TMap c a -> Bool
member [c]
cs = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Ord c => [c] -> TMap c a -> Maybe a
lookup [c]
cs
notMember :: forall c a. Ord c => [c] -> TMap c a -> Bool
notMember [c]
cs = forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. Ord c => [c] -> TMap c a -> Maybe a
lookup [c]
cs

-- | Tests if given map is empty.
null :: TMap c a -> Bool
null :: forall c a. TMap c a -> Bool
null (TMap (Node Maybe a
ma Map c (TMap c a)
e)) = forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e
{- Ensure all @TMap@ values exposed to users have no
   redundant node. -}

-- | Returns number of entries.
--
--   Note that this operation takes O(number of nodes),
--   unlike O(1) of 'Map.size'.
count :: TMap c a -> Int
count :: forall c a. TMap c a -> Int
count = forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap forall {c} {a}. Node c a Int -> Int
count'
  where
    count' :: Node c a Int -> Int
count' (Node Maybe a
ma Map c Int
e) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' forall a. Num a => a -> a -> a
(+) (forall (t :: * -> *) a. Foldable t => t a -> Int
length Maybe a
ma) Map c Int
e

-- | Returns list of key strings, in ascending order.
keys :: TMap c a -> [[c]]
keys :: forall c a. TMap c a -> [[c]]
keys = forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap forall {a} {a}. Node a a [[a]] -> [[a]]
keys'
  where
    keys' :: Node a a [[a]] -> [[a]]
keys' (Node Maybe a
ma Map a [[a]]
e) =
      [ [] | forall a. Maybe a -> Bool
isJust Maybe a
ma ] forall a. [a] -> [a] -> [a]
++
      [ a
cforall a. a -> [a] -> [a]
:[a]
cs' | (a
c,[[a]]
css') <- forall k a. Map k a -> [(k, a)]
Map.toList Map a [[a]]
e, [a]
cs' <- [[a]]
css' ]

-- | Returns list of values, in ascending order by its key.
elems :: TMap c a -> [a]
elems :: forall c a. TMap c a -> [a]
elems = forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap forall {c} {a}. Node c a [a] -> [a]
elems'
  where
    elems' :: Node c a [a] -> [a]
elems' (Node Maybe a
ma Map c [a]
e) = forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Maybe a
ma forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall a. [a] -> [a] -> [a]
(++) [] Map c [a]
e

-- * Construction

-- | Empty @TMap@.
empty :: TMap c a
empty :: forall c a. TMap c a
empty = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node forall a. Maybe a
Nothing forall k a. Map k a
Map.empty)

-- | @TMap@ which contains only one entry from the empty string to @a@.
just :: a -> TMap c a
just :: forall a c. a -> TMap c a
just a
a = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node (forall a. a -> Maybe a
Just a
a) forall k a. Map k a
Map.empty)

-- | @singleton xs a@ is a @TMap@ which contains only one entry
--   from @xs@ to @a@.
singleton :: [c] -> a -> TMap c a
singleton :: forall c a. [c] -> a -> TMap c a
singleton [c]
cs a
a0 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall c a. c -> TMap c a -> TMap c a
cons (forall a c. a -> TMap c a
just a
a0) [c]
cs

cons :: c -> TMap c a -> TMap c a
cons :: forall c a. c -> TMap c a -> TMap c a
cons c
c TMap c a
t = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node forall a. Maybe a
Nothing (forall k a. k -> a -> Map k a
Map.singleton c
c TMap c a
t))

-- * Single-item modification

-- | Inserts an entry of key and value pair.
--
--   Already existing value will be overwritten.
--
--   > insert = 'insertWith' (const a)
insert :: (Ord c) => [c] -> a -> TMap c a -> TMap c a
insert :: forall c a. Ord c => [c] -> a -> TMap c a -> TMap c a
insert [c]
cs a
a = forall c a. Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise (forall a b. a -> b -> a
const a
a) [c]
cs

-- | Deletes an entry with given key.
--
--   > delete = 'update' (const Nothing)
delete :: (Ord c) => [c] -> TMap c a -> TMap c a
delete :: forall c a. Ord c => [c] -> TMap c a -> TMap c a
delete = forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update (forall a b. a -> b -> a
const forall a. Maybe a
Nothing)

-- | @insertWith op xs a tmap@ inserts an entry of key-value pair @(cs,a)@
--   to the @tmap@. If @tmap@ already has an entry with key equals to
--   @xs@, its value @b@ is replaced with @op a b@.
--
--   > insertWith op cs a = 'revise' (maybe a (op a)) cs
insertWith :: (Ord c) => (a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a
insertWith :: forall c a.
Ord c =>
(a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a
insertWith a -> a -> a
f [c]
cs a
a = forall c a. Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise (forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
a (a -> a -> a
f a
a)) [c]
cs

-- | Deletes an entry with given key, conditionally.
--
--   @deleteWith f xs b@ looks up an entry with key @xs@, and if such entry
--   is found, evaluate @f b a@ with its value @a@. If it returned @Nothing@,
--   the entry is deleted. Otherwise, if it returned @Just a'@, the value of
--   the entry is replaced with @a'@.
--
--   > deleteWith f cs b = 'update' (f b) cs
deleteWith :: (Ord c) => (b -> a -> Maybe a) -> [c] -> b -> TMap c a -> TMap c a
deleteWith :: forall c b a.
Ord c =>
(b -> a -> Maybe a) -> [c] -> b -> TMap c a -> TMap c a
deleteWith b -> a -> Maybe a
f [c]
cs b
b = forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update (b -> a -> Maybe a
f b
b) [c]
cs

-- | Apply a function to the entry with given key.
adjust :: (Ord c) => (a -> a) -> [c] -> TMap c a -> TMap c a
adjust :: forall c a. Ord c => (a -> a) -> [c] -> TMap c a -> TMap c a
adjust a -> a
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c} {a}.
Ord c =>
c -> (TMap c a -> TMap c a) -> TMap c a -> TMap c a
step TMap c a -> TMap c a
base
  where
    base :: TMap c a -> TMap c a
base (TMap (Node Maybe a
ma Map c (TMap c a)
e)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node (a -> a
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma) Map c (TMap c a)
e)
    step :: c -> (TMap c a -> TMap c a) -> TMap c a -> TMap c a
step c
x TMap c a -> TMap c a
xs (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
      let e' :: Map c (TMap c a)
e' = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust TMap c a -> TMap c a
xs c
x Map c (TMap c a)
e
      in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e')
{-# INLINE adjust #-}

-- | Apply a function @f@ to the entry with the given key. If there is no such
--   entry, insert an entry with value @f Nothing@.
revise :: (Ord c) => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise :: forall c a. Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise Maybe a -> a
f = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c} {a}.
Ord c =>
c
-> (TMap c a -> TMap c a, TMap c a)
-> (TMap c a -> TMap c a, TMap c a)
step (TMap c a -> TMap c a
base, forall a c. a -> TMap c a
just (Maybe a -> a
f forall a. Maybe a
Nothing))
  where
    base :: TMap c a -> TMap c a
base (TMap (Node Maybe a
ma Map c (TMap c a)
e)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node (forall a. a -> Maybe a
Just (Maybe a -> a
f Maybe a
ma)) Map c (TMap c a)
e)
    step :: c
-> (TMap c a -> TMap c a, TMap c a)
-> (TMap c a -> TMap c a, TMap c a)
step c
x (TMap c a -> TMap c a
inserter', TMap c a
xs') =
      let inserter :: TMap c a -> TMap c a
inserter (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
            let e' :: Map c (TMap c a)
e' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall a b. a -> b -> a
const TMap c a -> TMap c a
inserter') c
x TMap c a
xs' Map c (TMap c a)
e
            in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e')
      in (TMap c a -> TMap c a
inserter, forall c a. c -> TMap c a -> TMap c a
cons c
x TMap c a
xs')
{-# INLINE revise #-}

-- | Apply a function @f@ to the entry with given key. If @f@ returns
--   @Nothing@, that entry is deleted.
update :: (Ord c) => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update :: forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update a -> Maybe a
f [c]
cs = forall a. a -> Maybe a -> a
fromMaybe forall c a. TMap c a
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
Ord c =>
(a -> Maybe a) -> [c] -> TMap c a -> Maybe (TMap c a)
update_ a -> Maybe a
f [c]
cs
{-# INLINE update #-}

update_ :: (Ord c) => (a -> Maybe a) -> [c] -> TMap c a -> Maybe (TMap c a)
update_ :: forall c a.
Ord c =>
(a -> Maybe a) -> [c] -> TMap c a -> Maybe (TMap c a)
update_ a -> Maybe a
f = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c} {a}.
Ord c =>
c -> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
step TMap c a -> Maybe (TMap c a)
base
  where
    base :: TMap c a -> Maybe (TMap c a)
base (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
      let ma' :: Maybe a
ma' = Maybe a
ma forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe a
f
      in if forall a. Maybe a -> Bool
isNothing Maybe a
ma' Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e
           then forall a. Maybe a
Nothing
           else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma' Map c (TMap c a)
e)
    step :: c -> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
step c
x TMap c a -> Maybe (TMap c a)
xs (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
      let e' :: Map c (TMap c a)
e' = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update TMap c a -> Maybe (TMap c a)
xs c
x Map c (TMap c a)
e
      in if forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e'
           then forall a. Maybe a
Nothing
           else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e')
{-# INLINE update_ #-}

-- | Apply a function @f@ to the entry with given key. This function @alter@
--   is the most generic version of 'adjust', 'revise', 'update'.
-- 
--   * You can insert new entry by returning @Just a@ from @f Nothing@.
--   * You can delete existing entry by returning @Nothing@ from
--     @f (Just a)@.
--
--   This function always evaluates @f Nothing@ in addition to determine
--   operation applied to the given key.
--   If you're not going to use @alter@ on missing keys, consider using @update@ instead.
alter :: (Ord c) => (Maybe a -> Maybe a) -> [c] -> TMap c a -> TMap c a
alter :: forall c a.
Ord c =>
(Maybe a -> Maybe a) -> [c] -> TMap c a -> TMap c a
alter Maybe a -> Maybe a
f =
  case Maybe a -> Maybe a
f forall a. Maybe a
Nothing of
    Maybe a
Nothing -> forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update (Maybe a -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
    Just a
f0 -> \[c]
cs -> forall a. a -> Maybe a -> a
fromMaybe forall c a. TMap c a
empty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a.
Ord c =>
(Maybe a -> Maybe a) -> a -> [c] -> TMap c a -> Maybe (TMap c a)
alter_ Maybe a -> Maybe a
f a
f0 [c]
cs
{-# INLINE alter #-}

alter_ :: (Ord c) => (Maybe a -> Maybe a) -> a -> [c] -> TMap c a -> Maybe (TMap c a)
alter_ :: forall c a.
Ord c =>
(Maybe a -> Maybe a) -> a -> [c] -> TMap c a -> Maybe (TMap c a)
alter_ Maybe a -> Maybe a
f a
f0 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c} {a}.
Ord c =>
c
-> (TMap c a -> Maybe (TMap c a), TMap c a)
-> (TMap c a -> Maybe (TMap c a), TMap c a)
step (TMap c a -> Maybe (TMap c a)
base, forall a c. a -> TMap c a
just a
f0)
  where
    base :: TMap c a -> Maybe (TMap c a)
base (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
      let ma' :: Maybe a
ma' = Maybe a -> Maybe a
f Maybe a
ma
      in if forall a. Maybe a -> Bool
isNothing Maybe a
ma' Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e
           then forall a. Maybe a
Nothing
           else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma' Map c (TMap c a)
e)
    step :: c
-> (TMap c a -> Maybe (TMap c a), TMap c a)
-> (TMap c a -> Maybe (TMap c a), TMap c a)
step c
x (TMap c a -> Maybe (TMap c a)
alterer', TMap c a
xs') =
      let alterer :: TMap c a -> Maybe (TMap c a)
alterer (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
            let e' :: Map c (TMap c a)
e' = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just TMap c a
xs') TMap c a -> Maybe (TMap c a)
alterer') c
x Map c (TMap c a)
e
            in if forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e'
                 then forall a. Maybe a
Nothing
                 else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e')
      in (TMap c a -> Maybe (TMap c a)
alterer, forall c a. c -> TMap c a -> TMap c a
cons c
x TMap c a
xs')
{-# INLINE alter_ #-}

-- * Combine
union :: (Ord c) => TMap c a -> TMap c a -> TMap c a
union :: forall c a. Ord c => TMap c a -> TMap c a -> TMap c a
union = forall c a.
Ord c =>
(a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith forall a b. a -> b -> a
const

unionWith :: (Ord c) => (a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith :: forall c a.
Ord c =>
(a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith a -> a -> a
f = TMap c a -> TMap c a -> TMap c a
go
  where
    go :: TMap c a -> TMap c a -> TMap c a
go (TMap (Node Maybe a
mat Map c (TMap c a)
et)) (TMap (Node Maybe a
mau Map c (TMap c a)
eu)) =
      let maz :: Maybe a
maz = case (Maybe a
mat, Maybe a
mau) of
            (Maybe a
Nothing, Maybe a
Nothing) -> forall a. Maybe a
Nothing
            (Just a
at, Maybe a
Nothing) -> forall a. a -> Maybe a
Just a
at
            (Maybe a
Nothing, Just a
au) -> forall a. a -> Maybe a
Just a
au
            (Just a
at, Just a
au) -> forall a. a -> Maybe a
Just (a -> a -> a
f a
at a
au)
          ez :: Map c (TMap c a)
ez = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith TMap c a -> TMap c a -> TMap c a
go Map c (TMap c a)
et Map c (TMap c a)
eu
      in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
maz Map c (TMap c a)
ez)

intersection :: (Ord c) => TMap c a -> TMap c b -> TMap c a
intersection :: forall c a b. Ord c => TMap c a -> TMap c b -> TMap c a
intersection = forall c a b r.
Ord c =>
(a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r
intersectionWith (\a
a b
_ -> forall a. a -> Maybe a
Just a
a)

intersectionWith :: (Ord c) =>
  (a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r
intersectionWith :: forall c a b r.
Ord c =>
(a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r
intersectionWith a -> b -> Maybe r
f TMap c a
x TMap c b
y = forall a. a -> Maybe a -> a
fromMaybe forall c a. TMap c a
empty forall a b. (a -> b) -> a -> b
$ TMap c a -> TMap c b -> Maybe (TMap c r)
go TMap c a
x TMap c b
y
  where
    go :: TMap c a -> TMap c b -> Maybe (TMap c r)
go (TMap (Node Maybe a
ma Map c (TMap c a)
ex)) (TMap (Node Maybe b
mb Map c (TMap c b)
ey)) =
      if forall a. Maybe a -> Bool
isNothing Maybe r
mr Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c r)
ez
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe r
mr Map c (TMap c r)
ez)
      where
        mr :: Maybe r
mr = do a
a <- Maybe a
ma
                b
b <- Maybe b
mb
                a -> b -> Maybe r
f a
a b
b
        emz :: Map c (Maybe (TMap c r))
emz = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith TMap c a -> TMap c b -> Maybe (TMap c r)
go Map c (TMap c a)
ex Map c (TMap c b)
ey
        ez :: Map c (TMap c r)
ez = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a. a -> a
id Map c (Maybe (TMap c r))
emz

difference :: (Ord c) => TMap c a -> TMap c b -> TMap c a
difference :: forall c a b. Ord c => TMap c a -> TMap c b -> TMap c a
difference = forall c a b.
Ord c =>
(a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
differenceWith (\a
_ b
_ -> forall a. Maybe a
Nothing)

differenceWith :: (Ord c) =>
  (a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
differenceWith :: forall c a b.
Ord c =>
(a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
differenceWith a -> b -> Maybe a
f TMap c a
x TMap c b
y = forall a. a -> Maybe a -> a
fromMaybe forall c a. TMap c a
empty forall a b. (a -> b) -> a -> b
$ TMap c a -> TMap c b -> Maybe (TMap c a)
go TMap c a
x TMap c b
y
  where
    go :: TMap c a -> TMap c b -> Maybe (TMap c a)
go (TMap (Node Maybe a
ma Map c (TMap c a)
ex)) (TMap (Node Maybe b
mb Map c (TMap c b)
ey)) =
      if forall a. Maybe a -> Bool
isNothing Maybe a
mr Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
ez
        then forall a. Maybe a
Nothing
        else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
mr Map c (TMap c a)
ez)
      where
        mr :: Maybe a
mr = case (Maybe a
ma, Maybe b
mb) of
          (Maybe a
Nothing, Maybe b
_)       -> forall a. Maybe a
Nothing
          (Just a
a,  Maybe b
Nothing) -> forall a. a -> Maybe a
Just a
a
          (Just a
a,  Just b
b)  -> a -> b -> Maybe a
f a
a b
b
        ez :: Map c (TMap c a)
ez = forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith TMap c a -> TMap c b -> Maybe (TMap c a)
go Map c (TMap c a)
ex Map c (TMap c b)
ey

{- |
Creates a new @TMap@ from two @TMap@s. The keys of the new map
are concatenations of one key from the first map and another one from the second map.

Corresponding values for these keys are calculated with the given function
of type @(x -> y -> z)@. If two different concatenations yield
the same key, the calculated values for these keys are combined with the 'Semigroup' operation @<>@.

The behavior of @appendWith@ is equivalent to the following implementation.

@
appendWith :: (Ord c, Semigroup z) => (x -> y -> z) ->
  TMap c x -> TMap c y -> TMap c z
appendWith f x y = 'fromListWith' (flip (<>))
  [ (kx ++ ky, f valx valy)
    | (kx, valx) <- 'toAscList' x
    , (ky, valy) <- toAscList y ]
@

In other words, a set of colliding key-valur pairs is combined in increasing order of the left key.
For example, suppose @x, y@ are @TMap@ with these key-value pairs,
and @kx1 ++ ky3, kx2 ++ ky2, kx3 ++ ky1@ are all equal to the same key @kz@.

@
x = 'fromAscList' [ (kx1, x1), (kx2, x2), (kx3, x3) ] -- kx1 < kx2 < kx3
y = fromAscList [ (ky1, y1), (ky2, y2), (ky3, y3) ]
@

On these maps, @appendWith@ combines the values for these colliding keys
in the order of @kx*@.

@
'lookup' kz (appendWith f x y) == Just (f x1 y3 <> f x2 y2 <> f x3 y1)
@

===== Example

> let x = fromList [("a", 1), ("aa", 2)]     :: TMap Char Int
>     y = fromList [("aa", 10), ("aaa", 20)] :: TMap Char Int
>
> appendWith (\a b -> show (a,b)) x y ==
>   fromList [ ("aaa", "(1,10)")
>            , ("aaaa", "(1,20)" <> "(2,10)")
>            , ("aaaaa", "(2,20)") ]

-}
appendWith :: (Ord c, Semigroup z) => (x -> y -> z) ->
  TMap c x -> TMap c y -> TMap c z
appendWith :: forall c z x y.
(Ord c, Semigroup z) =>
(x -> y -> z) -> TMap c x -> TMap c y -> TMap c z
appendWith x -> y -> z
f TMap c x
xs (TMap (Node Maybe y
my Map c (TMap c y)
ey))
  | forall k a. Map k a -> Bool
Map.null Map c (TMap c y)
ey = case Maybe y
my of
      Maybe y
Nothing -> forall c a. TMap c a
empty
      Just y
y  -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> y -> z
`f` y
y) TMap c x
xs
  | Bool
otherwise = TMap c x -> TMap c z
go TMap c x
xs
    where
      go :: TMap c x -> TMap c z
go (TMap (Node Maybe x
Nothing Map c (TMap c x)
ex)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node forall a. Maybe a
Nothing (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TMap c x -> TMap c z
go Map c (TMap c x)
ex))
      go (TMap (Node (Just x
x) Map c (TMap c x)
ex)) =
        let mz :: Maybe z
mz = x -> y -> z
f x
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe y
my
            ex' :: Map c (TMap c z)
ex' = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TMap c x -> TMap c z
go Map c (TMap c x)
ex
            ey' :: Map c (TMap c z)
ey' = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (x -> y -> z
f x
x)) Map c (TMap c y)
ey
            ez :: Map c (TMap c z)
ez = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith (forall c a.
Ord c =>
(a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith forall a. Semigroup a => a -> a -> a
(<>)) Map c (TMap c z)
ey' Map c (TMap c z)
ex'
        in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe z
mz Map c (TMap c z)
ez)

-- * Instances

instance Functor (TMap c) where
  fmap :: forall a b. (a -> b) -> TMap c a -> TMap c b
fmap a -> b
f = TMap c a -> TMap c b
go
    where
      go :: TMap c a -> TMap c b
go (TMap (Node Maybe a
ma Map c (TMap c a)
e)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
ma) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TMap c a -> TMap c b
go Map c (TMap c a)
e))

instance Foldable (TMap c) where
  foldr :: forall a b. (a -> b -> b) -> b -> TMap c a -> b
foldr a -> b -> b
f b
z = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. TMap c a -> [a]
elems
  toList :: forall a. TMap c a -> [a]
toList = forall c a. TMap c a -> [a]
elems
  null :: forall a. TMap c a -> Bool
null = forall c a. TMap c a -> Bool
Data.Trie.Map.Hidden.null
  length :: forall a. TMap c a -> Int
length = forall c a. TMap c a -> Int
count

instance Traversable (TMap c) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TMap c a -> f (TMap c b)
traverse a -> f b
f = forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey (forall a b. a -> b -> a
const a -> f b
f)

-- | 'unionWith'-based
instance (Ord c, Semigroup a) => Semigroup (TMap c a) where
  <> :: TMap c a -> TMap c a -> TMap c a
(<>) = forall c a.
Ord c =>
(a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith forall a. Semigroup a => a -> a -> a
(<>)
  stimes :: forall b. Integral b => b -> TMap c a -> TMap c a
stimes b
n = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n)

-- | 'unionWith'-based
instance (Ord c, Semigroup a) => Monoid (TMap c a) where
  mempty :: TMap c a
mempty = forall c a. TMap c a
empty
  mappend :: TMap c a -> TMap c a -> TMap c a
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- * Conversion

toList :: TMap c a -> [([c], a)]
toList :: forall c a. TMap c a -> [([c], a)]
toList = forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey (\[c]
k a
a [([c], a)]
r -> ([c]
k,a
a) forall a. a -> [a] -> [a]
: [([c], a)]
r) []

fromList :: Ord c => [([c], a)] -> TMap c a
fromList :: forall c a. Ord c => [([c], a)] -> TMap c a
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall c a. Ord c => [c] -> a -> TMap c a -> TMap c a
insert)) forall c a. TMap c a
empty

fromListWith :: Ord c => (a -> a -> a) -> [ ([c],a)] -> TMap c a
fromListWith :: forall c a. Ord c => (a -> a -> a) -> [([c], a)] -> TMap c a
fromListWith a -> a -> a
op = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall c a.
Ord c =>
(a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a
insertWith a -> a -> a
op))) forall c a. TMap c a
empty

toAscList :: TMap c a -> [([c], a)]
toAscList :: forall c a. TMap c a -> [([c], a)]
toAscList = forall c a. TMap c a -> [([c], a)]
toList

fromAscList :: Eq c => [([c], a)] -> TMap c a
fromAscList :: forall c a. Eq c => [([c], a)] -> TMap c a
fromAscList [] = forall c a. TMap c a
empty
fromAscList [([c]
cs, a
a)] = forall c a. [c] -> a -> TMap c a
singleton [c]
cs a
a
fromAscList [([c], a)]
pairs =
  let ([a]
as, [(c, [([c], a)])]
gs) = forall c a. Eq c => [([c], a)] -> ([a], [(c, [([c], a)])])
group_ [([c], a)]
pairs
      ma :: Maybe a
ma = forall a. NonEmpty a -> a
NE.last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
as
      e :: Map c (TMap c a)
e = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c a. Eq c => [([c], a)] -> TMap c a
fromAscList) [(c, [([c], a)])]
gs
  in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e)

foldl1' :: (a -> a -> a) -> NE.NonEmpty a -> a
foldl1' :: forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' a -> a -> a
f (a
a NE.:| [a]
as) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' a -> a -> a
f a
a [a]
as

fromAscListWith :: Ord c => (a -> a -> a) -> [ ([c],a)] -> TMap c a
fromAscListWith :: forall c a. Ord c => (a -> a -> a) -> [([c], a)] -> TMap c a
fromAscListWith a -> a -> a
_ [] = forall c a. TMap c a
empty
fromAscListWith a -> a -> a
op [([c], a)]
pairs =
  let ([a]
as, [(c, [([c], a)])]
gs) = forall c a. Eq c => [([c], a)] -> ([a], [(c, [([c], a)])])
group_ [([c], a)]
pairs
      ma :: Maybe a
ma = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' (forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
op) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
as
      e :: Map c (TMap c a)
e = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall c a. Ord c => (a -> a -> a) -> [([c], a)] -> TMap c a
fromAscListWith a -> a -> a
op)) [(c, [([c], a)])]
gs
  in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
ma Map c (TMap c a)
e)

group_ :: Eq c => [([c], a)] -> ([a], [ (c, [ ([c], a) ]) ] )
group_ :: forall c a. Eq c => [([c], a)] -> ([a], [(c, [([c], a)])])
group_ = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}.
Eq a =>
([a], b) -> ([b], [(a, [([a], b)])]) -> ([b], [(a, [([a], b)])])
step ([], [])
  where
    step :: ([a], b) -> ([b], [(a, [([a], b)])]) -> ([b], [(a, [([a], b)])])
step ([], b
a) ~([b]
as, [(a, [([a], b)])]
gs) = (b
a forall a. a -> [a] -> [a]
: [b]
as, [(a, [([a], b)])]
gs)
    step (a
c:[a]
cs, b
a) ~([b]
as, [(a, [([a], b)])]
gs) = ([b]
as, forall {a} {a} {b}.
Eq a =>
a -> a -> b -> [(a, [(a, b)])] -> [(a, [(a, b)])]
prepend a
c [a]
cs b
a [(a, [([a], b)])]
gs)
    
    prepend :: a -> a -> b -> [(a, [(a, b)])] -> [(a, [(a, b)])]
prepend a
c a
cs b
a [(a, [(a, b)])]
gs = case [(a, [(a, b)])]
gs of
      (a
d,[(a, b)]
ps'):[(a, [(a, b)])]
rest | a
c forall a. Eq a => a -> a -> Bool
== a
d  -> (a
d, (a
cs,b
a)forall a. a -> [a] -> [a]
:[(a, b)]
ps')forall a. a -> [a] -> [a]
:[(a, [(a, b)])]
rest
      [(a, [(a, b)])]
_                      -> (a
c, [(a
cs,b
a)])forall a. a -> [a] -> [a]
:[(a, [(a, b)])]
gs

toMap :: TMap c a -> Map [c] a
toMap :: forall c a. TMap c a -> Map [c] a
toMap = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a. TMap c a -> [([c], a)]
toAscList

fromMap :: (Eq c) => Map [c] a -> TMap c a
fromMap :: forall c a. Eq c => Map [c] a -> TMap c a
fromMap = forall c a. Eq c => [([c], a)] -> TMap c a
fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
Map.toAscList

keysTSet :: TMap c a -> TSet c
keysTSet :: forall c a. TMap c a -> TSet c
keysTSet (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
    forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
TSet.Node (forall a. Maybe a -> Bool
isJust Maybe a
ma) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall c a. TMap c a -> TSet c
keysTSet Map c (TMap c a)
e))

fromTSet :: ([c] -> a) -> TSet c -> TMap c a
fromTSet :: forall c a. ([c] -> a) -> TSet c -> TMap c a
fromTSet [c] -> a
f = [c] -> TSet c -> TMap c a
go []
  where
    go :: [c] -> TSet c -> TMap c a
go [c]
q (TSet (TSet.Node Bool
a Map c (TSet c)
e)) =
      let e' :: Map c (TMap c a)
e' = forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\c
c -> [c] -> TSet c -> TMap c a
go (c
cforall a. a -> [a] -> [a]
:[c]
q)) Map c (TSet c)
e
          a' :: Maybe a
a' = if Bool
a then forall a. a -> Maybe a
Just ([c] -> a
f (forall a. [a] -> [a]
reverse [c]
q)) else forall a. Maybe a
Nothing
      in forall c a. Node c a (TMap c a) -> TMap c a
TMap (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
a' Map c (TMap c a)
e')

-- * Parsing

toParser :: Alternative f =>
     (c -> f c') -- ^ char
  -> f eot       -- ^ eot
  -> TMap c a -> f ([c'], a)
toParser :: forall (f :: * -> *) c c' eot a.
Alternative f =>
(c -> f c') -> f eot -> TMap c a -> f ([c'], a)
toParser c -> f c'
f f eot
eot = forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a (f ([c'], a)) -> f ([c'], a)
toParser'
  where
    toParser' :: Node c a (f ([c'], a)) -> f ([c'], a)
toParser' (Node Maybe a
ma Map c (f ([c'], a))
e) =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
Ap.empty (\a
a -> ([], a
a) forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f eot
eot) Maybe a
ma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ forall {a} {b}. a -> ([a], b) -> ([a], b)
consFst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
f c
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ([c'], a)
p' | (c
c, f ([c'], a)
p') <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map c (f ([c'], a))
e ]

    consFst :: a -> ([a], b) -> ([a], b)
consFst a
c ([a]
cs, b
a) = (a
cforall a. a -> [a] -> [a]
:[a]
cs, b
a)

toParser_ :: Alternative f =>
     (c -> f c') -- ^ char
  -> f eot       -- ^ eot
  -> TMap c a -> f a
toParser_ :: forall (f :: * -> *) c c' eot a.
Alternative f =>
(c -> f c') -> f eot -> TMap c a -> f a
toParser_ c -> f c'
f f eot
eot = forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a (f a) -> f a
toParser'
  where
    toParser' :: Node c a (f a) -> f a
toParser' (Node Maybe a
ma Map c (f a)
e) =
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. Alternative f => f a
Ap.empty (forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f eot
eot) Maybe a
ma forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ c -> f c'
f c
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
p' | (c
c, f a
p') <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map c (f a)
e ]

toParser__ :: Alternative f =>
     (c -> f c') -- ^ char
  -> f eot       -- ^ eot
  -> TMap c a -> f ()
toParser__ :: forall (f :: * -> *) c c' eot a.
Alternative f =>
(c -> f c') -> f eot -> TMap c a -> f ()
toParser__ c -> f c'
f f eot
eot = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) c c' eot a.
Alternative f =>
(c -> f c') -> f eot -> TMap c a -> f a
toParser_ c -> f c'
f f eot
eot

-- * Traversing with keys

-- | Same semantics to following defintion, but have
--   more efficient implementation.
--
-- > traverseWithKey f = fmap fromAscList .
-- >                     traverse (\(cs,a) -> (,) cs <$> f cs a) .
-- >                     toAscList
traverseWithKey :: (Applicative f) =>
  ([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey :: forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey [c] -> a -> f b
f (TMap (Node Maybe a
Nothing Map c (TMap c a)
e)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c a r. Maybe a -> Map c r -> Node c a r
Node forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\c
c TMap c a
t' -> forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey ([c] -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cforall a. a -> [a] -> [a]
:)) TMap c a
t') Map c (TMap c a)
e
traverseWithKey [c] -> a -> f b
f (TMap (Node (Just a
a) Map c (TMap c a)
e)) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c a. Node c a (TMap c a) -> TMap c a
TMap forall a b. (a -> b) -> a -> b
$ forall c a r. Maybe a -> Map c r -> Node c a r
Node forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [c] -> a -> f b
f [] a
a) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey (\c
c TMap c a
t' -> forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey ([c] -> a -> f b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cforall a. a -> [a] -> [a]
:)) TMap c a
t') Map c (TMap c a)
e

-- | Same semantics to following defintion, but have
--   more efficient implementation.
--
-- > mapWithKey f = fromAscList .
-- >                map (\(cs,a) -> (cs,  f cs a)) .
-- >                toAscList
mapWithKey :: ([c] -> a -> b) -> TMap c a -> TMap c b
mapWithKey :: forall c a b. ([c] -> a -> b) -> TMap c a -> TMap c b
mapWithKey [c] -> a -> b
f (TMap (Node Maybe a
ma Map c (TMap c a)
e)) = forall c a. Node c a (TMap c a) -> TMap c a
TMap forall a b. (a -> b) -> a -> b
$ forall c a r. Maybe a -> Map c r -> Node c a r
Node ([c] -> a -> b
f [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma) (forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\c
c TMap c a
t' -> forall c a b. ([c] -> a -> b) -> TMap c a -> TMap c b
mapWithKey ([c] -> a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cforall a. a -> [a] -> [a]
:)) TMap c a
t') Map c (TMap c a)
e)

-- | Same semantics to following defintion, but have
--   more efficient implementation.
--
-- > foldMapWithKey f = foldMap (uncurry f) . toAscList
foldMapWithKey :: (Monoid r) => ([c] -> a -> r) -> TMap c a -> r
foldMapWithKey :: forall r c a. Monoid r => ([c] -> a -> r) -> TMap c a -> r
foldMapWithKey [c] -> a -> r
f = forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey (\[c]
k a
v r
r -> [c] -> a -> r
f [c]
k a
v forall a. Semigroup a => a -> a -> a
<> r
r) forall a. Monoid a => a
mempty

-- | Same semantics to following defintion, but have
--   more efficient implementation.
--
-- > foldrWithKey f z = foldr (uncurry f) z . toAscList
foldrWithKey :: ([c] -> a -> r -> r) -> r -> TMap c a -> r
foldrWithKey :: forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey [c] -> a -> r -> r
f r
z (TMap (Node Maybe a
ma Map c (TMap c a)
e)) =
  case Maybe a
ma of
    Maybe a
Nothing -> r
r
    Just a
a  -> [c] -> a -> r -> r
f [] a
a r
r
  where
    r :: r
r = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\c
c TMap c a
subTrie r
s ->
          forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey ([c] -> a -> r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cforall a. a -> [a] -> [a]
:)) r
s TMap c a
subTrie) r
z Map c (TMap c a)
e

-- * Other operations

foldTMap :: (Node c a r -> r) -> TMap c a -> r
foldTMap :: forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a r -> r
f = TMap c a -> r
go
  where
    -- Use lazy @<$>@
    go :: TMap c a -> r
go (TMap (Node Maybe a
a Map c (TMap c a)
e)) = Node c a r -> r
f (forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
a (TMap c a -> r
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map c (TMap c a)
e))

nonEmptyTMap :: TMap c a -> Maybe (TMap c a)
nonEmptyTMap :: forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap TMap c a
t
  | forall c a. TMap c a -> Bool
null TMap c a
t = forall a. Maybe a
Nothing
  | Bool
otherwise = forall a. a -> Maybe a
Just TMap c a
t