{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, ExistentialQuantification #-}
{- |

Module:      Text.AhoCorasick
Copyright:   Sergey S Lymar (c) 2012
License:     BSD-3-Clause
Maintainer:  Sergey S Lymar <sergey.lymar@gmail.com>
Stability:   experimental
Portability: portable

Aho-Corasick string matching algorithm

= Simplest example

@
example1 = mapM_ print $ findAll simpleSM \"ushers\" where
    simpleSM = makeSimpleStateMachine [\"he\",\"she\",\"his\",\"hers\"]
@

@
Position {pIndex = 1, pLength = 3, pVal = \"she\"}
Position {pIndex = 2, pLength = 2, pVal = \"he\"}
Position {pIndex = 2, pLength = 4, pVal = \"hers\"}
@

= With data

@
example2 = mapM_ print $ findAll sm \"ushers\" where
    sm = makeStateMachine [(\"he\",0),(\"she\",1),(\"his\",2),(\"hers\",3)]
@

@
Position {pIndex = 1, pLength = 3, pVal = 1}
Position {pIndex = 2, pLength = 2, pVal = 0}
Position {pIndex = 2, pLength = 4, pVal = 3}
@

= Step-by-step state machine evaluation

@
example3 = mapM_ print $ next sm \"ushers\" where
    sm = makeSimpleStateMachine [\"he\",\"she\",\"his\",\"hers\"]
    next _ [] = []
    next sm (s:n) = let (SMStepRes match nextSM) = stateMachineStep sm s in
        (s, match) : next nextSM n
@

@
(\'u\',[])
(\'s\',[])
(\'h\',[])
(\'e\',[(3,\"she\"),(2,\"he\")])
(\'r\',[])
(\'s\',[(4,\"hers\")])
@
-}
module Text.AhoCorasick (
      -- ** Basic interface
      makeStateMachine
    , makeSimpleStateMachine
    , findAll
    , Position(..)
      -- ** Low-level interface
    , stateMachineStep
    , SMStepRes(..)
    , resetStateMachine
    -- ** Types
    , StateMachine
    , KeyLength
    ) where

import Control.Monad.State.Lazy (execStateT, get, put)
import Control.Monad.ST.Strict (ST, runST)
import Control.Monad.Trans (lift)
import Data.Array.IArray (Array, array, (!))
import Data.Functor ((<&>))
import Data.Hashable (Hashable)
import Data.Maybe (fromJust)
import Data.STRef (STRef, newSTRef, readSTRef, writeSTRef, modifySTRef)
import qualified Data.HashMap.Strict as M

import Text.AhoCorasick.Internal.Deque (mkDQ, pushBack, popFront, dqLength, DQ)

data (Eq keySymb, Hashable keySymb) => TNode keySymb s =
    TNode {
          forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Int
tnId          :: Int
        , forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks       :: M.HashMap keySymb (STRef s (TNode keySymb s))
        , forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Maybe (STRef s (TNode keySymb s))
tnFail        :: Maybe (STRef s (TNode keySymb s))
        , forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> [Int]
tnValuesIds   :: [Int]
    }

type KeyLength = Int

data (Eq keySymb, Hashable keySymb) => TTree keySymb val s =
    TTree {
          forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s (TNode keySymb s)
ttRoot        :: STRef s (TNode keySymb s)
        , forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s Int
ttLastId      :: STRef s Int
        , forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> DQ (Int, val) s
ttValues      :: DQ (KeyLength, val) s
    }

type NodeIndex = Int

data (Eq keySymb, Hashable keySymb) => SMElem keySymb =
    SMElem {
          forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> HashMap keySymb Int
smeLinks      :: M.HashMap keySymb NodeIndex
        , forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> Int
smeFail       :: NodeIndex
        , forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> [Int]
smeValuesIds  :: [Int]
    }

data (Eq keySymb, Hashable keySymb) => StateMachine keySymb val =
    StateMachine {
          forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Array Int (SMElem keySymb)
smStates      :: Array NodeIndex (SMElem keySymb)
        , forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Array Int (Int, val)
smValues      :: Array Int (KeyLength, val)
        , forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Int
smState       :: Int
    }

data (Eq keySymb, Hashable keySymb) => SMStepRes keySymb val =
    SMStepRes {
          forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
SMStepRes keySymb val -> [(Int, val)]
smsrMatch     :: [(KeyLength, val)]
        , forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
SMStepRes keySymb val -> StateMachine keySymb val
smsrNextSM    :: StateMachine keySymb val
    }

data Position val =
    Position {
          forall val. Position val -> Int
pIndex        :: Int
        , forall val. Position val -> Int
pLength       :: Int
        , forall val. Position val -> val
pVal          :: val
    }

instance (Eq keySymb, Hashable keySymb, Show keySymb) =>
                                                    Show (SMElem keySymb) where
    show :: SMElem keySymb -> String
show (SMElem HashMap keySymb Int
l Int
f [Int]
v) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"SMElem {smeLinks = ", forall a. Show a => a -> String
show HashMap keySymb Int
l,
        String
", smeFail = ", forall a. Show a => a -> String
show Int
f,String
", smeValuesIds = ", forall a. Show a => a -> String
show [Int]
v, String
"}"]

instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) =>
                                        Show (StateMachine keySymb val) where
    show :: StateMachine keySymb val -> String
show (StateMachine Array Int (SMElem keySymb)
st Array Int (Int, val)
vals Int
state) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"StateMachine {smStates = ", forall a. Show a => a -> String
show Array Int (SMElem keySymb)
st,
        String
", smValues = ", forall a. Show a => a -> String
show Array Int (Int, val)
vals, String
", smState = ", forall a. Show a => a -> String
show Int
state,String
"}"]

instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) =>
                                            Show (SMStepRes keySymb val) where
    show :: SMStepRes keySymb val -> String
show (SMStepRes [(Int, val)]
f StateMachine keySymb val
n) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"StateMachineStepRes {smsrFound = ", forall a. Show a => a -> String
show [(Int, val)]
f,
        String
", smsrNewSM = ", forall a. Show a => a -> String
show StateMachine keySymb val
n,String
"}"]

instance (Show val) => Show (Position val) where
    show :: Position val -> String
show (Position Int
i Int
l val
v) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        String
"Position {pIndex = ", forall a. Show a => a -> String
show Int
i,
        String
", pLength = ", forall a. Show a => a -> String
show Int
l,
        String
", pVal = ", forall a. Show a => a -> String
show val
v,String
"}"]

(~>) :: t1 -> (t1 -> t2) -> t2
t1
x ~> :: forall t1 t2. t1 -> (t1 -> t2) -> t2
~> t1 -> t2
f = t1 -> t2
f t1
x
infixl 9 ~>

rootNodeId :: Int
rootNodeId :: Int
rootNodeId = Int
0

initNewTTree :: (Eq keySymb, Hashable keySymb) => ST s (TTree keySymb a s)
initNewTTree :: forall keySymb s a.
(Eq keySymb, Hashable keySymb) =>
ST s (TTree keySymb a s)
initNewTTree = do
    STRef s (TNode keySymb s)
root <- forall a s. a -> ST s (STRef s a)
newSTRef forall a b. (a -> b) -> a -> b
$ forall keySymb s.
Int
-> HashMap keySymb (STRef s (TNode keySymb s))
-> Maybe (STRef s (TNode keySymb s))
-> [Int]
-> TNode keySymb s
TNode Int
rootNodeId forall k v. HashMap k v
M.empty forall a. Maybe a
Nothing []
    STRef s Int
lid <- forall a s. a -> ST s (STRef s a)
newSTRef Int
rootNodeId
    forall keySymb val s.
STRef s (TNode keySymb s)
-> STRef s Int -> DQ (Int, val) s -> TTree keySymb val s
TTree STRef s (TNode keySymb s)
root STRef s Int
lid forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s a. ST s (DQ a s)
mkDQ

mkNewTNode :: (Eq keySymb, Hashable keySymb) =>
    TTree keySymb a s -> ST s (TNode keySymb s)
mkNewTNode :: forall keySymb a s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb a s -> ST s (TNode keySymb s)
mkNewTNode TTree keySymb a s
tree = do
    forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s Int
lid (forall a. Num a => a -> a -> a
+Int
1)
    Int
lv <- forall s a. STRef s a -> ST s a
readSTRef STRef s Int
lid
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall keySymb s.
Int
-> HashMap keySymb (STRef s (TNode keySymb s))
-> Maybe (STRef s (TNode keySymb s))
-> [Int]
-> TNode keySymb s
TNode Int
lv forall k v. HashMap k v
M.empty forall a. Maybe a
Nothing []
    where
    lid :: STRef s Int
lid = forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s Int
ttLastId TTree keySymb a s
tree

addKeyVal :: forall val s keySymb. (Eq keySymb, Hashable keySymb) =>
    TTree keySymb val s -> [keySymb] -> val -> ST s ()
addKeyVal :: forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> [keySymb] -> val -> ST s ()
addKeyVal TTree keySymb val s
tree [keySymb]
key val
val = STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
addSymb (forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s (TNode keySymb s)
ttRoot TTree keySymb val s
tree) [keySymb]
key
    where
    addSymb :: STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
    addSymb :: STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
addSymb STRef s (TNode keySymb s)
node [] = do
        Int
vi <- forall a s. DQ a s -> ST s Int
dqLength (forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> DQ (Int, val) s
ttValues TTree keySymb val s
tree)
        forall a s. DQ a s -> a -> ST s ()
pushBack (forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> DQ (Int, val) s
ttValues TTree keySymb val s
tree) (forall (t :: * -> *) a. Foldable t => t a -> Int
length [keySymb]
key, val
val)
        forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (TNode keySymb s)
node (\TNode keySymb s
r -> TNode keySymb s
r { tnValuesIds :: [Int]
tnValuesIds = [Int
vi] })
    addSymb STRef s (TNode keySymb s)
node (keySymb
c:[keySymb]
nc) = do
        TNode keySymb s
n <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
node
        let nlnks :: HashMap keySymb (STRef s (TNode keySymb s))
nlnks = forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks TNode keySymb s
n
        case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup keySymb
c HashMap keySymb (STRef s (TNode keySymb s))
nlnks of
            Just STRef s (TNode keySymb s)
tn -> STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
addSymb STRef s (TNode keySymb s)
tn [keySymb]
nc
            Maybe (STRef s (TNode keySymb s))
Nothing -> do
                TNode keySymb s
nnd <- forall keySymb a s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb a s -> ST s (TNode keySymb s)
mkNewTNode TTree keySymb val s
tree
                STRef s (TNode keySymb s)
refNewN <- forall a s. a -> ST s (STRef s a)
newSTRef TNode keySymb s
nnd
                forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (TNode keySymb s)
node (TNode keySymb s
n {tnLinks :: HashMap keySymb (STRef s (TNode keySymb s))
tnLinks = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert keySymb
c STRef s (TNode keySymb s)
refNewN HashMap keySymb (STRef s (TNode keySymb s))
nlnks})
                STRef s (TNode keySymb s) -> [keySymb] -> ST s ()
addSymb STRef s (TNode keySymb s)
refNewN [keySymb]
nc

findFailures :: (Eq keySymb, Hashable keySymb) => TTree keySymb val s -> ST s ()
findFailures :: forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s ()
findFailures TTree keySymb val s
tree = do
    forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (TNode keySymb s)
root (\TNode keySymb s
n -> TNode keySymb s
n {tnFail :: Maybe (STRef s (TNode keySymb s))
tnFail = forall a. a -> Maybe a
Just STRef s (TNode keySymb s)
root})
    DQ (STRef s (TNode keySymb s)) s
dq <- forall s a. ST s (DQ a s)
mkDQ
    forall a s. DQ a s -> a -> ST s ()
pushBack DQ (STRef s (TNode keySymb s)) s
dq STRef s (TNode keySymb s)
root
    DQ (STRef s (TNode keySymb s)) s -> ST s ()
procAll DQ (STRef s (TNode keySymb s)) s
dq
    where
    root :: STRef s (TNode keySymb s)
root = forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s (TNode keySymb s)
ttRoot TTree keySymb val s
tree
    procAll :: DQ (STRef s (TNode keySymb s)) s -> ST s ()
procAll DQ (STRef s (TNode keySymb s)) s
dq = do
        Maybe (STRef s (TNode keySymb s))
n <- forall a s. DQ a s -> ST s (Maybe a)
popFront DQ (STRef s (TNode keySymb s)) s
dq
        case Maybe (STRef s (TNode keySymb s))
n of
            Maybe (STRef s (TNode keySymb s))
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just STRef s (TNode keySymb s)
node -> do
                DQ (STRef s (TNode keySymb s)) s
-> STRef s (TNode keySymb s) -> ST s ()
procNode DQ (STRef s (TNode keySymb s)) s
dq STRef s (TNode keySymb s)
node
                DQ (STRef s (TNode keySymb s)) s -> ST s ()
procAll DQ (STRef s (TNode keySymb s)) s
dq
    procNode :: DQ (STRef s (TNode keySymb s)) s
-> STRef s (TNode keySymb s) -> ST s ()
procNode DQ (STRef s (TNode keySymb s)) s
dq STRef s (TNode keySymb s)
nodeRef = do
        TNode keySymb s
node <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
nodeRef
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(keySymb
symb, STRef s (TNode keySymb s)
link) -> do
            forall a s. DQ a s -> a -> ST s ()
pushBack DQ (STRef s (TNode keySymb s)) s
dq STRef s (TNode keySymb s)
link
            STRef s (TNode keySymb s)
fRef <- STRef s (TNode keySymb s)
-> Maybe (STRef s (TNode keySymb s))
-> keySymb
-> ST s (STRef s (TNode keySymb s))
findParentFail STRef s (TNode keySymb s)
link (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Maybe (STRef s (TNode keySymb s))
tnFail TNode keySymb s
node) keySymb
symb
            TNode keySymb s
f <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
fRef
            forall s a. STRef s a -> (a -> a) -> ST s ()
modifySTRef STRef s (TNode keySymb s)
link (\TNode keySymb s
n -> TNode keySymb s
n {tnFail :: Maybe (STRef s (TNode keySymb s))
tnFail = forall a. a -> Maybe a
Just STRef s (TNode keySymb s)
fRef,
                tnValuesIds :: [Int]
tnValuesIds = forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> [Int]
tnValuesIds TNode keySymb s
n forall a. [a] -> [a] -> [a]
++ forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> [Int]
tnValuesIds TNode keySymb s
f})
            ) forall a b. (a -> b) -> a -> b
$ forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks TNode keySymb s
node forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall k v. HashMap k v -> [(k, v)]
M.toList

    findParentFail :: STRef s (TNode keySymb s)
-> Maybe (STRef s (TNode keySymb s))
-> keySymb
-> ST s (STRef s (TNode keySymb s))
findParentFail STRef s (TNode keySymb s)
link (Just STRef s (TNode keySymb s)
cfRef) keySymb
symb = do
        TNode keySymb s
cf <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
cfRef
        case (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup keySymb
symb (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks TNode keySymb s
cf), STRef s (TNode keySymb s)
cfRef forall a. Eq a => a -> a -> Bool
== STRef s (TNode keySymb s)
root) of
            (Just STRef s (TNode keySymb s)
nl, Bool
_) -> if STRef s (TNode keySymb s)
nl forall a. Eq a => a -> a -> Bool
== STRef s (TNode keySymb s)
link
                then forall (m :: * -> *) a. Monad m => a -> m a
return STRef s (TNode keySymb s)
root
                else forall (m :: * -> *) a. Monad m => a -> m a
return STRef s (TNode keySymb s)
nl
            (Maybe (STRef s (TNode keySymb s))
Nothing, Bool
True) -> forall (m :: * -> *) a. Monad m => a -> m a
return STRef s (TNode keySymb s)
root
            (Maybe (STRef s (TNode keySymb s)), Bool)
_ -> STRef s (TNode keySymb s)
-> Maybe (STRef s (TNode keySymb s))
-> keySymb
-> ST s (STRef s (TNode keySymb s))
findParentFail STRef s (TNode keySymb s)
link (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Maybe (STRef s (TNode keySymb s))
tnFail TNode keySymb s
cf) keySymb
symb

convertToStateMachine :: forall val s keySymb. (Eq keySymb, Hashable keySymb) =>
    TTree keySymb val s ->
    ST s (StateMachine keySymb val)
convertToStateMachine :: forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s (StateMachine keySymb val)
convertToStateMachine TTree keySymb val s
tree = do
    Int
size <- forall s a. STRef s a -> ST s a
readSTRef forall a b. (a -> b) -> a -> b
$ forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s Int
ttLastId TTree keySymb val s
tree
    [(Int, SMElem keySymb)]
nds <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (forall {t :: (* -> *) -> * -> *}.
(MonadTrans t, MonadState [(Int, SMElem keySymb)] (t (ST s))) =>
STRef s (TNode keySymb s) -> t (ST s) ()
convertNode forall a b. (a -> b) -> a -> b
$ forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> STRef s (TNode keySymb s)
ttRoot TTree keySymb val s
tree) []

    Int
vlsSize <- forall a s. DQ a s -> ST s Int
dqLength forall a b. (a -> b) -> a -> b
$ forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> DQ (Int, val) s
ttValues TTree keySymb val s
tree
    [(Int, (Int, val))]
vls <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
i -> do
        Maybe (Int, val)
k <- forall a s. DQ a s -> ST s (Maybe a)
popFront (forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> DQ (Int, val) s
ttValues TTree keySymb val s
tree)
        forall (m :: * -> *) a. Monad m => a -> m a
return (Int
i,forall a. HasCallStack => Maybe a -> a
fromJust Maybe (Int, val)
k)
        ) [Int
0..(Int
vlsSizeforall a. Num a => a -> a -> a
-Int
1)]

    forall keySymb val.
Array Int (SMElem keySymb)
-> Array Int (Int, val) -> Int -> StateMachine keySymb val
StateMachine (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0, Int
size) [(Int, SMElem keySymb)]
nds) (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Int
0, Int
vlsSizeforall a. Num a => a -> a -> a
-Int
1) [(Int, (Int, val))]
vls) Int
rootNodeId
        forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall (m :: * -> *) a. Monad m => a -> m a
return
    where
    convertNode :: STRef s (TNode keySymb s) -> t (ST s) ()
convertNode STRef s (TNode keySymb s)
node = do
        (TNode keySymb s
n,HashMap keySymb Int
l,Int
fail) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ do
            TNode keySymb s
n <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
node
            HashMap keySymb Int
l <- forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks TNode keySymb s
n forall t1 t2. t1 -> (t1 -> t2) -> t2
~> HashMap keySymb (STRef s (TNode keySymb s))
-> ST s (HashMap keySymb Int)
convertLinks
            Int
fail <- (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Maybe (STRef s (TNode keySymb s))
tnFail TNode keySymb s
n forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall a. HasCallStack => Maybe a -> a
fromJust forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall s a. STRef s a -> ST s a
readSTRef) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Int
tnId
            forall (m :: * -> *) a. Monad m => a -> m a
return (TNode keySymb s
n,HashMap keySymb Int
l,Int
fail)
        [(Int, SMElem keySymb)]
v <- forall s (m :: * -> *). MonadState s m => m s
get
        forall s (m :: * -> *). MonadState s m => s -> m ()
put forall a b. (a -> b) -> a -> b
$ (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Int
tnId TNode keySymb s
n, forall keySymb.
HashMap keySymb Int -> Int -> [Int] -> SMElem keySymb
SMElem HashMap keySymb Int
l Int
fail (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> [Int]
tnValuesIds TNode keySymb s
n)) forall a. a -> [a] -> [a]
: [(Int, SMElem keySymb)]
v
        forall k v. HashMap k v -> [(k, v)]
M.toList (forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> HashMap keySymb (STRef s (TNode keySymb s))
tnLinks TNode keySymb s
n) forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ STRef s (TNode keySymb s) -> t (ST s) ()
convertNode

    convertLinks :: M.HashMap keySymb (STRef s (TNode keySymb s)) ->
        ST s (M.HashMap keySymb Int)
    convertLinks :: HashMap keySymb (STRef s (TNode keySymb s))
-> ST s (HashMap keySymb Int)
convertLinks HashMap keySymb (STRef s (TNode keySymb s))
lnksMap = do
        [(keySymb, Int)]
nl <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(keySymb
symb, STRef s (TNode keySymb s)
link) -> do
            TNode keySymb s
l <- forall s a. STRef s a -> ST s a
readSTRef STRef s (TNode keySymb s)
link
            forall (m :: * -> *) a. Monad m => a -> m a
return (keySymb
symb, forall keySymb s.
(Eq keySymb, Hashable keySymb) =>
TNode keySymb s -> Int
tnId TNode keySymb s
l)
            ) forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
M.toList HashMap keySymb (STRef s (TNode keySymb s))
lnksMap
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(keySymb, Int)]
nl

resetStateMachine :: (Eq keySymb, Hashable keySymb) =>
    StateMachine keySymb val -> StateMachine keySymb val
resetStateMachine :: forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> StateMachine keySymb val
resetStateMachine StateMachine keySymb val
m = StateMachine keySymb val
m { smState :: Int
smState = Int
rootNodeId }

stateMachineStep :: (Eq keySymb, Hashable keySymb) =>
    StateMachine keySymb val -> keySymb -> SMStepRes keySymb val
stateMachineStep :: forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> keySymb -> SMStepRes keySymb val
stateMachineStep StateMachine keySymb val
sm keySymb
symb =
    case (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup keySymb
symb HashMap keySymb Int
links, Int
currentState forall a. Eq a => a -> a -> Bool
== Int
rootNodeId) of
        (Just Int
nextState, Bool
_) -> forall keySymb val.
[(Int, val)] -> StateMachine keySymb val -> SMStepRes keySymb val
SMStepRes
            (forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Array Int (SMElem keySymb)
smStates StateMachine keySymb val
sm forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
nextState forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> [Int]
smeValuesIds forall t1 t2. t1 -> (t1 -> t2) -> t2
~> [Int] -> [(Int, val)]
convertToVals)
            (StateMachine keySymb val
sm { smState :: Int
smState = Int
nextState })
        (Maybe Int
Nothing, Bool
True) -> forall keySymb val.
[(Int, val)] -> StateMachine keySymb val -> SMStepRes keySymb val
SMStepRes [] StateMachine keySymb val
sm
        (Maybe Int
Nothing, Bool
False) -> forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> keySymb -> SMStepRes keySymb val
stateMachineStep
            (StateMachine keySymb val
sm { smState :: Int
smState = forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> Int
smeFail SMElem keySymb
currentNode}) keySymb
symb
    where
    currentState :: Int
currentState = forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Int
smState StateMachine keySymb val
sm
    currentNode :: SMElem keySymb
currentNode = forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Array Int (SMElem keySymb)
smStates StateMachine keySymb val
sm forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
currentState
    links :: HashMap keySymb Int
links = forall keySymb.
(Eq keySymb, Hashable keySymb) =>
SMElem keySymb -> HashMap keySymb Int
smeLinks SMElem keySymb
currentNode
    convertToVals :: [Int] -> [(Int, val)]
convertToVals = forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> Array Int (Int, val)
smValues StateMachine keySymb val
sm forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
i)

findAll :: (Eq keySymb, Hashable keySymb) =>
    StateMachine keySymb val -> [keySymb] -> [Position val]
findAll :: forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> [keySymb] -> [Position val]
findAll StateMachine keySymb val
sm [keySymb]
str =
    forall {keySymb} {val}.
Hashable keySymb =>
StateMachine keySymb val -> [(Int, keySymb)] -> [[Position val]]
step (forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> StateMachine keySymb val
resetStateMachine StateMachine keySymb val
sm) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [keySymb]
str) forall t1 t2. t1 -> (t1 -> t2) -> t2
~> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    where
    step :: StateMachine keySymb val -> [(Int, keySymb)] -> [[Position val]]
step StateMachine keySymb val
_ [] = []
    step StateMachine keySymb val
csm ((Int
idx,keySymb
symb):[(Int, keySymb)]
next) = case forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
StateMachine keySymb val -> keySymb -> SMStepRes keySymb val
stateMachineStep StateMachine keySymb val
csm keySymb
symb of
        SMStepRes [] StateMachine keySymb val
newsm -> StateMachine keySymb val -> [(Int, keySymb)] -> [[Position val]]
step StateMachine keySymb val
newsm [(Int, keySymb)]
next
        SMStepRes [(Int, val)]
r StateMachine keySymb val
newsm -> forall a b. (a -> b) -> [a] -> [b]
map (forall {val}. Int -> (Int, val) -> Position val
cnvToPos Int
idx) [(Int, val)]
r forall a. a -> [a] -> [a]
: StateMachine keySymb val -> [(Int, keySymb)] -> [[Position val]]
step StateMachine keySymb val
newsm [(Int, keySymb)]
next
    cnvToPos :: Int -> (Int, val) -> Position val
cnvToPos Int
idx (Int
keyLength, val
val) = forall val. Int -> Int -> val -> Position val
Position (Int
idx forall a. Num a => a -> a -> a
- Int
keyLength forall a. Num a => a -> a -> a
+ Int
1) Int
keyLength val
val

-- | Returns search keys as values
makeSimpleStateMachine :: (Eq keySymb, Hashable keySymb) =>
    [[keySymb]] -> StateMachine keySymb [keySymb]
makeSimpleStateMachine :: forall keySymb.
(Eq keySymb, Hashable keySymb) =>
[[keySymb]] -> StateMachine keySymb [keySymb]
makeSimpleStateMachine [[keySymb]]
keys = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    TTree keySymb [keySymb] s
tree <- forall keySymb s a.
(Eq keySymb, Hashable keySymb) =>
ST s (TTree keySymb a s)
initNewTTree
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\[keySymb]
s -> forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> [keySymb] -> val -> ST s ()
addKeyVal TTree keySymb [keySymb] s
tree [keySymb]
s [keySymb]
s) [[keySymb]]
keys
    forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s ()
findFailures TTree keySymb [keySymb] s
tree
    forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s (StateMachine keySymb val)
convertToStateMachine TTree keySymb [keySymb] s
tree

-- | Associate custom values with the search keys
makeStateMachine :: (Eq keySymb, Hashable keySymb) =>
    [([keySymb], val)] -> StateMachine keySymb val
makeStateMachine :: forall keySymb val.
(Eq keySymb, Hashable keySymb) =>
[([keySymb], val)] -> StateMachine keySymb val
makeStateMachine [([keySymb], val)]
kv = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    TTree keySymb val s
tree <- forall keySymb s a.
(Eq keySymb, Hashable keySymb) =>
ST s (TTree keySymb a s)
initNewTTree
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> [keySymb] -> val -> ST s ()
addKeyVal TTree keySymb val s
tree)) [([keySymb], val)]
kv
    forall keySymb val s.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s ()
findFailures TTree keySymb val s
tree
    forall val s keySymb.
(Eq keySymb, Hashable keySymb) =>
TTree keySymb val s -> ST s (StateMachine keySymb val)
convertToStateMachine TTree keySymb val s
tree