{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Data.Trie.Map.Hidden(
  -- * Types
  TMap(..),
  -- * Queries
  match,
  lookup,
  lookupPrefixes,
  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
[Node c a r] -> ShowS
Node c a r -> String
(Int -> Node c a r -> ShowS)
-> (Node c a r -> String)
-> ([Node c a r] -> ShowS)
-> Show (Node c a r)
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
$cshowsPrec :: forall c a r.
(Show a, Show c, Show r) =>
Int -> Node c a r -> ShowS
showsPrec :: Int -> Node c a r -> ShowS
$cshow :: forall c a r. (Show a, Show c, Show r) => Node c a r -> String
show :: Node c a r -> String
$cshowList :: forall c a r. (Show a, Show c, Show r) => [Node c a r] -> ShowS
showList :: [Node c a r] -> ShowS
Show, Node c a r -> Node c a r -> Bool
(Node c a r -> Node c a r -> Bool)
-> (Node c a r -> Node c a r -> Bool) -> Eq (Node c a r)
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
$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
/= :: Node c a r -> Node c a r -> Bool
Eq, Eq (Node c a r)
Eq (Node c a r) =>
(Node c a r -> Node c a r -> Ordering)
-> (Node c a r -> Node c a r -> Bool)
-> (Node c a r -> Node c a r -> Bool)
-> (Node c a r -> Node c a r -> Bool)
-> (Node c a r -> Node c a r -> Bool)
-> (Node c a r -> Node c a r -> Node c a r)
-> (Node c a r -> Node c a r -> Node c a r)
-> Ord (Node c a r)
Node c a r -> Node c a r -> Bool
Node c a r -> Node c a r -> Ordering
Node c a r -> Node c a r -> Node c a r
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
$ccompare :: forall c a r.
(Ord a, Ord c, Ord r) =>
Node c a r -> Node c a r -> Ordering
compare :: Node c a r -> Node c a r -> Ordering
$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
>= :: Node c a r -> Node c a r -> Bool
$cmax :: 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
$cmin :: 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
Ord, (forall a b. (a -> b) -> Node c a a -> Node c a b)
-> (forall a b. a -> Node c a b -> Node c a a)
-> Functor (Node c a)
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
$cfmap :: forall c a a b. (a -> b) -> Node c a a -> Node c a b
fmap :: forall a b. (a -> b) -> Node c a a -> Node c a b
$c<$ :: forall c a a b. a -> Node c a b -> Node c a a
<$ :: forall a b. a -> Node c a b -> Node c a a
Functor, (forall m. Monoid m => Node c a m -> m)
-> (forall m a. Monoid m => (a -> m) -> Node c a a -> m)
-> (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 a b. (a -> b -> b) -> b -> Node c a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node c a a -> b)
-> (forall b a. (b -> a -> b) -> b -> Node c a a -> b)
-> (forall a. (a -> a -> a) -> Node c a a -> a)
-> (forall a. (a -> a -> a) -> Node c a a -> a)
-> (forall a. Node c a a -> [a])
-> (forall a. Node c a a -> Bool)
-> (forall a. Node c a a -> Int)
-> (forall a. Eq a => a -> Node c a a -> Bool)
-> (forall a. Ord a => Node c a a -> a)
-> (forall a. Ord a => Node c a a -> a)
-> (forall a. Num a => Node c a a -> a)
-> (forall a. Num a => Node c a a -> a)
-> Foldable (Node c a)
forall a. Eq a => a -> Node c a a -> Bool
forall a. Num a => Node c a a -> a
forall a. Ord a => Node c a a -> a
forall m. Monoid m => Node c a m -> m
forall a. Node c a a -> Bool
forall a. Node c a a -> Int
forall a. Node c a a -> [a]
forall a. (a -> a -> a) -> Node c a a -> a
forall m a. Monoid m => (a -> m) -> Node c a a -> m
forall b a. (b -> a -> b) -> b -> Node c a a -> b
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
$cfold :: forall c a m. Monoid m => Node c a m -> m
fold :: forall m. Monoid m => Node c a m -> 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
foldMap' :: forall m a. Monoid m => (a -> m) -> Node c a a -> m
$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
foldr' :: forall a b. (a -> b -> 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
foldl' :: forall b a. (b -> a -> b) -> b -> Node c a a -> b
$cfoldr1 :: forall c a a. (a -> a -> a) -> Node c a a -> a
foldr1 :: forall a. (a -> a -> a) -> Node c a a -> a
$cfoldl1 :: forall c a a. (a -> a -> a) -> Node c a a -> a
foldl1 :: forall a. (a -> a -> a) -> Node c a a -> a
$ctoList :: forall c a a. Node c a a -> [a]
toList :: forall a. Node c a a -> [a]
$cnull :: forall c a a. Node c a a -> Bool
null :: forall a. Node c a a -> Bool
$clength :: forall c a a. Node c a a -> Int
length :: forall a. Node c a a -> Int
$celem :: forall c a a. Eq a => a -> Node c a a -> Bool
elem :: forall a. Eq a => a -> Node c a a -> Bool
$cmaximum :: forall c a a. Ord a => Node c a a -> a
maximum :: forall a. Ord a => Node c a a -> a
$cminimum :: forall c a a. Ord a => Node c a a -> a
minimum :: forall a. Ord a => Node c a a -> a
$csum :: forall c a a. Num a => Node c a a -> a
sum :: forall a. Num a => Node c a a -> a
$cproduct :: forall c a a. Num a => Node c a a -> a
product :: forall a. Num a => Node c a a -> a
Foldable, Functor (Node c a)
Foldable (Node c a)
(Functor (Node c a), Foldable (Node c a)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Node c a a -> f (Node c a b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Node c a (f a) -> f (Node c a a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Node c a a -> m (Node c a b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Node c a (m a) -> m (Node c a a))
-> Traversable (Node c a)
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 (m :: * -> *) a. Monad m => Node c a (m a) -> m (Node c a a)
forall (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
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)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a a -> f (Node c a b)
$csequenceA :: forall c a (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Node c a (f a) -> f (Node c a a)
$cmapM :: forall c a (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a a -> m (Node c a b)
$csequence :: forall c a (m :: * -> *) a.
Monad m =>
Node c a (m a) -> m (Node c a a)
sequence :: forall (m :: * -> *) a. Monad m => Node c a (m a) -> m (Node c a a)
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 = (a -> a -> Bool)
-> (a -> b -> Bool) -> Node c a a -> Node c a b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Node c a c -> Node c b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
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 = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> Node c a a -> Node c a b -> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Node c a c -> Node c b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
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) = (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
forall a b. (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
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
&& (c -> d -> Bool) -> Map c c -> Map c d -> Bool
forall a b. (a -> b -> Bool) -> Map c a -> Map c b -> 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) = (a -> b -> Ordering) -> Maybe a -> Maybe b -> Ordering
forall a b. (a -> b -> Ordering) -> Maybe a -> Maybe b -> Ordering
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 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (c -> d -> Ordering) -> Map c c -> Map c d -> Ordering
forall a b. (a -> b -> Ordering) -> Map c a -> Map c b -> Ordering
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) = Maybe a -> ()
forall a. NFData a => a -> ()
rnf Maybe a
a () -> () -> ()
forall a b. a -> b -> b
`seq` Map c r -> ()
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
(TMap c a -> TMap c a -> Bool)
-> (TMap c a -> TMap c a -> Bool) -> Eq (TMap c a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c a. (Eq a, Eq c) => 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
/= :: TMap c a -> TMap c a -> Bool
Eq, Eq (TMap c a)
Eq (TMap c a) =>
(TMap c a -> TMap c a -> Ordering)
-> (TMap c a -> TMap c a -> Bool)
-> (TMap c a -> TMap c a -> Bool)
-> (TMap c a -> TMap c a -> Bool)
-> (TMap c a -> TMap c a -> Bool)
-> (TMap c a -> TMap c a -> TMap c a)
-> (TMap c a -> TMap c a -> TMap c a)
-> Ord (TMap c a)
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
$ccompare :: forall c a. (Ord a, Ord c) => TMap c a -> TMap c a -> Ordering
compare :: TMap c a -> TMap c a -> Ordering
$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
>= :: TMap c a -> TMap c a -> Bool
$cmax :: 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
$cmin :: 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
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
    String -> ShowS
showString String
"fromList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([a], b) -> ShowS) -> [([a], b)] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith (([a] -> ShowS) -> (b -> ShowS) -> ([a], b) -> ShowS
forall a b. (a -> ShowS) -> (b -> ShowS) -> (a, b) -> ShowS
showPairWith [a] -> ShowS
showListC (Int -> b -> ShowS
showspA Int
0)) (TMap a b -> [([a], b)]
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 = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> (a, b)
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 ((a -> ShowS) -> Int -> a -> ShowS
forall a b. a -> b -> a
const a -> ShowS
showsA) ((a -> ShowS) -> [a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith a -> ShowS
showsA) ((b -> ShowS) -> Int -> b -> ShowS
forall a b. a -> b -> a
const b -> ShowS
showsB) ((b -> ShowS) -> [b] -> ShowS
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 = (Int -> c -> ShowS)
-> ([c] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> TMap c a
-> ShowS
forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> TMap a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> c -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [c] -> ShowS
forall a. Show a => [a] -> ShowS
showList

instance (Show c, Show a) => Show (TMap c a) where
  showsPrec :: Int -> TMap c a -> ShowS
showsPrec = Int -> TMap c a -> ShowS
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) = Node c a (TMap c a) -> ()
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 = (c -> c -> Bool)
-> (a -> b -> Bool) -> TMap c a -> TMap c b -> Bool
forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> TMap a c -> TMap b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 c -> c -> Bool
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)) =
        (c -> d -> Bool) -> Maybe c -> Maybe d -> Bool
forall a b. (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool
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
&&
        (a -> b -> Bool)
-> (TMap a c -> TMap b d -> Bool)
-> Map a (TMap a c)
-> Map b (TMap b d)
-> Bool
forall a b c d.
(a -> b -> Bool) -> (c -> d -> Bool) -> Map a c -> Map b d -> 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) = (a -> b -> Ordering)
-> (TMap c a -> TMap c b -> Ordering)
-> Node c a (TMap c a)
-> Node c b (TMap c b)
-> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Node c a c -> Node c b d -> Ordering
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 ((a -> b -> Ordering) -> TMap c a -> TMap c b -> Ordering
forall a b.
(a -> b -> Ordering) -> TMap c a -> TMap c b -> Ordering
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)) =
        (c -> d -> Ordering) -> Maybe c -> Maybe d -> Ordering
forall a b. (a -> b -> Ordering) -> Maybe a -> Maybe b -> Ordering
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 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<>
        (a -> b -> Ordering)
-> (TMap a c -> TMap b d -> Ordering)
-> Map a (TMap a c)
-> Map b (TMap b d)
-> Ordering
forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Map a c -> Map b d -> Ordering
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 = [([c], a)] -> TMap c a
[Item (TMap c a)] -> TMap c a
forall c a. Ord c => [([c], a)] -> TMap c a
fromList
  toList :: TMap c a -> [Item (TMap c a)]
toList = TMap c a -> [([c], a)]
TMap c a -> [Item (TMap c a)]
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 = (Int -> b -> Int) -> Int -> Maybe b -> Int
forall a. (Int -> a -> Int) -> Int -> Maybe a -> Int
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 = (Int -> a -> Int)
-> (Int -> TMap a b -> Int) -> Int -> Map a (TMap a b) -> Int
forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> Map a b -> Int
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 = (Int -> c -> Int) -> (Int -> a -> Int) -> Int -> TMap c a -> Int
forall a b.
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> TMap a b -> Int
forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> c -> Int
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 = Int -> TMap c a -> Int
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 = ([c] -> a -> b) -> TMap c a -> TMap c b
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 = ([c] -> a -> b -> b) -> b -> TMap c a -> b
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 = ([c] -> a -> f b) -> TMap c a -> f (TMap c b)
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)) =
        Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe a
ma Maybe a -> (a -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe b
f) ((TMap c a -> Maybe (TMap c b))
-> Map c (TMap c a) -> Map c (TMap c b)
forall a b. (a -> Maybe b) -> Map c a -> Map c b
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe (TMap c b -> Maybe (TMap c b)
forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap (TMap c b -> Maybe (TMap c b))
-> (TMap c a -> TMap c b) -> TMap c a -> Maybe (TMap c b)
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)) = (Node c b (TMap c b) -> TMap c b)
-> f (Node c b (TMap c b)) -> f (TMap c b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (f (Node c b (TMap c b)) -> f (TMap c b))
-> f (Node c b (TMap c b)) -> f (TMap c b)
forall a b. (a -> b) -> a -> b
$
        Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b))
-> f (Maybe b) -> f (Map c (TMap c b) -> Node c b (TMap c b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f (Maybe b)) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Maybe a -> f (Maybe b)
wither a -> f (Maybe b)
f Maybe a
ma f (Map c (TMap c b) -> Node c b (TMap c b))
-> f (Map c (TMap c b)) -> f (Node c b (TMap c b))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (TMap c a -> f (Maybe (TMap c b)))
-> Map c (TMap c a) -> f (Map c (TMap c b))
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Map c a -> f (Map c b)
wither ((TMap c b -> Maybe (TMap c b))
-> f (TMap c b) -> f (Maybe (TMap c b))
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TMap c b -> Maybe (TMap c b)
forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap (f (TMap c b) -> f (Maybe (TMap c b)))
-> (TMap c a -> f (TMap c b)) -> TMap c a -> f (Maybe (TMap c b))
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)) = Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
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 Maybe a -> (a -> Maybe b) -> Maybe b
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
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' = (c -> TMap c a -> Maybe (TMap c b))
-> Map c (TMap c a) -> Map c (TMap c b)
forall a b. (c -> a -> Maybe b) -> Map c a -> Map c b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe (\c
c TMap c a
t -> TMap c b -> Maybe (TMap c b)
forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap (TMap c b -> Maybe (TMap c b)) -> TMap c b -> Maybe (TMap c b)
forall a b. (a -> b) -> a -> b
$ ([c] -> a -> Maybe b) -> TMap c a -> TMap c b
forall a b. ([c] -> a -> Maybe b) -> TMap c a -> TMap c b
forall i (t :: * -> *) a b.
FilterableWithIndex i t =>
(i -> a -> Maybe b) -> t a -> t b
imapMaybe ([c] -> a -> Maybe b
f ([c] -> a -> Maybe b) -> ([c] -> [c]) -> [c] -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cc -> [c] -> [c]
forall 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)) = Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Node c b (TMap c b) -> TMap c b)
-> f (Node c b (TMap c b)) -> f (TMap c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b))
-> f (Maybe b) -> f (Map c (TMap c b) -> Node c b (TMap c b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Maybe b)
mb f (Map c (TMap c b) -> Node c b (TMap c b))
-> f (Map c (TMap c b)) -> f (Node c b (TMap c b))
forall a b. f (a -> b) -> f a -> f b
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 = (a -> f (Maybe b)) -> Maybe a -> f (Maybe b)
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f (Maybe b)) -> Maybe a -> f (Maybe b)
wither ([c] -> a -> f (Maybe b)
f []) Maybe a
ma
      edges' :: f (Map c (TMap c b))
edges' = (c -> TMap c a -> f (Maybe (TMap c b)))
-> Map c (TMap c a) -> f (Map c (TMap c b))
forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(c -> a -> f (Maybe b)) -> Map c a -> f (Map c 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 = TMap c b -> Maybe (TMap c b)
forall c a. TMap c a -> Maybe (TMap c a)
nonEmptyTMap (TMap c b -> Maybe (TMap c b))
-> f (TMap c b) -> f (Maybe (TMap c b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([c] -> a -> f (Maybe b)) -> TMap c a -> f (TMap c b)
forall i (t :: * -> *) (f :: * -> *) a b.
(WitherableWithIndex i t, Applicative f) =>
(i -> a -> f (Maybe b)) -> t a -> f (t b)
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 ([c] -> a -> f (Maybe b))
-> ([c] -> [c]) -> [c] -> a -> f (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c 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)) = Node c (These a b) (TMap c (These a b)) -> TMap c (These a b)
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe (These a b)
-> Map c (TMap c (These a b))
-> Node c (These a b) (TMap c (These a b))
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 = Maybe a -> Maybe b -> Maybe (These a b)
forall a b. Maybe a -> Maybe b -> Maybe (These a b)
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' = (These (TMap c a) (TMap c b) -> TMap c (These a b))
-> Map c (TMap c a)
-> Map c (TMap c b)
-> Map c (TMap c (These a b))
forall a b c. (These a b -> c) -> Map c a -> Map c b -> Map c c
forall (f :: * -> *) a b c.
Semialign f =>
(These a b -> c) -> f a -> f b -> f c
alignWith These (TMap c a) (TMap c b) -> TMap c (These a b)
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) = a -> These a b
forall a b. a -> These a b
This (a -> These a b) -> f a -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
t1
      subtree (That f b
t2) = b -> These a b
forall a b. b -> These a b
That (b -> These a b) -> f b -> f (These a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
t2
      subtree (These f a
t1 f b
t2) = f a -> f b -> f (These a b)
forall a b. f a -> f b -> f (These a b)
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 = TMap c a
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 = (a -> b -> Maybe c) -> TMap c a -> TMap c b -> TMap c c
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 -> c -> Maybe c
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)) = Node c c (TMap c c) -> TMap c c
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Node c c (TMap c c) -> TMap c c)
-> Maybe (Node c c (TMap c c)) -> Maybe (TMap c c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe c -> Map c (TMap c c) -> Node c c (TMap c c)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe c -> Map c (TMap c c) -> Node c c (TMap c c))
-> Maybe (Maybe c)
-> Maybe (Map c (TMap c c) -> Node c c (TMap c c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe c)
mc Maybe (Map c (TMap c c) -> Node c c (TMap c c))
-> Maybe (Map c (TMap c c)) -> Maybe (Node c c (TMap c c))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
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 = (a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe (Maybe c)
forall a b c.
(a -> b -> Maybe c) -> Maybe a -> Maybe b -> Maybe (Maybe c)
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' = (TMap c a -> TMap c b -> Maybe (TMap c c))
-> Map c (TMap c a) -> Map c (TMap c b) -> Maybe (Map c (TMap c c))
forall a b c.
(a -> b -> Maybe c) -> Map c a -> Map c b -> Maybe (Map c c)
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 c -> Map c (TMap c a) -> Maybe (TMap c a)
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 -> (Maybe a
forall a. Maybe a
Nothing, TMap c a
forall c a. TMap c a
empty)
    Just TMap c a
t' -> [c] -> TMap c a -> (Maybe a, TMap c a)
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 = (Maybe a, TMap c a) -> Maybe a
forall a b. (a, b) -> a
fst ((Maybe a, TMap c a) -> Maybe a)
-> (TMap c a -> (Maybe a, TMap c a)) -> TMap c a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> TMap c a -> (Maybe a, TMap c a)
forall c a. Ord c => [c] -> TMap c a -> (Maybe a, TMap c a)
match [c]
cs

-- | @lookupPrefixes xs tmap@ performs 'lookup' for every prefixes of the input string @xs@
--   and returns list of every pair of prefix and value exising in @tmap@.
--
-- ===== Example
-- 
-- >>> let x = fromList [("ham", 1), ("bacon", 2), ("hamburger", 3)]
-- >>> lookupPrefixes "hamburger and bacon" x
-- [("ham",1),("hamburger",3)]
lookupPrefixes :: (Ord c) => [c] -> TMap c a -> [([c], a)]
lookupPrefixes :: forall c a. Ord c => [c] -> TMap c a -> [([c], a)]
lookupPrefixes = [c] -> [c] -> TMap c a -> [([c], a)]
forall {a} {b}. Ord a => [a] -> [a] -> TMap a b -> [([a], b)]
go []
  where
    entry :: [a] -> Maybe b -> [([a], b)] -> [([a], b)]
entry [a]
revPrefix Maybe b
ma = case Maybe b
ma of
      Maybe b
Nothing -> [([a], b)] -> [([a], b)]
forall a. a -> a
id
      Just b
a -> (([a] -> [a]
forall a. [a] -> [a]
reverse [a]
revPrefix, b
a) ([a], b) -> [([a], b)] -> [([a], b)]
forall a. a -> [a] -> [a]
:)
    
    go :: [a] -> [a] -> TMap a b -> [([a], b)]
go [a]
revPrefix [] (TMap (Node Maybe b
ma Map a (TMap a b)
_)) = [a] -> Maybe b -> [([a], b)] -> [([a], b)]
forall {a} {b}. [a] -> Maybe b -> [([a], b)] -> [([a], b)]
entry [a]
revPrefix Maybe b
ma []
    go [a]
revPrefix (a
x:[a]
xs) (TMap (Node Maybe b
ma Map a (TMap a b)
e)) = [a] -> Maybe b -> [([a], b)] -> [([a], b)]
forall {a} {b}. [a] -> Maybe b -> [([a], b)] -> [([a], b)]
entry [a]
revPrefix Maybe b
ma ([([a], b)] -> [([a], b)]) -> [([a], b)] -> [([a], b)]
forall a b. (a -> b) -> a -> b
$
      case a -> Map a (TMap a b) -> Maybe (TMap a b)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup a
x Map a (TMap a b)
e of
        Maybe (TMap a b)
Nothing -> []
        Just TMap a b
rest -> [a] -> [a] -> TMap a b -> [([a], b)]
go (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
revPrefix) [a]
xs TMap a b
rest

member, notMember :: (Ord c) => [c] -> TMap c a -> Bool
member :: forall c a. Ord c => [c] -> TMap c a -> Bool
member [c]
cs = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (TMap c a -> Maybe a) -> TMap c a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> TMap c a -> Maybe a
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 = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe a -> Bool) -> (TMap c a -> Maybe a) -> TMap c a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> TMap c a -> Maybe a
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)) = Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& Map c (TMap c a) -> 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 = (Node c a Int -> Int) -> TMap c a -> Int
forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a Int -> Int
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) = (Int -> Int -> Int) -> Int -> Map c Int -> Int
forall b a. (b -> a -> b) -> b -> Map c a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
F.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) (Maybe a -> Int
forall a. Maybe a -> Int
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 = (Node c a [[c]] -> [[c]]) -> TMap c a -> [[c]]
forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a [[c]] -> [[c]]
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) =
      [ [] | Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
ma ] [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++
      [ a
ca -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
cs' | (a
c,[[a]]
css') <- Map a [[a]] -> [(a, [[a]])]
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 = (Node c a [a] -> [a]) -> TMap c a -> [a]
forall c a r. (Node c a r -> r) -> TMap c a -> r
foldTMap Node c a [a] -> [a]
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) = Maybe a -> [a]
forall a. Maybe a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Maybe a
ma [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ ([a] -> [a] -> [a]) -> [a] -> Map c [a] -> [a]
forall a b. (a -> b -> b) -> b -> Map c a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) [] Map c [a]
e

-- * Construction

-- | Empty @TMap@.
empty :: TMap c a
empty :: forall c a. TMap c a
empty = Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
forall a. Maybe a
Nothing Map c (TMap c a)
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 = Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (a -> Maybe a
forall a. a -> Maybe a
Just a
a) Map c (TMap c 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 = (c -> TMap c a -> TMap c a) -> TMap c a -> [c] -> TMap c a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr c -> TMap c a -> TMap c a
forall c a. c -> TMap c a -> TMap c a
cons (a -> TMap c a
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 = Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
forall a. Maybe a
Nothing (c -> TMap c a -> Map c (TMap c a)
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 = (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
forall c a. Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise (a -> Maybe a -> a
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 = (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
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 = (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
forall c a. Ord c => (Maybe a -> a) -> [c] -> TMap c a -> TMap c a
revise (a -> (a -> a) -> Maybe a -> a
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 = (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
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 = (c -> (TMap c a -> TMap c a) -> TMap c a -> TMap c a)
-> (TMap c a -> TMap c a) -> [c] -> TMap c a -> TMap c a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c -> (TMap c a -> TMap c a) -> TMap c a -> TMap c a
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)) = Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (a -> a
f (a -> a) -> Maybe a -> Maybe a
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' = (TMap c a -> TMap c a) -> c -> Map c (TMap c a) -> Map c (TMap c a)
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 Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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 = (TMap c a -> TMap c a, TMap c a) -> TMap c a -> TMap c a
forall a b. (a, b) -> a
fst ((TMap c a -> TMap c a, TMap c a) -> TMap c a -> TMap c a)
-> ([c] -> (TMap c a -> TMap c a, TMap c a))
-> [c]
-> TMap c a
-> TMap c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
 -> (TMap c a -> TMap c a, TMap c a)
 -> (TMap c a -> TMap c a, TMap c a))
-> (TMap c a -> TMap c a, TMap c a)
-> [c]
-> (TMap c a -> TMap c a, TMap c a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c
-> (TMap c a -> TMap c a, TMap c a)
-> (TMap c a -> TMap c a, TMap c a)
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, a -> TMap c a
forall a c. a -> TMap c a
just (Maybe a -> a
f Maybe a
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)) = Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (a -> Maybe a
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' = (TMap c a -> TMap c a -> TMap c a)
-> c -> TMap c a -> Map c (TMap c a) -> Map c (TMap c a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((TMap c a -> TMap c a) -> TMap c a -> TMap c a -> TMap c a
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 Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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, c -> TMap c a -> TMap c a
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 = TMap c a -> Maybe (TMap c a) -> TMap c a
forall a. a -> Maybe a -> a
fromMaybe TMap c a
forall c a. TMap c a
empty (Maybe (TMap c a) -> TMap c a)
-> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> TMap c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe a) -> [c] -> TMap c a -> Maybe (TMap c a)
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 = (c
 -> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a))
-> (TMap c a -> Maybe (TMap c a))
-> [c]
-> TMap c a
-> Maybe (TMap c a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c -> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
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 Maybe a -> (a -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe a
f
      in if Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma' Bool -> Bool -> Bool
&& Map c (TMap c a) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e
           then Maybe (TMap c a)
forall a. Maybe a
Nothing
           else TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
forall a b. (a -> b) -> a -> b
$ Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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' = (TMap c a -> Maybe (TMap c a))
-> c -> Map c (TMap c a) -> Map c (TMap c a)
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 Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& Map c (TMap c a) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e'
           then Maybe (TMap c a)
forall a. Maybe a
Nothing
           else TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
forall a b. (a -> b) -> a -> b
$ Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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 Maybe a
forall a. Maybe a
Nothing of
    Maybe a
Nothing -> (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
forall c a. Ord c => (a -> Maybe a) -> [c] -> TMap c a -> TMap c a
update (Maybe a -> Maybe a
f (Maybe a -> Maybe a) -> (a -> Maybe a) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just)
    Just a
f0 -> \[c]
cs -> TMap c a -> Maybe (TMap c a) -> TMap c a
forall a. a -> Maybe a -> a
fromMaybe TMap c a
forall c a. TMap c a
empty (Maybe (TMap c a) -> TMap c a)
-> (TMap c a -> Maybe (TMap c a)) -> TMap c a -> TMap c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Maybe a) -> a -> [c] -> TMap c a -> Maybe (TMap c a)
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 = (TMap c a -> Maybe (TMap c a), TMap c a)
-> TMap c a -> Maybe (TMap c a)
forall a b. (a, b) -> a
fst ((TMap c a -> Maybe (TMap c a), TMap c a)
 -> TMap c a -> Maybe (TMap c a))
-> ([c] -> (TMap c a -> Maybe (TMap c a), TMap c a))
-> [c]
-> TMap c a
-> Maybe (TMap c a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
 -> (TMap c a -> Maybe (TMap c a), TMap c a)
 -> (TMap c a -> Maybe (TMap c a), TMap c a))
-> (TMap c a -> Maybe (TMap c a), TMap c a)
-> [c]
-> (TMap c a -> Maybe (TMap c a), TMap c a)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c
-> (TMap c a -> Maybe (TMap c a), TMap c a)
-> (TMap c a -> Maybe (TMap c a), TMap c a)
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, a -> TMap c a
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 Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma' Bool -> Bool -> Bool
&& Map c (TMap c a) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e
           then Maybe (TMap c a)
forall a. Maybe a
Nothing
           else TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
forall a b. (a -> b) -> a -> b
$ Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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' = (Maybe (TMap c a) -> Maybe (TMap c a))
-> c -> Map c (TMap c a) -> Map c (TMap c a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Maybe (TMap c a)
-> (TMap c a -> Maybe (TMap c a))
-> Maybe (TMap c a)
-> Maybe (TMap c a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TMap c a -> Maybe (TMap c a)
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 Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
ma Bool -> Bool -> Bool
&& Map c (TMap c a) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
e'
                 then Maybe (TMap c a)
forall a. Maybe a
Nothing
                 else TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
forall a b. (a -> b) -> a -> b
$ Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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, c -> TMap c a -> TMap c a
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 = (a -> a -> a) -> 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 a -> a -> a
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) -> Maybe a
forall a. Maybe a
Nothing
            (Just a
at, Maybe a
Nothing) -> a -> Maybe a
forall a. a -> Maybe a
Just a
at
            (Maybe a
Nothing, Just a
au) -> a -> Maybe a
forall a. a -> Maybe a
Just a
au
            (Just a
at, Just a
au) -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
f a
at a
au)
          ez :: Map c (TMap c a)
ez = (TMap c a -> TMap c a -> TMap c a)
-> Map c (TMap c a) -> Map c (TMap c a) -> Map c (TMap c a)
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 Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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 = (a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
forall c a b r.
Ord c =>
(a -> b -> Maybe r) -> TMap c a -> TMap c b -> TMap c r
intersectionWith (\a
a b
_ -> a -> Maybe a
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 = TMap c r -> Maybe (TMap c r) -> TMap c r
forall a. a -> Maybe a -> a
fromMaybe TMap c r
forall c a. TMap c a
empty (Maybe (TMap c r) -> TMap c r) -> Maybe (TMap c r) -> TMap c r
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 Maybe r -> Bool
forall a. Maybe a -> Bool
isNothing Maybe r
mr Bool -> Bool -> Bool
&& Map c (TMap c r) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c r)
ez
        then Maybe (TMap c r)
forall a. Maybe a
Nothing
        else TMap c r -> Maybe (TMap c r)
forall a. a -> Maybe a
Just (TMap c r -> Maybe (TMap c r)) -> TMap c r -> Maybe (TMap c r)
forall a b. (a -> b) -> a -> b
$ Node c r (TMap c r) -> TMap c r
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe r -> Map c (TMap c r) -> Node c r (TMap c r)
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 = (TMap c a -> TMap c b -> Maybe (TMap c r))
-> Map c (TMap c a) -> Map c (TMap c b) -> Map c (Maybe (TMap c r))
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 = (Maybe (TMap c r) -> Maybe (TMap c r))
-> Map c (Maybe (TMap c r)) -> Map c (TMap c r)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe (TMap c r) -> Maybe (TMap c r)
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 = (a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
forall c a b.
Ord c =>
(a -> b -> Maybe a) -> TMap c a -> TMap c b -> TMap c a
differenceWith (\a
_ b
_ -> Maybe a
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 = TMap c a -> Maybe (TMap c a) -> TMap c a
forall a. a -> Maybe a -> a
fromMaybe TMap c a
forall c a. TMap c a
empty (Maybe (TMap c a) -> TMap c a) -> Maybe (TMap c a) -> TMap c a
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 Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
mr Bool -> Bool -> Bool
&& Map c (TMap c a) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c a)
ez
        then Maybe (TMap c a)
forall a. Maybe a
Nothing
        else TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just (TMap c a -> Maybe (TMap c a)) -> TMap c a -> Maybe (TMap c a)
forall a b. (a -> b) -> a -> b
$ Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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
_)       -> Maybe a
forall a. Maybe a
Nothing
          (Just a
a,  Maybe b
Nothing) -> a -> Maybe a
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 = (TMap c a -> TMap c b -> Maybe (TMap c a))
-> Map c (TMap c a) -> Map c (TMap c b) -> Map c (TMap c a)
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))
  | Map c (TMap c y) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TMap c y)
ey = case Maybe y
my of
      Maybe y
Nothing -> TMap c z
forall c a. TMap c a
empty
      Just y
y  -> (x -> z) -> TMap c x -> TMap c z
forall a b. (a -> b) -> TMap c a -> TMap c b
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)) = Node c z (TMap c z) -> TMap c z
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe z -> Map c (TMap c z) -> Node c z (TMap c z)
forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe z
forall a. Maybe a
Nothing ((TMap c x -> TMap c z) -> Map c (TMap c x) -> Map c (TMap c z)
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 (y -> z) -> Maybe y -> Maybe z
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe y
my
            ex' :: Map c (TMap c z)
ex' = (TMap c x -> TMap c z) -> Map c (TMap c x) -> Map c (TMap c z)
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' = (TMap c y -> TMap c z) -> Map c (TMap c y) -> Map c (TMap c z)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map ((y -> z) -> TMap c y -> TMap c z
forall a b. (a -> b) -> TMap c a -> TMap c b
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 = (TMap c z -> TMap c z -> TMap c z)
-> Map c (TMap c z) -> Map c (TMap c z) -> Map c (TMap c z)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((z -> z -> z) -> TMap c z -> TMap c z -> TMap c z
forall c a.
Ord c =>
(a -> a -> a) -> TMap c a -> TMap c a -> TMap c a
unionWith z -> z -> z
forall a. Semigroup a => a -> a -> a
(<>)) Map c (TMap c z)
ey' Map c (TMap c z)
ex'
        in Node c z (TMap c z) -> TMap c z
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe z -> Map c (TMap c z) -> Node c z (TMap c z)
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)) = Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node ((a -> b) -> Maybe a -> Maybe b
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
ma) ((TMap c a -> TMap c b) -> Map c (TMap c a) -> Map c (TMap c b)
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 = (a -> b -> b) -> b -> [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 a -> b -> b
f b
z ([a] -> b) -> (TMap c a -> [a]) -> TMap c a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMap c a -> [a]
forall c a. TMap c a -> [a]
elems
  toList :: forall a. TMap c a -> [a]
toList = TMap c a -> [a]
forall c a. TMap c a -> [a]
elems
  null :: forall a. TMap c a -> Bool
null = TMap c a -> Bool
forall c a. TMap c a -> Bool
Data.Trie.Map.Hidden.null
  length :: forall a. TMap c a -> Int
length = TMap c a -> Int
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 = ([c] -> a -> f b) -> TMap c a -> f (TMap c b)
forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey ((a -> f b) -> [c] -> a -> f b
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
(<>) = (a -> a -> a) -> 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 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)
  stimes :: forall b. Integral b => b -> TMap c a -> TMap c a
stimes b
n = (a -> a) -> TMap c a -> TMap c a
forall a b. (a -> b) -> TMap c a -> TMap c b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> a -> a
forall b. Integral b => b -> a -> a
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 = TMap c a
forall c a. TMap c a
empty
  mappend :: TMap c a -> TMap c a -> TMap c a
mappend = TMap c a -> TMap c a -> TMap c a
forall a. Semigroup a => a -> a -> a
(<>)

-- * Conversion

toList :: TMap c a -> [([c], a)]
toList :: forall c a. TMap c a -> [([c], a)]
toList = ([c] -> a -> [([c], a)] -> [([c], a)])
-> [([c], a)] -> TMap c a -> [([c], a)]
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) ([c], a) -> [([c], a)] -> [([c], 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 = (TMap c a -> ([c], a) -> TMap c a)
-> TMap c a -> [([c], a)] -> TMap c a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((([c], a) -> TMap c a -> TMap c a)
-> TMap c a -> ([c], a) -> TMap c a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([c] -> a -> TMap c a -> TMap c a)
-> ([c], a) -> TMap c a -> TMap c a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [c] -> a -> TMap c a -> TMap c a
forall c a. Ord c => [c] -> a -> TMap c a -> TMap c a
insert)) TMap c a
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 = (TMap c a -> ([c], a) -> TMap c a)
-> TMap c a -> [([c], a)] -> TMap c a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((([c], a) -> TMap c a -> TMap c a)
-> TMap c a -> ([c], a) -> TMap c a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([c] -> a -> TMap c a -> TMap c a)
-> ([c], a) -> TMap c a -> TMap c a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a
forall c a.
Ord c =>
(a -> a -> a) -> [c] -> a -> TMap c a -> TMap c a
insertWith a -> a -> a
op))) TMap c a
forall c a. TMap c a
empty

toAscList :: TMap c a -> [([c], a)]
toAscList :: forall c a. TMap c a -> [([c], a)]
toAscList = TMap c a -> [([c], a)]
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 [] = TMap c a
forall c a. TMap c a
empty
fromAscList [([c]
cs, a
a)] = [c] -> a -> TMap c 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) = [([c], a)] -> ([a], [(c, [([c], a)])])
forall c a. Eq c => [([c], a)] -> ([a], [(c, [([c], a)])])
group_ [([c], a)]
pairs
      ma :: Maybe a
ma = NonEmpty a -> a
forall a. NonEmpty a -> a
NE.last (NonEmpty a -> a) -> Maybe (NonEmpty a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
as
      e :: Map c (TMap c a)
e = [(c, TMap c a)] -> Map c (TMap c a)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(c, TMap c a)] -> Map c (TMap c a))
-> [(c, TMap c a)] -> Map c (TMap c a)
forall a b. (a -> b) -> a -> b
$ ((c, [([c], a)]) -> (c, TMap c a))
-> [(c, [([c], a)])] -> [(c, TMap c a)]
forall a b. (a -> b) -> [a] -> [b]
map (([([c], a)] -> TMap c a) -> (c, [([c], a)]) -> (c, TMap c a)
forall a b. (a -> b) -> (c, a) -> (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [([c], a)] -> TMap c a
forall c a. Eq c => [([c], a)] -> TMap c a
fromAscList) [(c, [([c], a)])]
gs
  in Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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) = (a -> a -> a) -> a -> [a] -> a
forall b a. (b -> a -> b) -> b -> [a] -> b
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
_ [] = TMap c a
forall c a. TMap c a
empty
fromAscListWith a -> a -> a
op [([c], a)]
pairs =
  let ([a]
as, [(c, [([c], a)])]
gs) = [([c], a)] -> ([a], [(c, [([c], a)])])
forall c a. Eq c => [([c], a)] -> ([a], [(c, [([c], a)])])
group_ [([c], a)]
pairs
      ma :: Maybe a
ma = (a -> a -> a) -> NonEmpty a -> a
forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1' ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
op) (NonEmpty a -> a) -> Maybe (NonEmpty a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> Maybe (NonEmpty a)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty [a]
as
      e :: Map c (TMap c a)
e = [(c, TMap c a)] -> Map c (TMap c a)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(c, TMap c a)] -> Map c (TMap c a))
-> [(c, TMap c a)] -> Map c (TMap c a)
forall a b. (a -> b) -> a -> b
$ ((c, [([c], a)]) -> (c, TMap c a))
-> [(c, [([c], a)])] -> [(c, TMap c a)]
forall a b. (a -> b) -> [a] -> [b]
map (([([c], a)] -> TMap c a) -> (c, [([c], a)]) -> (c, TMap c a)
forall a b. (a -> b) -> (c, a) -> (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a -> a) -> [([c], a)] -> TMap c a
forall c a. Ord c => (a -> a -> a) -> [([c], a)] -> TMap c a
fromAscListWith a -> a -> a
op)) [(c, [([c], a)])]
gs
  in Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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_ = (([c], a) -> ([a], [(c, [([c], a)])]) -> ([a], [(c, [([c], a)])]))
-> ([a], [(c, [([c], a)])])
-> [([c], a)]
-> ([a], [(c, [([c], a)])])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([c], a) -> ([a], [(c, [([c], a)])]) -> ([a], [(c, [([c], a)])])
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 b -> [b] -> [b]
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, a -> [a] -> b -> [(a, [([a], b)])] -> [(a, [([a], b)])]
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d  -> (a
d, (a
cs,b
a)(a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
:[(a, b)]
ps')(a, [(a, b)]) -> [(a, [(a, b)])] -> [(a, [(a, b)])]
forall a. a -> [a] -> [a]
:[(a, [(a, b)])]
rest
      [(a, [(a, b)])]
_                      -> (a
c, [(a
cs,b
a)])(a, [(a, b)]) -> [(a, [(a, b)])] -> [(a, [(a, b)])]
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 = [([c], a)] -> Map [c] a
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([([c], a)] -> Map [c] a)
-> (TMap c a -> [([c], a)]) -> TMap c a -> Map [c] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMap c a -> [([c], a)]
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 = [([c], a)] -> TMap c a
forall c a. Eq c => [([c], a)] -> TMap c a
fromAscList ([([c], a)] -> TMap c a)
-> (Map [c] a -> [([c], a)]) -> Map [c] a -> TMap c a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map [c] a -> [([c], a)]
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)) =
    Node c (TSet c) -> TSet c
forall c. Node c (TSet c) -> TSet c
TSet (Bool -> Map c (TSet c) -> Node c (TSet c)
forall c r. Bool -> Map c r -> Node c r
TSet.Node (Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
ma) ((TMap c a -> TSet c) -> Map c (TMap c a) -> Map c (TSet c)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TMap c a -> TSet c
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' = (c -> TSet c -> TMap c a) -> Map c (TSet c) -> Map c (TMap c a)
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
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
q)) Map c (TSet c)
e
          a' :: Maybe a
a' = if Bool
a then a -> Maybe a
forall a. a -> Maybe a
Just ([c] -> a
f ([c] -> [c]
forall a. [a] -> [a]
reverse [c]
q)) else Maybe a
forall a. Maybe a
Nothing
      in Node c a (TMap c a) -> TMap c a
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Maybe a -> Map c (TMap c a) -> Node c a (TMap c a)
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 = (Node c a (f ([c'], a)) -> f ([c'], a)) -> TMap c a -> f ([c'], a)
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) =
      f ([c'], a) -> (a -> f ([c'], a)) -> Maybe a -> f ([c'], a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f ([c'], a)
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
Ap.empty (\a
a -> ([], a
a) ([c'], a) -> f eot -> f ([c'], a)
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f eot
eot) Maybe a
ma f ([c'], a) -> f ([c'], a) -> f ([c'], a)
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      [f ([c'], a)] -> f ([c'], a)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ c' -> ([c'], a) -> ([c'], a)
forall {a} {b}. a -> ([a], b) -> ([a], b)
consFst (c' -> ([c'], a) -> ([c'], a))
-> f c' -> f (([c'], a) -> ([c'], a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f c'
f c
c f (([c'], a) -> ([c'], a)) -> f ([c'], a) -> f ([c'], a)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f ([c'], a)
p' | (c
c, f ([c'], a)
p') <- Map c (f ([c'], a)) -> [(c, f ([c'], a))]
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
ca -> [a] -> [a]
forall 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 = (Node c a (f a) -> f a) -> TMap c a -> f a
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) =
      f a -> (a -> f a) -> Maybe a -> f a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe f a
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
Ap.empty (a -> f eot -> f a
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f eot
eot) Maybe a
ma f a -> f a -> f a
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> 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 f c' -> f a -> f a
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f a
p' | (c
c, f a
p') <- Map c (f a) -> [(c, f a)]
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 = f a -> f ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (f a -> f ()) -> (TMap c a -> f a) -> TMap c a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> f c') -> f eot -> TMap c a -> f a
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)) = Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Node c b (TMap c b) -> TMap c b)
-> (Map c (TMap c b) -> Node c b (TMap c b))
-> Map c (TMap c b)
-> TMap c b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe b
forall a. Maybe a
Nothing (Map c (TMap c b) -> TMap c b)
-> f (Map c (TMap c b)) -> f (TMap c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (c -> TMap c a -> f (TMap c b))
-> Map c (TMap c a) -> f (Map c (TMap c 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' -> ([c] -> a -> f b) -> TMap c a -> f (TMap c b)
forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey ([c] -> a -> f b
f ([c] -> a -> f b) -> ([c] -> [c]) -> [c] -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cc -> [c] -> [c]
forall 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)) = (Node c b (TMap c b) -> TMap c b)
-> f (Node c b (TMap c b)) -> f (TMap c b)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (f (Node c b (TMap c b)) -> f (TMap c b))
-> f (Node c b (TMap c b)) -> f (TMap c b)
forall a b. (a -> b) -> a -> b
$ Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node (Maybe b -> Map c (TMap c b) -> Node c b (TMap c b))
-> f (Maybe b) -> f (Map c (TMap c b) -> Node c b (TMap c b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> f b -> f (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [c] -> a -> f b
f [] a
a) f (Map c (TMap c b) -> Node c b (TMap c b))
-> f (Map c (TMap c b)) -> f (Node c b (TMap c b))
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (c -> TMap c a -> f (TMap c b))
-> Map c (TMap c a) -> f (Map c (TMap c 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' -> ([c] -> a -> f b) -> TMap c a -> f (TMap c b)
forall (f :: * -> *) c a b.
Applicative f =>
([c] -> a -> f b) -> TMap c a -> f (TMap c b)
traverseWithKey ([c] -> a -> f b
f ([c] -> a -> f b) -> ([c] -> [c]) -> [c] -> a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cc -> [c] -> [c]
forall 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)) = Node c b (TMap c b) -> TMap c b
forall c a. Node c a (TMap c a) -> TMap c a
TMap (Node c b (TMap c b) -> TMap c b)
-> Node c b (TMap c b) -> TMap c b
forall a b. (a -> b) -> a -> b
$ Maybe b -> Map c (TMap c b) -> Node c b (TMap c b)
forall c a r. Maybe a -> Map c r -> Node c a r
Node ([c] -> a -> b
f [] (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe a
ma) ((c -> TMap c a -> TMap c b) -> Map c (TMap c a) -> Map c (TMap c b)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey (\c
c TMap c a
t' -> ([c] -> a -> b) -> TMap c a -> TMap c b
forall c a b. ([c] -> a -> b) -> TMap c a -> TMap c b
mapWithKey ([c] -> a -> b
f ([c] -> a -> b) -> ([c] -> [c]) -> [c] -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cc -> [c] -> [c]
forall 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 = ([c] -> a -> r -> r) -> r -> TMap c a -> r
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 r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
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 = (c -> TMap c a -> r -> r) -> r -> Map c (TMap c a) -> r
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\c
c TMap c a
subTrie r
s ->
          ([c] -> a -> r -> r) -> r -> TMap c a -> r
forall c a b. ([c] -> a -> b -> b) -> b -> TMap c a -> b
foldrWithKey ([c] -> a -> r -> r
f ([c] -> a -> r -> r) -> ([c] -> [c]) -> [c] -> a -> r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
cc -> [c] -> [c]
forall 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 (Maybe a -> Map c r -> Node c a r
forall c a r. Maybe a -> Map c r -> Node c a r
Node Maybe a
a (TMap c a -> r
go (TMap c a -> r) -> Map c (TMap c a) -> Map c r
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
  | TMap c a -> Bool
forall c a. TMap c a -> Bool
null TMap c a
t = Maybe (TMap c a)
forall a. Maybe a
Nothing
  | Bool
otherwise = TMap c a -> Maybe (TMap c a)
forall a. a -> Maybe a
Just TMap c a
t