module Algorithms.DFA.KMP.Automaton where
import Data.Bifunctor (bimap)
import Data.Maybe (isNothing)
import Data.Array (listArray , (!))
import Data.List (mapAccumL)
import Data.List.NonEmpty
import qualified Data.List.NonEmpty as NE
newtype Index = Index Int deriving (Integral, Real, Num, Enum, Ord, Eq)
data Jump a = Accept
| Hold a
| Step a
deriving Functor
type Process a = a -> Jump (Automaton a)
newtype Automaton a = Automaton (Process a)
data Interface a = Interface {
_targets :: [(a,Index)],
_fallback :: Either Index Index,
_accepts :: [a]
}
type Query a = Index -> Automaton a
core :: Eq a
=> Query a
-> Interface a
-> Process a
core m (Interface rs l ns) c
| c `elem` ns = Accept
| True = maybe (either (Hold . m) (Step . m) l) (Step . m) $ lookup c rs
run :: Automaton a
-> [a]
-> Maybe (Automaton a)
run m [] = Just m
run (Automaton m) xt@(x:xs) = case m x of
Accept -> Nothing
Hold s -> run s xt
Step s -> run s xs
automaton :: Eq a => NonEmpty (Interface a) -> Automaton a
automaton xs = let
a = listArray (0, NE.length xs) $ toList ys
ys = NE.map (Automaton . core ((a !) . fromIntegral)) $ xs
in a ! 0