{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Trie.Set.Hidden(
  -- * Types
  TSet(..),
  -- * Queries
  member, notMember,
  beginWith,
  null, count, enumerate,
  foldr, foldMap, foldl',
  -- * Construction
  empty, epsilon,
  singleton,
  insert, delete,
  -- * Combine
  union, intersection, difference,
  append,
  -- * Other operations
  prefixes, suffixes, infixes,
  -- * Conversion
  fromList, toList,
  fromAscList, toAscList,
  fromSet, toSet,
  -- * Parsing
  toParser, toParser_,
  -- * Low-level operation
  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

{-

The canonical Monoid instance could be (epsilon, append),
but here I choose (empty, union) to align to Set instance.
Semigroup instance must follow how Monoid is defined.

-}

-- | Semigroup(union)
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

-- | Monoid(empty, union)
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
(<>)

-- * Queries
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 t xs@ returns new TSet @t'@ which contains
--   all string @ys@ such that @t@ contains @xs ++ ys@.
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

-- | Returns number of elements. @count@ takes O(number of nodes)
--   unlike 'Set.size' which is O(1).
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

-- | List of all elements.
enumerate :: TSet c -> [[c]]
enumerate :: forall c. TSet c -> [[c]]
enumerate = forall c r. ([c] -> r -> r) -> r -> TSet c -> r
foldr (:) []

{-
from this post by u/foBrowsing:
  https://www.reddit.com/r/haskell/comments/8krv31/how_to_traverse_a_trie/dzaktkn/
-}
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

-- * Construction
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 = singleton []@
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'

-- * Combine
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)

-- * Other operations

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

-- * Conversion
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

-- * Parsing

-- | Construct a \"parser\" which recognizes member strings
--   of a TSet.
--
--   * @char@ constructs a parser which recognizes a character.
--   * @eot@ recognizes the end of a token.
toParser :: (Alternative f) =>
  (c -> f a) -- ^ char
  -> f b     -- ^ eot
  -> 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 ]

-- | Construct a \"parser\" which recognizes member strings
--   of a TSet.
--   It discards the information which string it is recognizing.
--
--   * @char@ constructs a parser which recognizes a character.
--   * @eot@ recognizes the end of a token.
toParser_ :: (Alternative f) =>
  (c -> f a) -- ^ char
  -> f b     -- ^ eot
  -> 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))