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

instance (NFData c, NFData r) => NFData (Node c r) where
  rnf :: Node c r -> ()
rnf (Node Bool
a Map c r
e) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
a () -> () -> ()
forall a b. a -> b -> b
`seq` Map c r -> ()
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
(TSet c -> TSet c -> Bool)
-> (TSet c -> TSet c -> Bool) -> Eq (TSet c)
forall c. Eq c => TSet c -> TSet c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
/= :: TSet c -> TSet c -> Bool
Eq, Eq (TSet c)
Eq (TSet c) =>
(TSet c -> TSet c -> Ordering)
-> (TSet c -> TSet c -> Bool)
-> (TSet c -> TSet c -> Bool)
-> (TSet c -> TSet c -> Bool)
-> (TSet c -> TSet c -> Bool)
-> (TSet c -> TSet c -> TSet c)
-> (TSet c -> TSet c -> TSet c)
-> Ord (TSet c)
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
$ccompare :: forall c. Ord c => TSet c -> TSet c -> Ordering
compare :: TSet c -> TSet c -> Ordering
$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
>= :: TSet c -> TSet c -> Bool
$cmax :: forall c. Ord c => TSet c -> TSet c -> TSet c
max :: TSet c -> TSet c -> TSet c
$cmin :: forall c. Ord c => TSet c -> TSet c -> TSet c
min :: TSet c -> TSet c -> TSet c
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 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] -> ShowS) -> [[a]] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith [a] -> ShowS
showListC (TSet a -> [[a]]
forall c. TSet c -> [[c]]
enumerate TSet a
t)

instance Show c => Show (TSet c) where
  showsPrec :: Int -> TSet c -> ShowS
showsPrec = Int -> TSet c -> ShowS
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) = Node c (TSet c) -> ()
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 = [[c]] -> TSet c
[Item (TSet c)] -> TSet c
forall c. Ord c => [[c]] -> TSet c
fromList
  toList :: TSet c -> [Item (TSet c)]
toList = TSet c -> [[c]]
TSet c -> [Item (TSet c)]
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 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
a2 Bool -> Bool -> Bool
&& (a -> b -> Bool)
-> (TSet a -> TSet b -> Bool)
-> Map a (TSet a)
-> Map b (TSet b)
-> 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
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)) = Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
a1 Bool
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> (a -> b -> Ordering)
-> (TSet a -> TSet b -> Ordering)
-> Map a (TSet a)
-> Map b (TSet b)
-> 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
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 = (Int -> c -> Int) -> Int -> TSet c -> Int
forall a. (Int -> a -> Int) -> Int -> TSet a -> Int
forall (t :: * -> *) a.
Hashable1 t =>
(Int -> a -> Int) -> Int -> t a -> Int
liftHashWithSalt Int -> c -> Int
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)) = (Int -> a -> Int)
-> (Int -> TSet a -> Int) -> Int -> Map a (TSet a) -> 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 -> TSet a -> Int
go (Int
s Int -> Bool -> Int
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
(<>) = 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 = b -> TSet c -> TSet c
forall b a. Integral b => b -> a -> a
stimesIdempotent

-- | Monoid(empty, union)
instance (Ord c) => Monoid (TSet c) where
  mempty :: TSet c
mempty = TSet c
forall c. TSet c
empty
  mappend :: TSet c -> TSet c -> TSet c
mappend = TSet c -> TSet c -> TSet c
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 c -> Map c (TSet c) -> Maybe (TSet c)
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' -> [c] -> TSet c -> Bool
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 (Bool -> Bool) -> (TSet c -> Bool) -> TSet c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [c] -> TSet c -> Bool
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 c -> Map c (TSet c) -> Maybe (TSet c)
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 -> TSet c
forall c. TSet c
empty
    Just TSet c
t' -> TSet c -> [c] -> TSet c
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
&& Map c (TSet c) -> 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 = (Node c Int -> Int) -> TSet c -> Int
forall c r. (Node c r -> r) -> TSet c -> r
foldTSet Node c Int -> Int
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) a -> a -> a
forall a. Num a => a -> a -> a
+ Map c a -> a
forall a. Num a => Map c 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 = ([c] -> [[c]] -> [[c]]) -> [[c]] -> TSet c -> [[c]]
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 = (c -> TSet c -> r -> r) -> r -> Map c (TSet c) -> r
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\c
x TSet c
tr r
xs -> ([c] -> r -> r) -> r -> TSet c -> r
forall c r. ([c] -> r -> r) -> r -> TSet c -> r
foldr ([c] -> r -> r
f ([c] -> r -> r) -> ([c] -> [c]) -> [c] -> r -> r
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 [] r -> r -> r
forall a. Monoid a => a -> a -> a
`mappend` r
r
  | Bool
otherwise = r
r
  where
    r :: r
r = (c -> TSet c -> r) -> Map c (TSet c) -> r
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey (\c
c TSet c
subTrie ->
          ([c] -> r) -> TSet c -> r
forall r c. Monoid r => ([c] -> r) -> TSet c -> r
foldMap ([c] -> r
f ([c] -> r) -> ([c] -> [c]) -> [c] -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c
c 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 = (r -> [c] -> r) -> r -> [[c]] -> r
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' r -> [c] -> r
f r
z ([[c]] -> r) -> (TSet c -> [[c]]) -> TSet c -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSet c -> [[c]]
forall c. TSet c -> [[c]]
enumerate

-- * Construction
empty :: TSet c
empty :: forall c. TSet c
empty = 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
Node Bool
False Map c (TSet c)
forall k a. Map k a
Map.empty)

-- | @epsilon = singleton []@
epsilon :: TSet c
epsilon :: forall c. TSet c
epsilon = 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
Node Bool
True Map c (TSet c)
forall k a. Map k a
Map.empty)

singleton :: [c] -> TSet c
singleton :: forall c. [c] -> TSet c
singleton = (c -> TSet c -> TSet c) -> TSet c -> [c] -> TSet c
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr c -> TSet c -> TSet c
forall c. c -> TSet c -> TSet c
cons TSet c
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 = 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
Node Bool
False (c -> TSet c -> Map c (TSet c)
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 = (TSet c -> TSet c, TSet c) -> TSet c -> TSet c
forall a b. (a, b) -> a
fst ((TSet c -> TSet c, TSet c) -> TSet c -> TSet c)
-> (f c -> (TSet c -> TSet c, TSet c)) -> f c -> TSet c -> TSet c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> (TSet c -> TSet c, TSet c) -> (TSet c -> TSet c, TSet c))
-> (TSet c -> TSet c, TSet c) -> f c -> (TSet c -> TSet c, TSet c)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c -> (TSet c -> TSet c, TSet c) -> (TSet c -> TSet c, TSet c)
forall {c}.
Ord c =>
c -> (TSet c -> TSet c, TSet c) -> (TSet c -> TSet c, TSet c)
f (TSet c -> TSet c
forall {c}. TSet c -> TSet c
b, TSet c
forall c. TSet c
epsilon)
  where
    b :: TSet c -> TSet c
b (TSet (Node Bool
_ Map c (TSet c)
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
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' = (TSet c -> TSet c -> TSet c)
-> c -> TSet c -> Map c (TSet c) -> Map c (TSet c)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((TSet c -> TSet c) -> TSet c -> TSet c -> TSet c
forall a b. a -> b -> a
const TSet c -> TSet c
inserter') c
x TSet c
xs' Map c (TSet c)
e
            in 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
Node Bool
a Map c (TSet c)
e')
          xs :: TSet c
xs = c -> TSet c -> TSet c
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 = TSet c -> Maybe (TSet c) -> TSet c
forall a. a -> Maybe a -> a
fromMaybe TSet c
forall c. TSet c
empty (Maybe (TSet c) -> TSet c) -> Maybe (TSet c) -> TSet c
forall a b. (a -> b) -> a -> b
$ f c -> TSet c -> Maybe (TSet c)
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_ = (c -> (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c))
-> (TSet c -> Maybe (TSet c)) -> f c -> TSet c -> Maybe (TSet c)
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr c -> (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
forall {c}.
Ord c =>
c -> (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
f TSet c -> Maybe (TSet c)
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 Map c (TSet c) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TSet c)
e then Maybe (TSet c)
forall a. Maybe a
Nothing else TSet c -> Maybe (TSet c)
forall a. a -> Maybe a
Just (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
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' = (TSet c -> Maybe (TSet c)) -> c -> Map c (TSet c) -> Map c (TSet c)
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' = 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
Node Bool
a Map c (TSet c)
e')
      in if TSet c -> Bool
forall c. TSet c -> Bool
null TSet c
t' then Maybe (TSet c)
forall a. Maybe a
Nothing else TSet c -> Maybe (TSet c)
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)) = 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
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 = (TSet c -> TSet c -> TSet c)
-> Map c (TSet c) -> Map c (TSet c) -> Map c (TSet c)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith TSet c -> TSet c -> TSet c
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 = TSet c -> Maybe (TSet c) -> TSet c
forall a. a -> Maybe a -> a
fromMaybe TSet c
forall c. TSet c
empty (Maybe (TSet c) -> TSet c) -> Maybe (TSet c) -> TSet c
forall a b. (a -> b) -> a -> b
$ TSet c -> TSet c -> Maybe (TSet c)
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
&& Map c (TSet c) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ez
      then Maybe (TSet c)
forall a. Maybe a
Nothing
      else TSet c -> Maybe (TSet c)
forall a. a -> Maybe a
Just (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
forall a b. (a -> b) -> a -> b
$ 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
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 = (TSet c -> TSet c -> Maybe (TSet c))
-> Map c (TSet c) -> Map c (TSet c) -> Map c (Maybe (TSet c))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith TSet c -> TSet c -> Maybe (TSet c)
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 = (Maybe (TSet c) -> Maybe (TSet c))
-> Map c (Maybe (TSet c)) -> Map c (TSet c)
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe Maybe (TSet c) -> Maybe (TSet c)
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 = TSet c -> Maybe (TSet c) -> TSet c
forall a. a -> Maybe a -> a
fromMaybe TSet c
forall c. TSet c
empty (Maybe (TSet c) -> TSet c) -> Maybe (TSet c) -> TSet c
forall a b. (a -> b) -> a -> b
$ TSet c -> TSet c -> Maybe (TSet c)
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
&& Map c (TSet c) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ez
      then Maybe (TSet c)
forall a. Maybe a
Nothing
      else TSet c -> Maybe (TSet c)
forall a. a -> Maybe a
Just (TSet c -> Maybe (TSet c)) -> TSet c -> Maybe (TSet c)
forall a b. (a -> b) -> a -> b
$ 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
Node Bool
az Map c (TSet c)
ez)
  where
    az :: Bool
az = Bool
ax Bool -> Bool -> Bool
forall a. Ord a => a -> a -> Bool
> Bool
ay
    ez :: Map c (TSet c)
ez = (TSet c -> TSet c -> Maybe (TSet c))
-> Map c (TSet c) -> Map c (TSet c) -> Map c (TSet c)
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith TSet c -> TSet c -> Maybe (TSet c)
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))
  | Map c (TSet c) -> Bool
forall k a. Map k a -> Bool
Map.null Map c (TSet c)
ey = if Bool
ay then TSet c
x else TSet c
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        = Node c (TSet c) -> TSet c
forall c. Node c (TSet c) -> TSet c
TSet (Node c (TSet c) -> TSet c) -> Node c (TSet c) -> TSet c
forall a b. (a -> b) -> a -> b
$ Bool -> Map c (TSet c) -> Node c (TSet c)
forall c r. Bool -> Map c r -> Node c r
Node Bool
ay ((TSet c -> TSet c -> TSet c)
-> Map c (TSet c) -> Map c (TSet c) -> Map c (TSet c)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith TSet c -> TSet c -> TSet c
forall c. Ord c => TSet c -> TSet c -> TSet c
union Map c (TSet c)
ey ((TSet c -> TSet c) -> Map c (TSet c) -> Map c (TSet c)
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 = Node c (TSet c) -> TSet c
forall c. Node c (TSet c) -> TSet c
TSet (Node c (TSet c) -> TSet c) -> Node c (TSet c) -> TSet c
forall a b. (a -> b) -> a -> b
$ Bool -> Map c (TSet c) -> Node c (TSet c)
forall c r. Bool -> Map c r -> Node c r
Node Bool
ax ((TSet c -> TSet c) -> Map c (TSet c) -> Map c (TSet c)
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 | TSet c -> Bool
forall c. TSet c -> Bool
null TSet c
t    = TSet c
forall c. TSet c
empty
           | Bool
otherwise = (Node c (TSet c) -> TSet c) -> TSet c -> TSet c
forall c r. (Node c r -> r) -> TSet c -> r
foldTSet Node c (TSet c) -> TSet c
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) = 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
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 = (Node c (TSet c, TSet c) -> TSet c) -> TSet c -> TSet c
forall c r. (Node c (TSet c, r) -> r) -> TSet c -> r
paraTSet Node c (TSet c, TSet c) -> TSet c
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 = TSet c -> TSet c -> TSet c
forall c. Ord c => TSet c -> TSet c -> TSet c
union (Node c (TSet c) -> TSet c
forall c. Node c (TSet c) -> TSet c
TSet ((TSet c, TSet c) -> TSet c
forall a b. (a, b) -> a
fst ((TSet c, TSet c) -> TSet c)
-> Node c (TSet c, TSet c) -> Node c (TSet c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Node c (TSet c, TSet c)
nx)) (((TSet c, TSet c) -> TSet c) -> Node c (TSet c, TSet c) -> TSet c
forall m a. Monoid m => (a -> m) -> Node c a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap (TSet c, TSet c) -> TSet c
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 = TSet c -> TSet c
forall c. Ord c => TSet c -> TSet c
suffixes (TSet c -> TSet c) -> (TSet c -> TSet c) -> TSet c -> TSet c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSet c -> TSet c
forall {c}. TSet c -> TSet c
prefixes

-- * Conversion
toList, toAscList :: TSet c -> [[c]]
toList :: forall c. TSet c -> [[c]]
toList = TSet c -> [[c]]
forall c. TSet c -> [[c]]
enumerate
toAscList :: forall c. TSet c -> [[c]]
toAscList = TSet c -> [[c]]
forall c. TSet c -> [[c]]
enumerate

fromList :: (Ord c) => [[c]] -> TSet c
fromList :: forall c. Ord c => [[c]] -> TSet c
fromList = (TSet c -> [c] -> TSet c) -> TSet c -> [[c]] -> TSet c
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] -> TSet c -> TSet c) -> TSet c -> [c] -> TSet c
forall a b c. (a -> b -> c) -> b -> a -> c
flip [c] -> TSet c -> TSet c
forall c (f :: * -> *).
(Ord c, Foldable f) =>
f c -> TSet c -> TSet c
insert) TSet c
forall c. TSet c
empty

fromAscList :: (Eq c) => [[c]] -> TSet c
fromAscList :: forall c. Eq c => [[c]] -> TSet c
fromAscList [] = TSet c
forall c. TSet c
empty
fromAscList [[c]
cs] = [c] -> TSet c
forall c. [c] -> TSet c
singleton [c]
cs
fromAscList [[c]]
xs =
  let (Bool
a,[(c, [[c]])]
es) = [[c]] -> (Bool, [(c, [[c]])])
forall c. Eq c => [[c]] -> (Bool, [(c, [[c]])])
groupStrs [[c]]
xs
      e' :: Map c (TSet c)
e' = [(c, TSet c)] -> Map c (TSet c)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(c, TSet c)] -> Map c (TSet c))
-> [(c, TSet c)] -> Map c (TSet c)
forall a b. (a -> b) -> a -> b
$ ((c, [[c]]) -> (c, TSet c)) -> [(c, [[c]])] -> [(c, TSet c)]
forall a b. (a -> b) -> [a] -> [b]
map (([[c]] -> TSet c) -> (c, [[c]]) -> (c, TSet c)
forall a b. (a -> b) -> (c, a) -> (c, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[c]] -> TSet c
forall c. Eq c => [[c]] -> TSet c
fromAscList) [(c, [[c]])]
es
  in 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
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 = ([c] -> (Bool, [(c, [[c]])]) -> (Bool, [(c, [[c]])]))
-> (Bool, [(c, [[c]])]) -> [[c]] -> (Bool, [(c, [[c]])])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
List.foldr [c] -> (Bool, [(c, [[c]])]) -> (Bool, [(c, [[c]])])
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
d -> (Bool
hasNull, (a
d, [a]
cs[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
dss)(a, [[a]]) -> [(a, [[a]])] -> [(a, [[a]])]
forall a. a -> [a] -> [a]
:[(a, [[a]])]
rest)
        [(a, [[a]])]
_                      -> (Bool
hasNull, (a
c, [[a]
cs])(a, [[a]]) -> [(a, [[a]])] -> [(a, [[a]])]
forall a. a -> [a] -> [a]
:[(a, [[a]])]
gs)

toSet :: TSet c -> Set [c]
toSet :: forall c. TSet c -> Set [c]
toSet = [[c]] -> Set [c]
forall a. [a] -> Set a
Set.fromDistinctAscList ([[c]] -> Set [c]) -> (TSet c -> [[c]]) -> TSet c -> Set [c]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSet c -> [[c]]
forall c. TSet c -> [[c]]
enumerate

fromSet :: (Eq c) => Set [c] -> TSet c
fromSet :: forall c. Eq c => Set [c] -> TSet c
fromSet = [[c]] -> TSet c
forall c. Eq c => [[c]] -> TSet c
fromAscList ([[c]] -> TSet c) -> (Set [c] -> [[c]]) -> Set [c] -> TSet c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set [c] -> [[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 = (Node c (f [a]) -> f [a]) -> TSet c -> f [a]
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 [] [a] -> f b -> f [a]
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
eot else f [a]
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
Ap.empty) 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 [ (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> c -> f a
char c
c f ([a] -> [a]) -> f [a] -> f [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 [a]
as | (c
c, f [a]
as) <- Map c (f [a]) -> [(c, f [a])]
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 = (Node c (f ()) -> f ()) -> TSet c -> f ()
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 () () -> f b -> f ()
forall a b. a -> f b -> f a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f b
eot else f ()
forall a. f a
forall (f :: * -> *) a. Alternative f => f a
Ap.empty) f () -> f () -> f ()
forall a. f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      [f ()] -> f ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
F.asum [ c -> f a
char c
c f a -> f () -> f ()
forall a b. f a -> f b -> f b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f ()
as | (c
c, f ()
as) <- Map c (f ()) -> [(c, f ())]
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 (Bool -> Map c r -> Node c r
forall c r. Bool -> Map c r -> Node c r
Node Bool
a ((TSet c -> r) -> Map c (TSet c) -> Map c r
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 (Bool -> Map c (TSet c, r) -> Node c (TSet c, r)
forall c r. Bool -> Map c r -> Node c r
Node Bool
a ((TSet c -> (TSet c, r)) -> Map c (TSet c) -> Map c (TSet c, r)
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (TSet c -> TSet c
forall a. a -> a
id (TSet c -> TSet c) -> (TSet c -> r) -> TSet c -> (TSet c, r)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
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))