{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Trie.Set.Hidden(
TSet(..),
member, notMember,
beginWith,
null, count, enumerate,
foldr, foldMap, foldl',
empty, epsilon,
singleton,
insert, delete,
union, intersection, difference,
append,
prefixes, suffixes, infixes,
fromList, toList,
fromAscList, toAscList,
fromSet, toSet,
toParser, toParser_,
Node(..),
foldTSet, paraTSet
)
where
import Prelude hiding (Foldable(..))
import Control.Applicative hiding (empty)
import qualified Control.Applicative as Ap
import Data.Semigroup
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import qualified Data.List as List (foldr, foldl')
import Data.Maybe (fromMaybe)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Arrow ((&&&))
import Control.DeepSeq
import Data.Functor.Classes
import Text.Show (showListWith)
import qualified GHC.Exts
import Data.Hashable.Lifted
import Data.Hashable
data Node c r = Node !Bool !(Map c r)
deriving (Int -> Node c r -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c r. (Show c, Show r) => Int -> Node c r -> ShowS
forall c r. (Show c, Show r) => [Node c r] -> ShowS
forall c r. (Show c, Show r) => Node c r -> String
showList :: [Node c r] -> ShowS
$cshowList :: forall c r. (Show c, Show r) => [Node c r] -> ShowS
show :: Node c r -> String
$cshow :: forall c r. (Show c, Show r) => Node c r -> String
showsPrec :: Int -> Node c r -> ShowS
$cshowsPrec :: forall c r. (Show c, Show r) => Int -> Node c r -> ShowS
Show, Node c r -> Node c r -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c r. (Eq c, Eq r) => Node c r -> Node c r -> Bool
/= :: Node c r -> Node c r -> Bool
$c/= :: forall c r. (Eq c, Eq r) => Node c r -> Node c r -> Bool
== :: Node c r -> Node c r -> Bool
$c== :: forall c r. (Eq c, Eq r) => Node c r -> Node c r -> Bool
Eq, Node c r -> Node c r -> Bool
Node c r -> Node c r -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {c} {r}. (Ord c, Ord r) => Eq (Node c r)
forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Bool
forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Ordering
forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Node c r
min :: Node c r -> Node c r -> Node c r
$cmin :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Node c r
max :: Node c r -> Node c r -> Node c r
$cmax :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Node c r
>= :: Node c r -> Node c r -> Bool
$c>= :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Bool
> :: Node c r -> Node c r -> Bool
$c> :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Bool
<= :: Node c r -> Node c r -> Bool
$c<= :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Bool
< :: Node c r -> Node c r -> Bool
$c< :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Bool
compare :: Node c r -> Node c r -> Ordering
$ccompare :: forall c r. (Ord c, Ord r) => Node c r -> Node c r -> Ordering
Ord, forall a b. a -> Node c b -> Node c a
forall a b. (a -> b) -> Node c a -> Node c b
forall c a b. a -> Node c b -> Node c a
forall c a b. (a -> b) -> Node c a -> Node c b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Node c b -> Node c a
$c<$ :: forall c a b. a -> Node c b -> Node c a
fmap :: forall a b. (a -> b) -> Node c a -> Node c b
$cfmap :: forall c a b. (a -> b) -> Node c a -> Node c b
Functor, forall a. Node c a -> Bool
forall c a. Eq a => a -> Node c a -> Bool
forall c a. Num a => Node c a -> a
forall c a. Ord a => Node c a -> a
forall m a. Monoid m => (a -> m) -> Node c a -> m
forall c m. Monoid m => Node c m -> m
forall c a. Node c a -> Bool
forall c a. Node c a -> Int
forall c a. Node c a -> [a]
forall a b. (a -> b -> b) -> b -> Node c a -> b
forall c a. (a -> a -> a) -> Node c a -> a
forall c m a. Monoid m => (a -> m) -> Node c a -> m
forall c b a. (b -> a -> b) -> b -> Node c a -> b
forall c a b. (a -> b -> b) -> b -> Node c a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Node c a -> a
$cproduct :: forall c a. Num a => Node c a -> a
sum :: forall a. Num a => Node c a -> a
$csum :: forall c a. Num a => Node c a -> a
minimum :: forall a. Ord a => Node c a -> a
$cminimum :: forall c a. Ord a => Node c a -> a
maximum :: forall a. Ord a => Node c a -> a
$cmaximum :: forall c a. Ord a => Node c a -> a
elem :: forall a. Eq a => a -> Node c a -> Bool
$celem :: forall c a. Eq a => a -> Node c a -> Bool
length :: forall a. Node c a -> Int
$clength :: forall c a. Node c a -> Int
null :: forall a. Node c a -> Bool
$cnull :: forall c a. Node c a -> Bool
toList :: forall a. Node c a -> [a]
$ctoList :: forall c a. Node c a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Node c a -> a
$cfoldl1 :: forall c a. (a -> a -> a) -> Node c a -> a
foldr1 :: forall a. (a -> a -> a) -> Node c a -> a
$cfoldr1 :: forall c a. (a -> a -> a) -> Node c a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Node c a -> b
$cfoldl' :: forall c b a. (b -> a -> b) -> b -> Node c a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Node c a -> b
$cfoldl :: forall c b a. (b -> a -> b) -> b -> Node c a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Node c a -> b
$cfoldr' :: forall c a b. (a -> b -> b) -> b -> Node c a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Node c a -> b
$cfoldr :: forall c a b. (a -> b -> b) -> b -> Node c a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Node c a -> m
$cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Node c a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Node c a -> m
$cfoldMap :: forall c m a. Monoid m => (a -> m) -> Node c a -> m
fold :: forall m. Monoid m => Node c m -> m
$cfold :: forall c m. Monoid m => Node c m -> m
Foldable, forall c. Functor (Node c)
forall c. Foldable (Node c)
forall c (m :: * -> *) a. Monad m => Node c (m a) -> m (Node c a)
forall c (f :: * -> *) a.
Applicative f =>
Node c (f a) -> f (Node c a)
forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a -> m (Node c b)
forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a -> f (Node c b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a -> f (Node c b)
sequence :: forall (m :: * -> *) a. Monad m => Node c (m a) -> m (Node c a)
$csequence :: forall c (m :: * -> *) a. Monad m => Node c (m a) -> m (Node c a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a -> m (Node c b)
$cmapM :: forall c (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Node c a -> m (Node c b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Node c (f a) -> f (Node c a)
$csequenceA :: forall c (f :: * -> *) a.
Applicative f =>
Node c (f a) -> f (Node c a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a -> f (Node c b)
$ctraverse :: forall c (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Node c a -> f (Node c b)
Traversable)
instance (NFData c, NFData r) => NFData (Node c r) where
rnf :: Node c r -> ()
rnf (Node Bool
a Map c r
e) = forall a. NFData a => a -> ()
rnf Bool
a seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf Map c r
e
newtype TSet c = TSet { forall c. TSet c -> Node c (TSet c)
getNode :: Node c (TSet c) }
deriving (TSet c -> TSet c -> Bool
forall c. Eq c => TSet c -> TSet c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TSet c -> TSet c -> Bool
$c/= :: forall c. Eq c => TSet c -> TSet c -> Bool
== :: TSet c -> TSet c -> Bool
$c== :: forall c. Eq c => TSet c -> TSet c -> Bool
Eq, TSet c -> TSet c -> Bool
TSet c -> TSet c -> Ordering
TSet c -> TSet c -> TSet c
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}. Ord c => Eq (TSet c)
forall c. Ord c => TSet c -> TSet c -> Bool
forall c. Ord c => TSet c -> TSet c -> Ordering
forall c. Ord c => TSet c -> TSet c -> TSet c
min :: TSet c -> TSet c -> TSet c
$cmin :: forall c. Ord c => TSet c -> TSet c -> TSet c
max :: TSet c -> TSet c -> TSet c
$cmax :: forall c. Ord c => TSet c -> TSet c -> TSet c
>= :: TSet c -> TSet c -> Bool
$c>= :: forall c. Ord c => TSet c -> TSet c -> Bool
> :: TSet c -> TSet c -> Bool
$c> :: forall c. Ord c => TSet c -> TSet c -> Bool
<= :: TSet c -> TSet c -> Bool
$c<= :: forall c. Ord c => TSet c -> TSet c -> Bool
< :: TSet c -> TSet c -> Bool
$c< :: forall c. Ord c => TSet c -> TSet c -> Bool
compare :: TSet c -> TSet c -> Ordering
$ccompare :: forall c. Ord c => TSet c -> TSet c -> Ordering
Ord)
instance Show1 TSet where
liftShowsPrec :: forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> TSet a -> ShowS
liftShowsPrec Int -> a -> ShowS
_ [a] -> ShowS
showListC Int
p TSet a
t = Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"fromList " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> ShowS) -> [a] -> ShowS
showListWith [a] -> ShowS
showListC (forall c. TSet c -> [[c]]
enumerate TSet a
t)
instance Show c => Show (TSet c) where
showsPrec :: Int -> TSet c -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
instance (NFData c) => NFData (TSet c) where
rnf :: TSet c -> ()
rnf (TSet Node c (TSet c)
node) = forall a. NFData a => a -> ()
rnf Node c (TSet c)
node
instance (Ord c) => GHC.Exts.IsList (TSet c) where
type Item (TSet c) = [c]
fromList :: [Item (TSet c)] -> TSet c
fromList = forall c. Ord c => [[c]] -> TSet c
fromList
toList :: TSet c -> [Item (TSet c)]
toList = forall c. TSet c -> [[c]]
toList
instance Eq1 TSet where
liftEq :: forall a b. (a -> b -> Bool) -> TSet a -> TSet b -> Bool
liftEq a -> b -> Bool
eq = TSet a -> TSet b -> Bool
go
where
go :: TSet a -> TSet b -> Bool
go (TSet (Node Bool
a1 Map a (TSet a)
e1)) (TSet (Node Bool
a2 Map b (TSet b)
e2)) = Bool
a1 forall a. Eq a => a -> a -> Bool
== Bool
a2 Bool -> Bool -> Bool
&& forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
eq TSet a -> TSet b -> Bool
go Map a (TSet a)
e1 Map b (TSet b)
e2
instance Ord1 TSet where
liftCompare :: forall a b. (a -> b -> Ordering) -> TSet a -> TSet b -> Ordering
liftCompare a -> b -> Ordering
cmp = TSet a -> TSet b -> Ordering
go
where
go :: TSet a -> TSet b -> Ordering
go (TSet (Node Bool
a1 Map a (TSet a)
e1)) (TSet (Node Bool
a2 Map b (TSet b)
e2)) = forall a. Ord a => a -> a -> Ordering
compare Bool
a1 Bool
a2 forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
cmp TSet a -> TSet b -> Ordering
go Map a (TSet a)
e1 Map b (TSet b)
e2
instance Hashable c => Hashable (TSet c) where
hashWithSalt :: Int -> TSet c -> Int
hashWithSalt = forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt forall a. Hashable a => Int -> a -> Int
hashWithSalt
instance Hashable1 TSet where
liftHashWithSalt :: forall a. (Int -> a -> Int) -> Int -> TSet a -> Int
liftHashWithSalt Int -> a -> Int
hashC = Int -> TSet a -> Int
go
where
go :: Int -> TSet a -> Int
go Int
s (TSet (Node Bool
a Map a (TSet a)
e)) = forall (t :: * -> * -> *) a b.
Hashable2 t =>
(Int -> a -> Int) -> (Int -> b -> Int) -> Int -> t a b -> Int
liftHashWithSalt2 Int -> a -> Int
hashC Int -> TSet a -> Int
go (Int
s forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Bool
a) Map a (TSet a)
e
instance (Ord c) => Semigroup (TSet c) where
<> :: TSet c -> TSet c -> TSet c
(<>) = forall c. Ord c => TSet c -> TSet c -> TSet c
union
stimes :: forall b. Integral b => b -> TSet c -> TSet c
stimes = forall b a. Integral b => b -> a -> a
stimesIdempotent
instance (Ord c) => Monoid (TSet c) where
mempty :: TSet c
mempty = forall c. TSet c
empty
mappend :: TSet c -> TSet c -> TSet c
mappend = forall a. Semigroup a => a -> a -> a
(<>)
member :: (Ord c) => [c] -> TSet c -> Bool
member :: forall c. Ord c => [c] -> TSet c -> Bool
member [] (TSet (Node Bool
a Map c (TSet c)
_)) = Bool
a
member (c
c:[c]
cs) (TSet (Node Bool
_ Map c (TSet c)
e)) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c Map c (TSet c)
e of
Maybe (TSet c)
Nothing -> Bool
False
Just TSet c
t' -> forall c. Ord c => [c] -> TSet c -> Bool
member [c]
cs TSet c
t'
notMember :: (Ord c) => [c] -> TSet c -> Bool
notMember :: forall c. Ord c => [c] -> TSet c -> Bool
notMember [c]
cs = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Ord c => [c] -> TSet c -> Bool
member [c]
cs
beginWith :: (Ord c) => TSet c -> [c] -> TSet c
beginWith :: forall c. Ord c => TSet c -> [c] -> TSet c
beginWith TSet c
t [] = TSet c
t
beginWith (TSet (Node Bool
_ Map c (TSet c)
e)) (c
c:[c]
cs) =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup c
c Map c (TSet c)
e of
Maybe (TSet c)
Nothing -> forall c. TSet c
empty
Just TSet c
t' -> forall c. Ord c => TSet c -> [c] -> TSet c
beginWith TSet c
t' [c]
cs
null :: TSet c -> Bool
null :: forall c. TSet c -> Bool
null (TSet (Node Bool
a Map c (TSet c)
e)) = Bool -> Bool
not Bool
a Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TSet c)
e
count :: TSet c -> Int
count :: forall c. TSet c -> Int
count = forall c r. (Node c r -> r) -> TSet c -> r
foldTSet forall {a} {c}. Num a => Node c a -> a
count'
where
count' :: Node c a -> a
count' (Node Bool
a Map c a
e) =
(if Bool
a then a
1 else a
0) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
F.sum Map c a
e
enumerate :: TSet c -> [[c]]
enumerate :: forall c. TSet c -> [[c]]
enumerate = forall c r. ([c] -> r -> r) -> r -> TSet c -> r
foldr (:) []
foldr :: ([c] -> r -> r) -> r -> TSet c -> r
foldr :: forall c r. ([c] -> r -> r) -> r -> TSet c -> r
foldr [c] -> r -> r
f r
z (TSet (Node Bool
a Map c (TSet c)
e))
| Bool
a = [c] -> r -> r
f [] r
r
| Bool
otherwise = r
r
where
r :: r
r = forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\c
x TSet c
tr r
xs -> forall c r. ([c] -> r -> r) -> r -> TSet c -> r
foldr ([c] -> r -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) c
x) r
xs TSet c
tr) r
z Map c (TSet c)
e
foldMap :: (Monoid r) => ([c] -> r) -> TSet c -> r
foldMap :: forall r c. Monoid r => ([c] -> r) -> TSet c -> r
foldMap [c] -> r
f (TSet (Node Bool
a Map c (TSet c)
e))
| Bool
a = [c] -> r
f [] forall a. Monoid a => a -> a -> a
`mappend` r
r
| Bool
otherwise = r
r
where
r :: r
r = forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\c
c TSet c
subTrie ->
forall r c. Monoid r => ([c] -> r) -> TSet c -> r
foldMap ([c] -> r
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c forall a. a -> [a] -> [a]
:)) TSet c
subTrie) Map c (TSet c)
e
foldl' :: (r -> [c] -> r) -> r -> TSet c -> r
foldl' :: forall r c. (r -> [c] -> r) -> r -> TSet c -> r
foldl' r -> [c] -> r
f r
z = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' r -> [c] -> r
f r
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TSet c -> [[c]]
enumerate
empty :: TSet c
empty :: forall c. TSet c
empty = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
False forall k a. Map k a
Map.empty)
epsilon :: TSet c
epsilon :: forall c. TSet c
epsilon = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
True forall k a. Map k a
Map.empty)
singleton :: [c] -> TSet c
singleton :: forall c. [c] -> TSet c
singleton = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall c. c -> TSet c -> TSet c
cons forall c. TSet c
epsilon
cons :: c -> TSet c -> TSet c
cons :: forall c. c -> TSet c -> TSet c
cons c
c TSet c
t = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
False (forall k a. k -> a -> Map k a
Map.singleton c
c TSet c
t))
insert :: (Ord c, Foldable f) => f c -> TSet c -> TSet c
insert :: forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> TSet c
insert = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c}.
Ord c =>
c -> (TSet c -> TSet c, TSet c) -> (TSet c -> TSet c, TSet c)
f (forall {c}. TSet c -> TSet c
b, forall c. TSet c
epsilon)
where
b :: TSet c -> TSet c
b (TSet (Node Bool
_ Map c (TSet c)
e)) = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
True Map c (TSet c)
e)
f :: c -> (TSet c -> TSet c, TSet c) -> (TSet c -> TSet c, TSet c)
f c
x (TSet c -> TSet c
inserter', TSet c
xs') =
let inserter :: TSet c -> TSet c
inserter (TSet (Node Bool
a Map c (TSet c)
e)) =
let e' :: Map c (TSet c)
e' = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall a b. a -> b -> a
const TSet c -> TSet c
inserter') c
x TSet c
xs' Map c (TSet c)
e
in forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
a Map c (TSet c)
e')
xs :: TSet c
xs = forall c. c -> TSet c -> TSet c
cons c
x TSet c
xs'
in (TSet c -> TSet c
inserter, TSet c
xs)
delete :: (Ord c, Foldable f) => f c -> TSet c -> TSet c
delete :: forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> TSet c
delete f c
cs TSet c
t = forall a. a -> Maybe a -> a
fromMaybe forall c. TSet c
empty forall a b. (a -> b) -> a -> b
$ forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> Maybe (TSet c)
delete_ f c
cs TSet c
t
delete_ :: (Ord c, Foldable f) => f c -> TSet c -> Maybe (TSet c)
delete_ :: forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> Maybe (TSet c)
delete_ = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr forall {c}.
Ord c =>
c -> (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
f forall {c}. TSet c -> Maybe (TSet c)
b
where
b :: TSet c -> Maybe (TSet c)
b (TSet (Node Bool
_ Map c (TSet c)
e)) =
if forall k a. Map k a -> Bool
Map.null Map c (TSet c)
e then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just (forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
False Map c (TSet c)
e))
f :: c -> (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
f c
x TSet c -> Maybe (TSet c)
xs (TSet (Node Bool
a Map c (TSet c)
e)) =
let e' :: Map c (TSet c)
e' = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
Map.update TSet c -> Maybe (TSet c)
xs c
x Map c (TSet c)
e
t' :: TSet c
t' = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
a Map c (TSet c)
e')
in if forall c. TSet c -> Bool
null TSet c
t' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just TSet c
t'
union :: (Ord c) => TSet c -> TSet c -> TSet c
union :: forall c. Ord c => TSet c -> TSet c -> TSet c
union (TSet (Node Bool
ax Map c (TSet c)
ex)) (TSet (Node Bool
ay Map c (TSet c)
ey)) = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
az Map c (TSet c)
ez)
where
az :: Bool
az = Bool
ax Bool -> Bool -> Bool
|| Bool
ay
ez :: Map c (TSet c)
ez = forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall c. Ord c => TSet c -> TSet c -> TSet c
union Map c (TSet c)
ex Map c (TSet c)
ey
intersection :: (Ord c) => TSet c -> TSet c -> TSet c
intersection :: forall c. Ord c => TSet c -> TSet c -> TSet c
intersection TSet c
x TSet c
y = forall a. a -> Maybe a -> a
fromMaybe forall c. TSet c
empty forall a b. (a -> b) -> a -> b
$ forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
intersection_ TSet c
x TSet c
y
intersection_ :: (Ord c) => TSet c -> TSet c -> Maybe (TSet c)
intersection_ :: forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
intersection_ (TSet (Node Bool
ax Map c (TSet c)
ex)) (TSet (Node Bool
ay Map c (TSet c)
ey)) =
if Bool -> Bool
not Bool
az Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ez
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
az Map c (TSet c)
ez)
where
az :: Bool
az = Bool
ax Bool -> Bool -> Bool
&& Bool
ay
emz :: Map c (Maybe (TSet c))
emz = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
intersection_ Map c (TSet c)
ex Map c (TSet c)
ey
ez :: Map c (TSet c)
ez = forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall a. a -> a
id Map c (Maybe (TSet c))
emz
difference :: (Ord c) => TSet c -> TSet c -> TSet c
difference :: forall c. Ord c => TSet c -> TSet c -> TSet c
difference TSet c
x TSet c
y = forall a. a -> Maybe a -> a
fromMaybe forall c. TSet c
empty forall a b. (a -> b) -> a -> b
$ forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
difference_ TSet c
x TSet c
y
difference_ :: (Ord c) => TSet c -> TSet c -> Maybe (TSet c)
difference_ :: forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
difference_ (TSet (Node Bool
ax Map c (TSet c)
ex)) (TSet (Node Bool
ay Map c (TSet c)
ey)) =
if Bool -> Bool
not Bool
az Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ez
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
az Map c (TSet c)
ez)
where
az :: Bool
az = Bool
ax forall a. Ord a => a -> a -> Bool
> Bool
ay
ez :: Map c (TSet c)
ez = forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith forall c. Ord c => TSet c -> TSet c -> Maybe (TSet c)
difference_ Map c (TSet c)
ex Map c (TSet c)
ey
append :: (Ord c) => TSet c -> TSet c -> TSet c
append :: forall c. Ord c => TSet c -> TSet c -> TSet c
append TSet c
x (TSet (Node Bool
ay Map c (TSet c)
ey))
| forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ey = if Bool
ay then TSet c
x else forall c. TSet c
empty
| Bool
otherwise = TSet c -> TSet c
go TSet c
x
where
go :: TSet c -> TSet c
go (TSet (Node Bool
ax Map c (TSet c)
ex))
| Bool
ax = forall c. Node c (TSet c) -> TSet c
TSet forall a b. (a -> b) -> a -> b
$ forall c r. Bool -> Map c r -> Node c r
Node Bool
ay (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall c. Ord c => TSet c -> TSet c -> TSet c
union Map c (TSet c)
ey (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TSet c -> TSet c
go Map c (TSet c)
ex))
| Bool
otherwise = forall c. Node c (TSet c) -> TSet c
TSet forall a b. (a -> b) -> a -> b
$ forall c r. Bool -> Map c r -> Node c r
Node Bool
ax (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TSet c -> TSet c
go Map c (TSet c)
ex)
prefixes :: TSet c -> TSet c
prefixes :: forall {c}. TSet c -> TSet c
prefixes TSet c
t | forall c. TSet c -> Bool
null TSet c
t = forall c. TSet c
empty
| Bool
otherwise = forall c r. (Node c r -> r) -> TSet c -> r
foldTSet forall c. Node c (TSet c) -> TSet c
prefixes' TSet c
t
where
prefixes' :: Node c (TSet c) -> TSet c
prefixes' (Node Bool
_ Map c (TSet c)
e) = forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
True Map c (TSet c)
e)
suffixes :: (Ord c) => TSet c -> TSet c
suffixes :: forall c. Ord c => TSet c -> TSet c
suffixes = forall c r. (Node c (TSet c, r) -> r) -> TSet c -> r
paraTSet forall {c}. Ord c => Node c (TSet c, TSet c) -> TSet c
suffixes'
where
suffixes' :: Node c (TSet c, TSet c) -> TSet c
suffixes' Node c (TSet c, TSet c)
nx = forall c. Ord c => TSet c -> TSet c -> TSet c
union (forall c. Node c (TSet c) -> TSet c
TSet (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node c (TSet c, TSet c)
nx)) (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall a b. (a, b) -> b
snd Node c (TSet c, TSet c)
nx)
infixes :: (Ord c) => TSet c -> TSet c
infixes :: forall c. Ord c => TSet c -> TSet c
infixes = forall c. Ord c => TSet c -> TSet c
suffixes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {c}. TSet c -> TSet c
prefixes
toList, toAscList :: TSet c -> [[c]]
toList :: forall c. TSet c -> [[c]]
toList = forall c. TSet c -> [[c]]
enumerate
toAscList :: forall c. TSet c -> [[c]]
toAscList = forall c. TSet c -> [[c]]
enumerate
fromList :: (Ord c) => [[c]] -> TSet c
fromList :: forall c. Ord c => [[c]] -> TSet c
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> TSet c
insert) forall c. TSet c
empty
fromAscList :: (Eq c) => [[c]] -> TSet c
fromAscList :: forall c. Eq c => [[c]] -> TSet c
fromAscList [] = forall c. TSet c
empty
fromAscList [[c]
cs] = forall c. [c] -> TSet c
singleton [c]
cs
fromAscList [[c]]
xs =
let (Bool
a,[(c, [[c]])]
es) = forall c. Eq c => [[c]] -> (Bool, [(c, [[c]])])
groupStrs [[c]]
xs
e' :: Map c (TSet c)
e' = forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall c. Eq c => [[c]] -> TSet c
fromAscList) [(c, [[c]])]
es
in forall c. Node c (TSet c) -> TSet c
TSet (forall c r. Bool -> Map c r -> Node c r
Node Bool
a Map c (TSet c)
e')
groupStrs :: (Eq c) => [[c]] -> (Bool, [(c,[[c]])])
groupStrs :: forall c. Eq c => [[c]] -> (Bool, [(c, [[c]])])
groupStrs = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr forall {a}.
Eq a =>
[a] -> (Bool, [(a, [[a]])]) -> (Bool, [(a, [[a]])])
pushStr (Bool
False, [])
where
pushStr :: [a] -> (Bool, [(a, [[a]])]) -> (Bool, [(a, [[a]])])
pushStr [] (Bool
_, [(a, [[a]])]
gs) = (Bool
True, [(a, [[a]])]
gs)
pushStr (a
c:[a]
cs) (Bool
hasNull, [(a, [[a]])]
gs) =
case [(a, [[a]])]
gs of
(a
d, [[a]]
dss):[(a, [[a]])]
rest | a
c forall a. Eq a => a -> a -> Bool
== a
d -> (Bool
hasNull, (a
d, [a]
csforall a. a -> [a] -> [a]
:[[a]]
dss)forall a. a -> [a] -> [a]
:[(a, [[a]])]
rest)
[(a, [[a]])]
_ -> (Bool
hasNull, (a
c, [[a]
cs])forall a. a -> [a] -> [a]
:[(a, [[a]])]
gs)
toSet :: TSet c -> Set [c]
toSet :: forall c. TSet c -> Set [c]
toSet = forall a. [a] -> Set a
Set.fromDistinctAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. TSet c -> [[c]]
enumerate
fromSet :: (Eq c) => Set [c] -> TSet c
fromSet :: forall c. Eq c => Set [c] -> TSet c
fromSet = forall c. Eq c => [[c]] -> TSet c
fromAscList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toAscList
toParser :: (Alternative f) =>
(c -> f a)
-> f b
-> TSet c -> f [a]
toParser :: forall (f :: * -> *) c a b.
Alternative f =>
(c -> f a) -> f b -> TSet c -> f [a]
toParser c -> f a
char f b
eot = forall c r. (Node c r -> r) -> TSet c -> r
foldTSet Node c (f [a]) -> f [a]
enumerateA'
where
enumerateA' :: Node c (f [a]) -> f [a]
enumerateA' (Node Bool
a Map c (f [a])
e) =
(if Bool
a then [] forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
eot else forall (f :: * -> *) a. Alternative f => f a
Ap.empty) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f a
char c
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f [a]
as | (c
c, f [a]
as) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map c (f [a])
e ]
toParser_ :: (Alternative f) =>
(c -> f a)
-> f b
-> TSet c -> f ()
toParser_ :: forall (f :: * -> *) c a b.
Alternative f =>
(c -> f a) -> f b -> TSet c -> f ()
toParser_ c -> f a
char f b
eot = forall c r. (Node c r -> r) -> TSet c -> r
foldTSet Node c (f ()) -> f ()
enumerateA'
where
enumerateA' :: Node c (f ()) -> f ()
enumerateA' (Node Bool
a Map c (f ())
e) =
(if Bool
a then () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
eot else forall (f :: * -> *) a. Alternative f => f a
Ap.empty) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ c -> f a
char c
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
as | (c
c, f ()
as) <- forall k a. Map k a -> [(k, a)]
Map.toAscList Map c (f ())
e ]
foldTSet :: (Node c r -> r) -> TSet c -> r
foldTSet :: forall c r. (Node c r -> r) -> TSet c -> r
foldTSet Node c r -> r
f = TSet c -> r
go
where go :: TSet c -> r
go (TSet (Node Bool
a Map c (TSet c)
e)) = Node c r -> r
f (forall c r. Bool -> Map c r -> Node c r
Node Bool
a (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map TSet c -> r
go Map c (TSet c)
e))
paraTSet :: (Node c (TSet c, r) -> r) -> TSet c -> r
paraTSet :: forall c r. (Node c (TSet c, r) -> r) -> TSet c -> r
paraTSet Node c (TSet c, r) -> r
f = TSet c -> r
go
where go :: TSet c -> r
go (TSet (Node Bool
a Map c (TSet c)
e)) = Node c (TSet c, r) -> r
f (forall c r. Bool -> Map c r -> Node c r
Node Bool
a (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall a. a -> a
id forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& TSet c -> r
go) Map c (TSet c)
e))