{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists       #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
module Data.RadixTree
  ( RadixTree (..)
  , RadixNode (..)
  , CompressedRadixTree
    -- * Construction
  , fromFoldable_
  , fromFoldable
  , compressBy
    -- * Parsing with radix trees
  , RadixParsing (..)
  , parse_
  , lookup_
  , search
  ) where
import           Control.Applicative
import           Control.DeepSeq
import           Data.Data               (Data, Typeable)
import           Data.Foldable           (asum, foldr', toList)
import           Data.Map.Strict         (Map)
import qualified Data.Map.Strict         as M
import           Data.Sequence           (Seq)
import qualified Data.Sequence           as Seq
import           Data.Text               (Text)
import qualified Data.Text               as T
import qualified Data.Text.Array         as TI (Array)
import qualified Data.Text.Internal      as TI (Text (..), text)
import           Data.Vector             (Vector)
import qualified Data.Vector             as V
import           Lens.Micro
import           Text.Parser.Char        (CharParsing (anyChar, text))
import           Text.Parser.Combinators (Parsing (try))

--------------------------------------------------------------------------------
-- Stuff to help construct RadixTrees
--
-- I'm not clever enough to write a function to go directly from a 'Foldable' to
-- a fully-optimised RadixTree. Instead, I generate a prefix-tree using a 'Map'
-- directly ('Trie'), and then gradually compress that ('CompressedTrie') before
-- packing the final result into an efficient structure using 'Text' nodes.
--
-- TODO:
-- - generate RadixTree directly, instead of going through 'Trie'/'CompressedTrie'
-- - use compact regions?

data PrefixNode a tree = Accept !Text a !tree | Skip !tree
  deriving (Int -> PrefixNode a tree -> ShowS
[PrefixNode a tree] -> ShowS
PrefixNode a tree -> String
(Int -> PrefixNode a tree -> ShowS)
-> (PrefixNode a tree -> String)
-> ([PrefixNode a tree] -> ShowS)
-> Show (PrefixNode a tree)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a tree.
(Show a, Show tree) =>
Int -> PrefixNode a tree -> ShowS
forall a tree. (Show a, Show tree) => [PrefixNode a tree] -> ShowS
forall a tree. (Show a, Show tree) => PrefixNode a tree -> String
showList :: [PrefixNode a tree] -> ShowS
$cshowList :: forall a tree. (Show a, Show tree) => [PrefixNode a tree] -> ShowS
show :: PrefixNode a tree -> String
$cshow :: forall a tree. (Show a, Show tree) => PrefixNode a tree -> String
showsPrec :: Int -> PrefixNode a tree -> ShowS
$cshowsPrec :: forall a tree.
(Show a, Show tree) =>
Int -> PrefixNode a tree -> ShowS
Show, PrefixNode a tree -> PrefixNode a tree -> Bool
(PrefixNode a tree -> PrefixNode a tree -> Bool)
-> (PrefixNode a tree -> PrefixNode a tree -> Bool)
-> Eq (PrefixNode a tree)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a tree.
(Eq a, Eq tree) =>
PrefixNode a tree -> PrefixNode a tree -> Bool
/= :: PrefixNode a tree -> PrefixNode a tree -> Bool
$c/= :: forall a tree.
(Eq a, Eq tree) =>
PrefixNode a tree -> PrefixNode a tree -> Bool
== :: PrefixNode a tree -> PrefixNode a tree -> Bool
$c== :: forall a tree.
(Eq a, Eq tree) =>
PrefixNode a tree -> PrefixNode a tree -> Bool
Eq)

newtype Trie a = Trie (PrefixNode a (Map Char (Trie a)))
  deriving (Int -> Trie a -> ShowS
[Trie a] -> ShowS
Trie a -> String
(Int -> Trie a -> ShowS)
-> (Trie a -> String) -> ([Trie a] -> ShowS) -> Show (Trie a)
forall a. Show a => Int -> Trie a -> ShowS
forall a. Show a => [Trie a] -> ShowS
forall a. Show a => Trie a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Trie a] -> ShowS
$cshowList :: forall a. Show a => [Trie a] -> ShowS
show :: Trie a -> String
$cshow :: forall a. Show a => Trie a -> String
showsPrec :: Int -> Trie a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Trie a -> ShowS
Show, Trie a -> Trie a -> Bool
(Trie a -> Trie a -> Bool)
-> (Trie a -> Trie a -> Bool) -> Eq (Trie a)
forall a. Eq a => Trie a -> Trie a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Trie a -> Trie a -> Bool
$c/= :: forall a. Eq a => Trie a -> Trie a -> Bool
== :: Trie a -> Trie a -> Bool
$c== :: forall a. Eq a => Trie a -> Trie a -> Bool
Eq)

newtype CompressedTrie a = CompressedTrie (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
  deriving (Int -> CompressedTrie a -> ShowS
[CompressedTrie a] -> ShowS
CompressedTrie a -> String
(Int -> CompressedTrie a -> ShowS)
-> (CompressedTrie a -> String)
-> ([CompressedTrie a] -> ShowS)
-> Show (CompressedTrie a)
forall a. Show a => Int -> CompressedTrie a -> ShowS
forall a. Show a => [CompressedTrie a] -> ShowS
forall a. Show a => CompressedTrie a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressedTrie a] -> ShowS
$cshowList :: forall a. Show a => [CompressedTrie a] -> ShowS
show :: CompressedTrie a -> String
$cshow :: forall a. Show a => CompressedTrie a -> String
showsPrec :: Int -> CompressedTrie a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CompressedTrie a -> ShowS
Show, CompressedTrie a -> CompressedTrie a -> Bool
(CompressedTrie a -> CompressedTrie a -> Bool)
-> (CompressedTrie a -> CompressedTrie a -> Bool)
-> Eq (CompressedTrie a)
forall a. Eq a => CompressedTrie a -> CompressedTrie a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressedTrie a -> CompressedTrie a -> Bool
$c/= :: forall a. Eq a => CompressedTrie a -> CompressedTrie a -> Bool
== :: CompressedTrie a -> CompressedTrie a -> Bool
$c== :: forall a. Eq a => CompressedTrie a -> CompressedTrie a -> Bool
Eq)

{-# INLINE node #-}
node :: Lens (PrefixNode p a) (PrefixNode p b) a b
node :: (a -> f b) -> PrefixNode p a -> f (PrefixNode p b)
node = (PrefixNode p a -> a)
-> (PrefixNode p a -> b -> PrefixNode p b)
-> Lens (PrefixNode p a) (PrefixNode p b) a b
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
  (\PrefixNode p a
x -> case PrefixNode p a
x of { Accept Text
_ p
_ a
t -> a
t; Skip a
t -> a
t })
  (\PrefixNode p a
x b
a -> case PrefixNode p a
x of { Accept Text
l p
p a
_ -> Text -> p -> b -> PrefixNode p b
forall a tree. Text -> a -> tree -> PrefixNode a tree
Accept Text
l p
p b
a; Skip a
_ -> b -> PrefixNode p b
forall a tree. tree -> PrefixNode a tree
Skip b
a })

leaf :: Text -> Text -> a -> Trie a
leaf :: Text -> Text -> a -> Trie a
leaf Text
ft Text
t a
v = String -> Trie a
go (Text -> String
T.unpack Text
t)
  where
    go :: String -> Trie a
go (Char
x:String
xs) = PrefixNode a (Map Char (Trie a)) -> Trie a
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (Map Char (Trie a) -> PrefixNode a (Map Char (Trie a))
forall a tree. tree -> PrefixNode a tree
Skip (Char -> Trie a -> Map Char (Trie a)
forall k a. k -> a -> Map k a
M.singleton Char
x (String -> Trie a
go String
xs)))
    go []     = PrefixNode a (Map Char (Trie a)) -> Trie a
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (Text -> a -> Map Char (Trie a) -> PrefixNode a (Map Char (Trie a))
forall a tree. Text -> a -> tree -> PrefixNode a tree
Accept Text
ft a
v Map Char (Trie a)
forall k a. Map k a
M.empty)

insert :: Text -> Text -> a -> Trie a -> Trie a
insert :: Text -> Text -> a -> Trie a -> Trie a
insert Text
ft Text
text' a
a (Trie PrefixNode a (Map Char (Trie a))
n) = case Text -> Maybe (Char, Text)
T.uncons Text
text' of
  Just (Char
c, Text
cs) -> PrefixNode a (Map Char (Trie a)) -> Trie a
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (((Map Char (Trie a) -> Identity (Map Char (Trie a)))
-> PrefixNode a (Map Char (Trie a))
-> Identity (PrefixNode a (Map Char (Trie a)))
forall p a b. Lens (PrefixNode p a) (PrefixNode p b) a b
node ((Map Char (Trie a) -> Identity (Map Char (Trie a)))
 -> PrefixNode a (Map Char (Trie a))
 -> Identity (PrefixNode a (Map Char (Trie a))))
-> (Map Char (Trie a) -> Map Char (Trie a))
-> PrefixNode a (Map Char (Trie a))
-> PrefixNode a (Map Char (Trie a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
    (Trie a -> Trie a -> Trie a)
-> Char -> Trie a -> Map Char (Trie a) -> Map Char (Trie a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
    (\Trie a
_ Trie a
orig -> Text -> Text -> a -> Trie a -> Trie a
forall a. Text -> Text -> a -> Trie a -> Trie a
Data.RadixTree.insert Text
ft Text
cs a
a Trie a
orig)
    Char
c
    (Text -> Text -> a -> Trie a
forall a. Text -> Text -> a -> Trie a
leaf Text
ft Text
cs a
a)) PrefixNode a (Map Char (Trie a))
n)
  Maybe (Char, Text)
Nothing ->
    PrefixNode a (Map Char (Trie a)) -> Trie a
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (PrefixNode a (Map Char (Trie a))
nPrefixNode a (Map Char (Trie a))
-> Getting
     (PrefixNode a (Map Char (Trie a)))
     (PrefixNode a (Map Char (Trie a)))
     (PrefixNode a (Map Char (Trie a)))
-> PrefixNode a (Map Char (Trie a))
forall s a. s -> Getting a s a -> a
^.(Map Char (Trie a)
 -> Const (PrefixNode a (Map Char (Trie a))) (Map Char (Trie a)))
-> PrefixNode a (Map Char (Trie a))
-> Const
     (PrefixNode a (Map Char (Trie a)))
     (PrefixNode a (Map Char (Trie a)))
forall p a b. Lens (PrefixNode p a) (PrefixNode p b) a b
node((Map Char (Trie a)
  -> Const (PrefixNode a (Map Char (Trie a))) (Map Char (Trie a)))
 -> PrefixNode a (Map Char (Trie a))
 -> Const
      (PrefixNode a (Map Char (Trie a)))
      (PrefixNode a (Map Char (Trie a))))
-> ((PrefixNode a (Map Char (Trie a))
     -> Const
          (PrefixNode a (Map Char (Trie a)))
          (PrefixNode a (Map Char (Trie a))))
    -> Map Char (Trie a)
    -> Const (PrefixNode a (Map Char (Trie a))) (Map Char (Trie a)))
-> Getting
     (PrefixNode a (Map Char (Trie a)))
     (PrefixNode a (Map Char (Trie a)))
     (PrefixNode a (Map Char (Trie a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Map Char (Trie a) -> PrefixNode a (Map Char (Trie a)))
-> SimpleGetter
     (Map Char (Trie a)) (PrefixNode a (Map Char (Trie a)))
forall s a. (s -> a) -> SimpleGetter s a
to (Text -> a -> Map Char (Trie a) -> PrefixNode a (Map Char (Trie a))
forall a tree. Text -> a -> tree -> PrefixNode a tree
Accept Text
ft a
a))

makeCompressable :: Trie a -> CompressedTrie a
makeCompressable :: Trie a -> CompressedTrie a
makeCompressable (Trie PrefixNode a (Map Char (Trie a))
n) = PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
forall a.
PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
CompressedTrie (
  ASetter
  (PrefixNode a (Map Char (Trie a)))
  (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
  (Map Char (Trie a))
  (Map (Seq Char) (CompressedTrie a))
-> (Map Char (Trie a) -> Map (Seq Char) (CompressedTrie a))
-> PrefixNode a (Map Char (Trie a))
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (PrefixNode a (Map Char (Trie a)))
  (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
  (Map Char (Trie a))
  (Map (Seq Char) (CompressedTrie a))
forall p a b. Lens (PrefixNode p a) (PrefixNode p b) a b
node ((Trie a -> CompressedTrie a)
-> Map (Seq Char) (Trie a) -> Map (Seq Char) (CompressedTrie a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map Trie a -> CompressedTrie a
forall a. Trie a -> CompressedTrie a
makeCompressable (Map (Seq Char) (Trie a) -> Map (Seq Char) (CompressedTrie a))
-> (Map Char (Trie a) -> Map (Seq Char) (Trie a))
-> Map Char (Trie a)
-> Map (Seq Char) (CompressedTrie a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Seq Char) -> Map Char (Trie a) -> Map (Seq Char) (Trie a)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
M.mapKeysMonotonic Char -> Seq Char
forall a. a -> Seq a
Seq.singleton) PrefixNode a (Map Char (Trie a))
n)

compress :: Trie a -> CompressedTrie a
compress :: Trie a -> CompressedTrie a
compress = CompressedTrie a -> CompressedTrie a
forall a. CompressedTrie a -> CompressedTrie a
go (CompressedTrie a -> CompressedTrie a)
-> (Trie a -> CompressedTrie a) -> Trie a -> CompressedTrie a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trie a -> CompressedTrie a
forall a. Trie a -> CompressedTrie a
makeCompressable
  where
    go :: CompressedTrie a -> CompressedTrie a
    go :: CompressedTrie a -> CompressedTrie a
go (CompressedTrie PrefixNode a (Map (Seq Char) (CompressedTrie a))
n) = case PrefixNode a (Map (Seq Char) (CompressedTrie a))
n of
      Accept Text
l a
p Map (Seq Char) (CompressedTrie a)
m -> PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
forall a.
PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
CompressedTrie (Text
-> a
-> Map (Seq Char) (CompressedTrie a)
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
forall a tree. Text -> a -> tree -> PrefixNode a tree
Accept Text
l a
p ((CompressedTrie a -> CompressedTrie a)
-> Map (Seq Char) (CompressedTrie a)
-> Map (Seq Char) (CompressedTrie a)
forall a b k. (a -> b) -> Map k a -> Map k b
M.map CompressedTrie a -> CompressedTrie a
forall a. CompressedTrie a -> CompressedTrie a
go Map (Seq Char) (CompressedTrie a)
m))
      Skip Map (Seq Char) (CompressedTrie a)
m       -> PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
forall a.
PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
CompressedTrie (Map (Seq Char) (CompressedTrie a)
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
forall a tree. tree -> PrefixNode a tree
Skip ((Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a))
-> Map (Seq Char) (CompressedTrie a)
-> Map (Seq Char) (CompressedTrie a)
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
M.foldMapWithKey Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
forall a.
Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
compress1 Map (Seq Char) (CompressedTrie a)
m))

    compress1 :: Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
    compress1 :: Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
compress1 Seq Char
k c :: CompressedTrie a
c@(CompressedTrie PrefixNode a (Map (Seq Char) (CompressedTrie a))
n) =
      case Map (Seq Char) (CompressedTrie a) -> Int
forall k a. Map k a -> Int
M.size Map (Seq Char) (CompressedTrie a)
sm of
        Int
0 -> Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
forall k a. k -> a -> Map k a
M.singleton Seq Char
k CompressedTrie a
c
        Int
1 | Skip Map (Seq Char) (CompressedTrie a)
_ <- PrefixNode a (Map (Seq Char) (CompressedTrie a))
n -> Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
forall a.
Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
compress1 (Seq Char
k Seq Char -> Seq Char -> Seq Char
forall a. Semigroup a => a -> a -> a
<> Seq Char
k') CompressedTrie a
sm'
          where (Seq Char
k', CompressedTrie a
sm') = Map (Seq Char) (CompressedTrie a) -> (Seq Char, CompressedTrie a)
forall k a. Map k a -> (k, a)
M.findMax Map (Seq Char) (CompressedTrie a)
sm
        Int
_ -> Seq Char -> CompressedTrie a -> Map (Seq Char) (CompressedTrie a)
forall k a. k -> a -> Map k a
M.singleton Seq Char
k (CompressedTrie a -> CompressedTrie a
forall a. CompressedTrie a -> CompressedTrie a
go (PrefixNode a (Map (Seq Char) (CompressedTrie a))
n PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> (PrefixNode a (Map (Seq Char) (CompressedTrie a))
    -> PrefixNode a (Map (Seq Char) (CompressedTrie a)))
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
forall a b. a -> (a -> b) -> b
& (Map (Seq Char) (CompressedTrie a)
 -> Identity (Map (Seq Char) (CompressedTrie a)))
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> Identity (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
forall p a b. Lens (PrefixNode p a) (PrefixNode p b) a b
node ((Map (Seq Char) (CompressedTrie a)
  -> Identity (Map (Seq Char) (CompressedTrie a)))
 -> PrefixNode a (Map (Seq Char) (CompressedTrie a))
 -> Identity (PrefixNode a (Map (Seq Char) (CompressedTrie a))))
-> Map (Seq Char) (CompressedTrie a)
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> PrefixNode a (Map (Seq Char) (CompressedTrie a))
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (Seq Char) (CompressedTrie a)
sm PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> (PrefixNode a (Map (Seq Char) (CompressedTrie a))
    -> CompressedTrie a)
-> CompressedTrie a
forall a b. a -> (a -> b) -> b
& PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
forall a.
PrefixNode a (Map (Seq Char) (CompressedTrie a))
-> CompressedTrie a
CompressedTrie))
      where sm :: Map (Seq Char) (CompressedTrie a)
sm = PrefixNode a (Map (Seq Char) (CompressedTrie a))
nPrefixNode a (Map (Seq Char) (CompressedTrie a))
-> Getting
     (Map (Seq Char) (CompressedTrie a))
     (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
     (Map (Seq Char) (CompressedTrie a))
-> Map (Seq Char) (CompressedTrie a)
forall s a. s -> Getting a s a -> a
^.Getting
  (Map (Seq Char) (CompressedTrie a))
  (PrefixNode a (Map (Seq Char) (CompressedTrie a)))
  (Map (Seq Char) (CompressedTrie a))
forall p a b. Lens (PrefixNode p a) (PrefixNode p b) a b
node

--------------------------------------------------------------------------------

-- | A node in a radixtree. To advance from here a parser must parse the 'Text'
-- (i.e., the prefix) value at this node.
data RadixNode a = RadixNode {-# UNPACK #-} !Text !(RadixTree a)
  deriving (RadixNode a -> RadixNode a -> Bool
(RadixNode a -> RadixNode a -> Bool)
-> (RadixNode a -> RadixNode a -> Bool) -> Eq (RadixNode a)
forall a. Eq a => RadixNode a -> RadixNode a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RadixNode a -> RadixNode a -> Bool
$c/= :: forall a. Eq a => RadixNode a -> RadixNode a -> Bool
== :: RadixNode a -> RadixNode a -> Bool
$c== :: forall a. Eq a => RadixNode a -> RadixNode a -> Bool
Eq, Int -> RadixNode a -> ShowS
[RadixNode a] -> ShowS
RadixNode a -> String
(Int -> RadixNode a -> ShowS)
-> (RadixNode a -> String)
-> ([RadixNode a] -> ShowS)
-> Show (RadixNode a)
forall a. Show a => Int -> RadixNode a -> ShowS
forall a. Show a => [RadixNode a] -> ShowS
forall a. Show a => RadixNode a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RadixNode a] -> ShowS
$cshowList :: forall a. Show a => [RadixNode a] -> ShowS
show :: RadixNode a -> String
$cshow :: forall a. Show a => RadixNode a -> String
showsPrec :: Int -> RadixNode a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RadixNode a -> ShowS
Show, Typeable, Typeable (RadixNode a)
DataType
Constr
Typeable (RadixNode a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RadixNode a))
-> (RadixNode a -> Constr)
-> (RadixNode a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RadixNode a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (RadixNode a)))
-> ((forall b. Data b => b -> b) -> RadixNode a -> RadixNode a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RadixNode a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RadixNode a -> r)
-> (forall u. (forall d. Data d => d -> u) -> RadixNode a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RadixNode a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a))
-> Data (RadixNode a)
RadixNode a -> DataType
RadixNode a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (RadixNode a))
(forall b. Data b => b -> b) -> RadixNode a -> RadixNode a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixNode a)
forall a. Data a => Typeable (RadixNode a)
forall a. Data a => RadixNode a -> DataType
forall a. Data a => RadixNode a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> RadixNode a -> RadixNode a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RadixNode a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> RadixNode a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixNode a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixNode a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixNode a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RadixNode a -> u
forall u. (forall d. Data d => d -> u) -> RadixNode a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixNode a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixNode a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixNode a))
$cRadixNode :: Constr
$tRadixNode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
gmapMp :: (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
gmapM :: (forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RadixNode a -> m (RadixNode a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> RadixNode a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RadixNode a -> u
gmapQ :: (forall d. Data d => d -> u) -> RadixNode a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> RadixNode a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixNode a -> r
gmapT :: (forall b. Data b => b -> b) -> RadixNode a -> RadixNode a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> RadixNode a -> RadixNode a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixNode a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixNode a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (RadixNode a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixNode a))
dataTypeOf :: RadixNode a -> DataType
$cdataTypeOf :: forall a. Data a => RadixNode a -> DataType
toConstr :: RadixNode a -> Constr
$ctoConstr :: forall a. Data a => RadixNode a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixNode a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixNode a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixNode a -> c (RadixNode a)
$cp1Data :: forall a. Data a => Typeable (RadixNode a)
Data)

-- | A radixtree. Construct with 'fromFoldable_, and use with 'parse'.
data RadixTree a
  = -- | Can terminate a parser successfully, returning the 'Text' value given.
    RadixAccept
    {-# UNPACK #-} !Text -- ^ text to return at this point
    {-# UNPACK #-} !(Vector (RadixNode a)) -- ^ possible subtrees beyond this point
    a -- ^ value to return at this point
  | RadixSkip
    {-# UNPACK #-} !(Vector (RadixNode a)) -- ^ possible subtrees beyond this point
  deriving (RadixTree a -> RadixTree a -> Bool
(RadixTree a -> RadixTree a -> Bool)
-> (RadixTree a -> RadixTree a -> Bool) -> Eq (RadixTree a)
forall a. Eq a => RadixTree a -> RadixTree a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RadixTree a -> RadixTree a -> Bool
$c/= :: forall a. Eq a => RadixTree a -> RadixTree a -> Bool
== :: RadixTree a -> RadixTree a -> Bool
$c== :: forall a. Eq a => RadixTree a -> RadixTree a -> Bool
Eq, Int -> RadixTree a -> ShowS
[RadixTree a] -> ShowS
RadixTree a -> String
(Int -> RadixTree a -> ShowS)
-> (RadixTree a -> String)
-> ([RadixTree a] -> ShowS)
-> Show (RadixTree a)
forall a. Show a => Int -> RadixTree a -> ShowS
forall a. Show a => [RadixTree a] -> ShowS
forall a. Show a => RadixTree a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RadixTree a] -> ShowS
$cshowList :: forall a. Show a => [RadixTree a] -> ShowS
show :: RadixTree a -> String
$cshow :: forall a. Show a => RadixTree a -> String
showsPrec :: Int -> RadixTree a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RadixTree a -> ShowS
Show, Typeable, Typeable (RadixTree a)
DataType
Constr
Typeable (RadixTree a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RadixTree a))
-> (RadixTree a -> Constr)
-> (RadixTree a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RadixTree a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (RadixTree a)))
-> ((forall b. Data b => b -> b) -> RadixTree a -> RadixTree a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RadixTree a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RadixTree a -> r)
-> (forall u. (forall d. Data d => d -> u) -> RadixTree a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RadixTree a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a))
-> Data (RadixTree a)
RadixTree a -> DataType
RadixTree a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (RadixTree a))
(forall b. Data b => b -> b) -> RadixTree a -> RadixTree a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixTree a)
forall a. Data a => Typeable (RadixTree a)
forall a. Data a => RadixTree a -> DataType
forall a. Data a => RadixTree a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> RadixTree a -> RadixTree a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RadixTree a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> RadixTree a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixTree a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixTree a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixTree a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RadixTree a -> u
forall u. (forall d. Data d => d -> u) -> RadixTree a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixTree a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixTree a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixTree a))
$cRadixSkip :: Constr
$cRadixAccept :: Constr
$tRadixTree :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
gmapMp :: (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
gmapM :: (forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> RadixTree a -> m (RadixTree a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> RadixTree a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RadixTree a -> u
gmapQ :: (forall d. Data d => d -> u) -> RadixTree a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> RadixTree a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RadixTree a -> r
gmapT :: (forall b. Data b => b -> b) -> RadixTree a -> RadixTree a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> RadixTree a -> RadixTree a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixTree a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RadixTree a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (RadixTree a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RadixTree a))
dataTypeOf :: RadixTree a -> DataType
$cdataTypeOf :: forall a. Data a => RadixTree a -> DataType
toConstr :: RadixTree a -> Constr
$ctoConstr :: forall a. Data a => RadixTree a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixTree a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RadixTree a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RadixTree a -> c (RadixTree a)
$cp1Data :: forall a. Data a => Typeable (RadixTree a)
Data)

instance NFData a => NFData (RadixNode a) where
  {-# INLINE rnf #-}
  rnf :: RadixNode a -> ()
rnf (RadixNode Text
l RadixTree a
t) = Text -> ()
forall a. NFData a => a -> ()
rnf Text
l () -> () -> ()
`seq` RadixTree a -> ()
forall a. NFData a => a -> ()
rnf RadixTree a
t

instance NFData a => NFData (RadixTree a) where
  {-# INLINE rnf #-}
  rnf :: RadixTree a -> ()
rnf (RadixAccept Text
t Vector (RadixNode a)
v a
p) = Text
t Text -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
p () -> () -> ()
`seq` Vector (RadixNode a) -> ()
forall a. NFData a => a -> ()
rnf Vector (RadixNode a)
v
  rnf (RadixSkip Vector (RadixNode a)
v)       = Vector (RadixNode a) -> ()
forall a. NFData a => a -> ()
rnf Vector (RadixNode a)
v

-- | Compress a totally-unoptimised 'Trie' into a nice and easily-parsable
-- 'RadixTree'
fromTrie :: Trie a -> RadixTree a
fromTrie :: Trie a -> RadixTree a
fromTrie = CompressedTrie a -> RadixTree a
forall a. CompressedTrie a -> RadixTree a
go (CompressedTrie a -> RadixTree a)
-> (Trie a -> CompressedTrie a) -> Trie a -> RadixTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trie a -> CompressedTrie a
forall a. Trie a -> CompressedTrie a
compress
  where
    !z :: Vector a
z = Vector a
forall a. Vector a
V.empty

    radixNode :: Seq Char -> CompressedTrie a -> RadixNode a
    radixNode :: Seq Char -> CompressedTrie a -> RadixNode a
radixNode Seq Char
l CompressedTrie a
t = Text -> RadixTree a -> RadixNode a
forall a. Text -> RadixTree a -> RadixNode a
RadixNode (String -> Text
T.pack (Seq Char -> String
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Char
l)) (CompressedTrie a -> RadixTree a
forall a. CompressedTrie a -> RadixTree a
go CompressedTrie a
t)

    mapToVector :: Map k a -> Vector (k, a)
    mapToVector :: Map k a -> Vector (k, a)
mapToVector Map k a
m = case Map k a -> Int
forall k a. Map k a -> Int
M.size Map k a
m of
      Int
0  -> Vector (k, a)
forall a. Vector a
z
      Int
sz -> Int -> [(k, a)] -> Vector (k, a)
forall a. Int -> [a] -> Vector a
V.fromListN Int
sz (Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
M.toList Map k a
m)

    go :: CompressedTrie a -> RadixTree a
    go :: CompressedTrie a -> RadixTree a
go (CompressedTrie PrefixNode a (Map (Seq Char) (CompressedTrie a))
n) = case PrefixNode a (Map (Seq Char) (CompressedTrie a))
n of
      Accept Text
l a
p Map (Seq Char) (CompressedTrie a)
m -> Text -> Vector (RadixNode a) -> a -> RadixTree a
forall a. Text -> Vector (RadixNode a) -> a -> RadixTree a
RadixAccept Text
l (((Seq Char, CompressedTrie a) -> RadixNode a)
-> Vector (Seq Char, CompressedTrie a) -> Vector (RadixNode a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Seq Char -> CompressedTrie a -> RadixNode a)
-> (Seq Char, CompressedTrie a) -> RadixNode a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq Char -> CompressedTrie a -> RadixNode a
forall a. Seq Char -> CompressedTrie a -> RadixNode a
radixNode) (Map (Seq Char) (CompressedTrie a)
-> Vector (Seq Char, CompressedTrie a)
forall k a. Map k a -> Vector (k, a)
mapToVector Map (Seq Char) (CompressedTrie a)
m)) a
p
      Skip Map (Seq Char) (CompressedTrie a)
m       -> Vector (RadixNode a) -> RadixTree a
forall a. Vector (RadixNode a) -> RadixTree a
RadixSkip (Vector (RadixNode a) -> RadixTree a)
-> (Map (Seq Char) (CompressedTrie a) -> Vector (RadixNode a))
-> Map (Seq Char) (CompressedTrie a)
-> RadixTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Seq Char, CompressedTrie a) -> RadixNode a)
-> Vector (Seq Char, CompressedTrie a) -> Vector (RadixNode a)
forall a b. (a -> b) -> Vector a -> Vector b
V.map ((Seq Char -> CompressedTrie a -> RadixNode a)
-> (Seq Char, CompressedTrie a) -> RadixNode a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Seq Char -> CompressedTrie a -> RadixNode a
forall a. Seq Char -> CompressedTrie a -> RadixNode a
radixNode) (Vector (Seq Char, CompressedTrie a) -> Vector (RadixNode a))
-> (Map (Seq Char) (CompressedTrie a)
    -> Vector (Seq Char, CompressedTrie a))
-> Map (Seq Char) (CompressedTrie a)
-> Vector (RadixNode a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Seq Char) (CompressedTrie a)
-> Vector (Seq Char, CompressedTrie a)
forall k a. Map k a -> Vector (k, a)
mapToVector (Map (Seq Char) (CompressedTrie a) -> RadixTree a)
-> Map (Seq Char) (CompressedTrie a) -> RadixTree a
forall a b. (a -> b) -> a -> b
$! Map (Seq Char) (CompressedTrie a)
m

data TextSlice = TextSlice
  { TextSlice -> Int
tsOffset16 :: {-# UNPACK #-} !Int -- ^ offset (in units of Word16)
  , TextSlice -> Int
tsLength16 :: {-# UNPACK #-} !Int -- ^ length (in units of Word16)
  }

-- | Probably dangerous magic
--
-- When the second argument is found to be within the first, we re-use the
-- 'Text' array of the first. This should allow the second argument to be
-- garbage collected. This is to improve locality and memory use.
magicallySaveSpaceSometimes :: Text -> Text -> Maybe TextSlice
magicallySaveSpaceSometimes :: Text -> Text -> Maybe TextSlice
magicallySaveSpaceSometimes Text
full s :: Text
s@(TI.Text Array
_ Int
_ Int
slen) =
  case Text -> Text -> (Text, Text)
T.breakOn Text
s Text
full of
    (TI.Text{}, r :: Text
r@(TI.Text Array
_ Int
remoffs Int
_))
      | Text -> Bool
T.null Text
r  -> Maybe TextSlice
forall a. Maybe a
Nothing
      | Bool
otherwise -> TextSlice -> Maybe TextSlice
forall a. a -> Maybe a
Just TextSlice :: Int -> Int -> TextSlice
TextSlice{tsOffset16 :: Int
tsOffset16 = Int
remoffs, tsLength16 :: Int
tsLength16 = Int
slen}

-- | A normal 'RadixTree' stores a new 'Text' at every node. In contrast, a
-- 'CompressedRadixTree' takes a single corpus 'Text' which is indexed into by
-- nodes. This can save a lot of memory (e.g., using the radix trees from the
-- parsing benchmarks in this package, the 'CompressedRadixTree' version is
-- 254032 bytes, whereas the ordinary 'RadixTree' is a rotund 709904 bytes) at
-- no runtime cost.
data CompressedRadixTree a
  = CompressedRadixTree {-# UNPACK #-} !TI.Array !(CompressedRadixTree1 a)

data CompressedRadixTree1 a
  = CompressedRadixAccept
    {-# UNPACK #-} !TextSlice
    {-# UNPACK #-} !(Vector (CompressedRadixNode a))
    a
  | CompressedRadixSkip {-# UNPACK #-} !(Vector (CompressedRadixNode a))

data CompressedRadixNode a
  = CompressedRadixNode {-# UNPACK #-} !TextSlice !(CompressedRadixTree1 a)

instance NFData a => NFData (CompressedRadixNode a) where
  {-# INLINE rnf #-}
  rnf :: CompressedRadixNode a -> ()
rnf (CompressedRadixNode TextSlice
ts CompressedRadixTree1 a
t) = TextSlice
ts TextSlice -> () -> ()
`seq` CompressedRadixTree1 a -> ()
forall a. NFData a => a -> ()
rnf CompressedRadixTree1 a
t

instance NFData a => NFData (CompressedRadixTree a) where
  {-# INLINE rnf #-}
  rnf :: CompressedRadixTree a -> ()
rnf (CompressedRadixTree Array
arr CompressedRadixTree1 a
v) = Array
arr Array -> () -> ()
`seq` CompressedRadixTree1 a -> ()
forall a. NFData a => a -> ()
rnf CompressedRadixTree1 a
v

instance NFData a => NFData (CompressedRadixTree1 a) where
  {-# INLINE rnf #-}
  rnf :: CompressedRadixTree1 a -> ()
rnf (CompressedRadixAccept TextSlice
ts Vector (CompressedRadixNode a)
v a
a) = TextSlice
ts TextSlice -> () -> ()
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
a () -> () -> ()
`seq` Vector (CompressedRadixNode a) -> ()
forall a. NFData a => a -> ()
rnf Vector (CompressedRadixNode a)
v
  rnf (CompressedRadixSkip Vector (CompressedRadixNode a)
v)        = Vector (CompressedRadixNode a) -> ()
forall a. NFData a => a -> ()
rnf Vector (CompressedRadixNode a)
v

-- | Compress a 'RadixTree' given a corpus. All values in the tree must be
-- findable within the corpus, though the corpus does not have to necessarily be
-- the direct source of the tree
compressBy :: Text -> RadixTree a -> Maybe (CompressedRadixTree a)
compressBy :: Text -> RadixTree a -> Maybe (CompressedRadixTree a)
compressBy full :: Text
full@(TI.Text Array
arr Int
_ Int
_) RadixTree a
rt =
  Array -> CompressedRadixTree1 a -> CompressedRadixTree a
forall a. Array -> CompressedRadixTree1 a -> CompressedRadixTree a
CompressedRadixTree Array
arr (CompressedRadixTree1 a -> CompressedRadixTree a)
-> Maybe (CompressedRadixTree1 a) -> Maybe (CompressedRadixTree a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RadixTree a -> Maybe (CompressedRadixTree1 a)
forall a. RadixTree a -> Maybe (CompressedRadixTree1 a)
recompressT RadixTree a
rt

  where
    magic :: Text -> Maybe TextSlice
magic = Text -> Text -> Maybe TextSlice
magicallySaveSpaceSometimes Text
full

    recompressN :: RadixNode a -> Maybe (CompressedRadixNode a)
    recompressN :: RadixNode a -> Maybe (CompressedRadixNode a)
recompressN (RadixNode Text
t RadixTree a
tree) = TextSlice -> CompressedRadixTree1 a -> CompressedRadixNode a
forall a.
TextSlice -> CompressedRadixTree1 a -> CompressedRadixNode a
CompressedRadixNode (TextSlice -> CompressedRadixTree1 a -> CompressedRadixNode a)
-> Maybe TextSlice
-> Maybe (CompressedRadixTree1 a -> CompressedRadixNode a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe TextSlice
magic Text
t Maybe (CompressedRadixTree1 a -> CompressedRadixNode a)
-> Maybe (CompressedRadixTree1 a) -> Maybe (CompressedRadixNode a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RadixTree a -> Maybe (CompressedRadixTree1 a)
forall a. RadixTree a -> Maybe (CompressedRadixTree1 a)
recompressT RadixTree a
tree

    recompressT :: RadixTree a -> Maybe (CompressedRadixTree1 a)
    recompressT :: RadixTree a -> Maybe (CompressedRadixTree1 a)
recompressT (RadixSkip Vector (RadixNode a)
v)       = Vector (CompressedRadixNode a) -> CompressedRadixTree1 a
forall a. Vector (CompressedRadixNode a) -> CompressedRadixTree1 a
CompressedRadixSkip (Vector (CompressedRadixNode a) -> CompressedRadixTree1 a)
-> Maybe (Vector (CompressedRadixNode a))
-> Maybe (CompressedRadixTree1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (RadixNode a -> Maybe (CompressedRadixNode a))
-> Vector (RadixNode a) -> Maybe (Vector (CompressedRadixNode a))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM RadixNode a -> Maybe (CompressedRadixNode a)
forall a. RadixNode a -> Maybe (CompressedRadixNode a)
recompressN Vector (RadixNode a)
v
    recompressT (RadixAccept Text
t Vector (RadixNode a)
v a
a) = TextSlice
-> Vector (CompressedRadixNode a) -> a -> CompressedRadixTree1 a
forall a.
TextSlice
-> Vector (CompressedRadixNode a) -> a -> CompressedRadixTree1 a
CompressedRadixAccept (TextSlice
 -> Vector (CompressedRadixNode a) -> a -> CompressedRadixTree1 a)
-> Maybe TextSlice
-> Maybe
     (Vector (CompressedRadixNode a) -> a -> CompressedRadixTree1 a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe TextSlice
magic Text
t Maybe
  (Vector (CompressedRadixNode a) -> a -> CompressedRadixTree1 a)
-> Maybe (Vector (CompressedRadixNode a))
-> Maybe (a -> CompressedRadixTree1 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (RadixNode a -> Maybe (CompressedRadixNode a))
-> Vector (RadixNode a) -> Maybe (Vector (CompressedRadixNode a))
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Vector a -> m (Vector b)
V.mapM RadixNode a -> Maybe (CompressedRadixNode a)
forall a. RadixNode a -> Maybe (CompressedRadixNode a)
recompressN Vector (RadixNode a)
v Maybe (a -> CompressedRadixTree1 a)
-> Maybe a -> Maybe (CompressedRadixTree1 a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | *Slow*. Same as 'fromFoldable', but you do not need to supply pairs of text
-- and values; they will default to '()'.
fromFoldable_ :: Foldable f => f Text -> RadixTree ()
fromFoldable_ :: f Text -> RadixTree ()
fromFoldable_ =
  Trie () -> RadixTree ()
forall a. Trie a -> RadixTree a
fromTrie (Trie () -> RadixTree ())
-> (f Text -> Trie ()) -> f Text -> RadixTree ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Trie () -> Trie ()) -> Trie () -> f Text -> Trie ()
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\Text
t -> Text -> Text -> () -> Trie () -> Trie ()
forall a. Text -> Text -> a -> Trie a -> Trie a
insert Text
t Text
t ()) (PrefixNode () (Map Char (Trie ())) -> Trie ()
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (Map Char (Trie ()) -> PrefixNode () (Map Char (Trie ()))
forall a tree. tree -> PrefixNode a tree
Skip Map Char (Trie ())
forall k a. Map k a
M.empty))

-- | *Slow*
fromFoldable :: Foldable f => f (Text, a) -> RadixTree a
fromFoldable :: f (Text, a) -> RadixTree a
fromFoldable =
  Trie a -> RadixTree a
forall a. Trie a -> RadixTree a
fromTrie (Trie a -> RadixTree a)
-> (f (Text, a) -> Trie a) -> f (Text, a) -> RadixTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, a) -> Trie a -> Trie a) -> Trie a -> f (Text, a) -> Trie a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr' (\(Text
t, a
a) -> Text -> Text -> a -> Trie a -> Trie a
forall a. Text -> Text -> a -> Trie a -> Trie a
insert Text
t Text
t a
a) (PrefixNode a (Map Char (Trie a)) -> Trie a
forall a. PrefixNode a (Map Char (Trie a)) -> Trie a
Trie (Map Char (Trie a) -> PrefixNode a (Map Char (Trie a))
forall a tree. tree -> PrefixNode a tree
Skip Map Char (Trie a)
forall k a. Map k a
M.empty))

--------------------------------------------------------------------------------
-- Parsers from 'RadixTree's

class RadixParsing radixtree where
  keys :: radixtree a -> [(Text, a)]
  parse :: CharParsing m => (Text -> a -> r) -> radixtree a -> m r
  lookup :: radixtree a -> Text -> Maybe (Text, a)

{-# INLINE search #-}
-- | Find all occurences of the terms in a 'RadixTree' from this point on. This
-- will consume the entire remaining input. Can lazily produce results (but this
-- depends on your parser).
search
  :: (Monad m, CharParsing m, RadixParsing radixtree)
  => radixtree a
  -> m [Text]
search :: radixtree a -> m [Text]
search radixtree a
r = m [Text]
go
  where
    go :: m [Text]
go =
      ((Text -> a -> Text) -> radixtree a -> m Text
forall (radixtree :: * -> *) (m :: * -> *) a r.
(RadixParsing radixtree, CharParsing m) =>
(Text -> a -> r) -> radixtree a -> m r
parse Text -> a -> Text
forall a b. a -> b -> a
const radixtree a
r m Text -> (Text -> m [Text]) -> m [Text]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
x -> (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> m [Text] -> m [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Text]
go) m [Text] -> m [Text] -> m [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (m Char
forall (m :: * -> *). CharParsing m => m Char
anyChar m Char -> m [Text] -> m [Text]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m [Text]
go) m [Text] -> m [Text] -> m [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return []

{-# INLINE parse_ #-}
parse_ :: (RadixParsing r, CharParsing m) => r a -> m Text
parse_ :: r a -> m Text
parse_ = (Text -> a -> Text) -> r a -> m Text
forall (radixtree :: * -> *) (m :: * -> *) a r.
(RadixParsing radixtree, CharParsing m) =>
(Text -> a -> r) -> radixtree a -> m r
Data.RadixTree.parse Text -> a -> Text
forall a b. a -> b -> a
const

{-# INLINE lookup_ #-}
lookup_ :: RadixParsing r => r a -> Text -> Maybe Text
lookup_ :: r a -> Text -> Maybe Text
lookup_ r a
r Text
t = (Text, a) -> Text
forall a b. (a, b) -> a
fst ((Text, a) -> Text) -> Maybe (Text, a) -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> r a -> Text -> Maybe (Text, a)
forall (radixtree :: * -> *) a.
RadixParsing radixtree =>
radixtree a -> Text -> Maybe (Text, a)
Data.RadixTree.lookup r a
r Text
t

instance RadixParsing RadixTree where
  keys :: RadixTree a -> [(Text, a)]
keys = [(Text, a)] -> RadixTree a -> [(Text, a)]
forall a. [(Text, a)] -> RadixTree a -> [(Text, a)]
go []
    where
      go :: [(Text, a)] -> RadixTree a -> [(Text, a)]
go [(Text, a)]
nil (RadixAccept Text
l Vector (RadixNode a)
xs a
a) = (Text
l,a
a) (Text, a) -> [(Text, a)] -> [(Text, a)]
forall a. a -> [a] -> [a]
: (RadixNode a -> [(Text, a)] -> [(Text, a)])
-> [(Text, a)] -> Vector (RadixNode a) -> [(Text, a)]
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\(RadixNode Text
_ RadixTree a
x) [(Text, a)]
xs' -> [(Text, a)] -> RadixTree a -> [(Text, a)]
go [(Text, a)]
xs' RadixTree a
x) [(Text, a)]
nil Vector (RadixNode a)
xs
      go [(Text, a)]
nil (RadixSkip Vector (RadixNode a)
xs) = (RadixNode a -> [(Text, a)] -> [(Text, a)])
-> [(Text, a)] -> Vector (RadixNode a) -> [(Text, a)]
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\(RadixNode Text
_ RadixTree a
x) [(Text, a)]
xs' -> [(Text, a)] -> RadixTree a -> [(Text, a)]
go [(Text, a)]
xs' RadixTree a
x) [(Text, a)]
nil Vector (RadixNode a)
xs

  {-# INLINE parse #-}
  -- | Parse from a 'RadixTree'
  parse :: CharParsing m => (Text -> a -> r) -> RadixTree a -> m r
  parse :: (Text -> a -> r) -> RadixTree a -> m r
parse Text -> a -> r
constr = RadixTree a -> m r
go
    where
      go :: RadixTree a -> m r
go RadixTree a
r = case RadixTree a
r of
        RadixAccept Text
l Vector (RadixNode a)
nodes a
a
          | Text -> Bool
T.null Text
l -> m r
forall (f :: * -> *) a. Alternative f => f a
empty
          | Bool
otherwise -> Vector (m r) -> m r
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((RadixNode a -> m r) -> Vector (RadixNode a) -> Vector (m r)
forall a b. (a -> b) -> Vector a -> Vector b
V.map RadixNode a -> m r
parseRadixNode Vector (RadixNode a)
nodes) m r -> m r -> m r
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a -> r
constr Text
l a
a)
        RadixSkip Vector (RadixNode a)
nodes ->
          Vector (m r) -> m r
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((RadixNode a -> m r) -> Vector (RadixNode a) -> Vector (m r)
forall a b. (a -> b) -> Vector a -> Vector b
V.map RadixNode a -> m r
parseRadixNode Vector (RadixNode a)
nodes)

      {-# INLINE parseRadixNode #-}
      parseRadixNode :: RadixNode a -> m r
parseRadixNode (RadixNode Text
prefix RadixTree a
tree)
        | Text -> Bool
T.null Text
prefix = RadixTree a -> m r
go RadixTree a
tree
        | Bool
otherwise     = m r -> m r
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
text Text
prefix m Text -> m r -> m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RadixTree a -> m r
go RadixTree a
tree)

  lookup :: RadixTree a -> Text -> Maybe (Text, a)
  lookup :: RadixTree a -> Text -> Maybe (Text, a)
lookup RadixTree a
rt0 Text
t0
    | Text -> Bool
T.null Text
t0 = case RadixTree a
rt0 of
        RadixAccept Text
v Vector (RadixNode a)
_ a
a -> (Text, a) -> Maybe (Text, a)
forall a. a -> Maybe a
Just (Text
v, a
a)
        RadixSkip Vector (RadixNode a)
_       -> Maybe (Text, a)
forall a. Maybe a
Nothing
    | Bool
otherwise = case RadixTree a
rt0 of
        RadixAccept Text
_ Vector (RadixNode a)
ns a
_ -> Text -> Vector (RadixNode a) -> Maybe (Text, a)
forall a. Text -> Vector (RadixNode a) -> Maybe (Text, a)
lookupRadixNodes Text
t0 Vector (RadixNode a)
ns
        RadixSkip     Vector (RadixNode a)
ns   -> Text -> Vector (RadixNode a) -> Maybe (Text, a)
forall a. Text -> Vector (RadixNode a) -> Maybe (Text, a)
lookupRadixNodes Text
t0 Vector (RadixNode a)
ns
    where
      lookupRadixNodes :: Text -> Vector (RadixNode a) -> Maybe (Text, a)
lookupRadixNodes Text
t Vector (RadixNode a)
v = Int -> Maybe (Text, a)
go Int
0
        where
          !vlen :: Int
vlen = Vector (RadixNode a) -> Int
forall a. Vector a -> Int
V.length Vector (RadixNode a)
v
          go :: Int -> Maybe (Text, a)
go !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
vlen  = case Vector (RadixNode a) -> Int -> RadixNode a
forall a. Vector a -> Int -> a
V.unsafeIndex Vector (RadixNode a)
v Int
i of
                RadixNode Text
pfix RadixTree a
rt -> case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes Text
pfix Text
t of
                  Just (Text
_, Text
remPfx, Text
remSfx)
                    | Text -> Bool
T.null Text
remPfx -> RadixTree a -> Text -> Maybe (Text, a)
forall (radixtree :: * -> *) a.
RadixParsing radixtree =>
radixtree a -> Text -> Maybe (Text, a)
Data.RadixTree.lookup RadixTree a
rt Text
remSfx
                    | Bool
otherwise     -> Maybe (Text, a)
forall a. Maybe a
Nothing
                  Maybe (Text, Text, Text)
Nothing -> Int -> Maybe (Text, a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            | Bool
otherwise = Maybe (Text, a)
forall a. Maybe a
Nothing

instance RadixParsing CompressedRadixTree where

  keys :: CompressedRadixTree a -> [(Text, a)]
keys (CompressedRadixTree Array
arr CompressedRadixTree1 a
crt) = [(Text, a)] -> CompressedRadixTree1 a -> [(Text, a)]
go [] CompressedRadixTree1 a
crt
    where
      fromSlice :: TextSlice -> Text
fromSlice (TextSlice Int
offs Int
len) = Array -> Int -> Int -> Text
TI.text Array
arr Int
offs Int
len

      go :: [(Text, a)] -> CompressedRadixTree1 a -> [(Text, a)]
go [(Text, a)]
nil (CompressedRadixAccept TextSlice
l Vector (CompressedRadixNode a)
xs a
a) =
        (TextSlice -> Text
fromSlice TextSlice
l, a
a) (Text, a) -> [(Text, a)] -> [(Text, a)]
forall a. a -> [a] -> [a]
: (CompressedRadixNode a -> [(Text, a)] -> [(Text, a)])
-> [(Text, a)] -> Vector (CompressedRadixNode a) -> [(Text, a)]
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\(CompressedRadixNode TextSlice
_ CompressedRadixTree1 a
x) [(Text, a)]
xs' -> [(Text, a)] -> CompressedRadixTree1 a -> [(Text, a)]
go [(Text, a)]
xs' CompressedRadixTree1 a
x) [(Text, a)]
nil Vector (CompressedRadixNode a)
xs
      go [(Text, a)]
nil (CompressedRadixSkip Vector (CompressedRadixNode a)
xs) =
        (CompressedRadixNode a -> [(Text, a)] -> [(Text, a)])
-> [(Text, a)] -> Vector (CompressedRadixNode a) -> [(Text, a)]
forall a b. (a -> b -> b) -> b -> Vector a -> b
V.foldr (\(CompressedRadixNode TextSlice
_ CompressedRadixTree1 a
x) [(Text, a)]
xs' -> [(Text, a)] -> CompressedRadixTree1 a -> [(Text, a)]
go [(Text, a)]
xs' CompressedRadixTree1 a
x) [(Text, a)]
nil Vector (CompressedRadixNode a)
xs

  {-# INLINE parse #-}
  -- | Parse from a 'RadixTree'
  parse :: CharParsing m => (Text -> a -> r) -> CompressedRadixTree a -> m r
  parse :: (Text -> a -> r) -> CompressedRadixTree a -> m r
parse Text -> a -> r
constr (CompressedRadixTree Array
arr CompressedRadixTree1 a
crt) = CompressedRadixTree1 a -> m r
go CompressedRadixTree1 a
crt
    where
      fromSlice :: TextSlice -> Text
fromSlice (TextSlice Int
offs Int
len) = Array -> Int -> Int -> Text
TI.text Array
arr Int
offs Int
len
      go :: CompressedRadixTree1 a -> m r
go CompressedRadixTree1 a
r = case CompressedRadixTree1 a
r of
        CompressedRadixAccept TextSlice
ts Vector (CompressedRadixNode a)
nodes a
a -> case TextSlice -> Text
fromSlice TextSlice
ts of
          Text
l | Text -> Bool
T.null Text
l -> m r
forall (f :: * -> *) a. Alternative f => f a
empty
            | Bool
otherwise -> Vector (m r) -> m r
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((CompressedRadixNode a -> m r)
-> Vector (CompressedRadixNode a) -> Vector (m r)
forall a b. (a -> b) -> Vector a -> Vector b
V.map CompressedRadixNode a -> m r
parseRadixNode Vector (CompressedRadixNode a)
nodes) m r -> m r -> m r
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> r -> m r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> a -> r
constr Text
l a
a)
        CompressedRadixSkip Vector (CompressedRadixNode a)
nodes -> Vector (m r) -> m r
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ((CompressedRadixNode a -> m r)
-> Vector (CompressedRadixNode a) -> Vector (m r)
forall a b. (a -> b) -> Vector a -> Vector b
V.map CompressedRadixNode a -> m r
parseRadixNode Vector (CompressedRadixNode a)
nodes)
      {-# INLINE parseRadixNode #-}
      parseRadixNode :: CompressedRadixNode a -> m r
parseRadixNode (CompressedRadixNode TextSlice
ts CompressedRadixTree1 a
tree) = case TextSlice -> Text
fromSlice TextSlice
ts of
        Text
prefix | Text -> Bool
T.null Text
prefix -> CompressedRadixTree1 a -> m r
go CompressedRadixTree1 a
tree
               | Bool
otherwise     -> m r -> m r
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Text -> m Text
forall (m :: * -> *). CharParsing m => Text -> m Text
text Text
prefix m Text -> m r -> m r
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> CompressedRadixTree1 a -> m r
go CompressedRadixTree1 a
tree)

  lookup :: CompressedRadixTree a -> Text -> Maybe (Text, a)
  lookup :: CompressedRadixTree a -> Text -> Maybe (Text, a)
lookup (CompressedRadixTree Array
arr0 CompressedRadixTree1 a
rt0) = CompressedRadixTree1 a -> Text -> Maybe (Text, a)
lookup1 CompressedRadixTree1 a
rt0
    where
      fromSlice :: TextSlice -> Text
fromSlice (TextSlice Int
offs16 Int
len16) = Array -> Int -> Int -> Text
TI.text Array
arr0 Int
offs16 Int
len16

      lookup1 :: CompressedRadixTree1 a -> Text -> Maybe (Text, a)
lookup1 CompressedRadixTree1 a
rt !Text
t
        | Text -> Bool
T.null Text
t = case CompressedRadixTree1 a
rt of
            CompressedRadixAccept TextSlice
v Vector (CompressedRadixNode a)
_ a
a -> (Text, a) -> Maybe (Text, a)
forall a. a -> Maybe a
Just (TextSlice -> Text
fromSlice TextSlice
v, a
a)
            CompressedRadixSkip Vector (CompressedRadixNode a)
_       -> Maybe (Text, a)
forall a. Maybe a
Nothing
        | Bool
otherwise = case CompressedRadixTree1 a
rt of
            CompressedRadixAccept TextSlice
_ Vector (CompressedRadixNode a)
ns a
_ -> Text -> Vector (CompressedRadixNode a) -> Maybe (Text, a)
lookupCompressedRadixNodes Text
t Vector (CompressedRadixNode a)
ns
            CompressedRadixSkip     Vector (CompressedRadixNode a)
ns   -> Text -> Vector (CompressedRadixNode a) -> Maybe (Text, a)
lookupCompressedRadixNodes Text
t Vector (CompressedRadixNode a)
ns

      lookupCompressedRadixNodes :: Text -> Vector (CompressedRadixNode a) -> Maybe (Text, a)
lookupCompressedRadixNodes !Text
t Vector (CompressedRadixNode a)
v = Int -> Maybe (Text, a)
go Int
0
        where
          !vlen :: Int
vlen = Vector (CompressedRadixNode a) -> Int
forall a. Vector a -> Int
V.length Vector (CompressedRadixNode a)
v
          go :: Int -> Maybe (Text, a)
go !Int
i
            | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
vlen  = case Vector (CompressedRadixNode a) -> Int -> CompressedRadixNode a
forall a. Vector a -> Int -> a
V.unsafeIndex Vector (CompressedRadixNode a)
v Int
i of
                CompressedRadixNode TextSlice
pfix CompressedRadixTree1 a
rt -> case Text -> Text -> Maybe (Text, Text, Text)
T.commonPrefixes (TextSlice -> Text
fromSlice TextSlice
pfix) Text
t of
                  Just (Text
_, Text
remPfx, Text
remSfx)
                    | Text -> Bool
T.null Text
remPfx -> CompressedRadixTree1 a -> Text -> Maybe (Text, a)
lookup1 CompressedRadixTree1 a
rt Text
remSfx
                    | Bool
otherwise     -> Maybe (Text, a)
forall a. Maybe a
Nothing
                  Maybe (Text, Text, Text)
Nothing -> Int -> Maybe (Text, a)
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
            | Bool
otherwise = Maybe (Text, a)
forall a. Maybe a
Nothing