-- | KMP algorithm implementation based on Deterministic Finite Automaton Automata
-- lpws = the longets suffix which is a prefix length
{-# language GeneralizedNewtypeDeriving, DeriveFunctor #-}

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

-- | Index to select the DFA states
newtype Index = Index Int deriving (Integral, Real, Num, Enum, Ord, Eq)

-- | Target of a transition
data Jump a   = Accept -- ^ final state
                | Hold a -- ^ hold on the stream 
                | Step a -- ^ step the stream 
                deriving Functor

-- | Machine transition
type Process a = a -> Jump (Automaton a) 

-- | A wrapper do deal with cycle 
newtype Automaton a = Automaton (Process a) 

-- | API
data Interface a = Interface {
    _targets ::  [(a,Index)], -- ^ where to go on occurrencies
    _fallback :: Either Index Index,  -- ^ Left is retake, Right is step ahead
    _accepts :: [a] -- ^ finals, accept states
    }

-- | backend
type Query a = Index -> Automaton a

-- | create a Resolve
core    :: Eq a 
        => Query a -- ^ backend
        -> Interface a -- ^ behavior definition
        -> 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 the automata against a stream . Nothing represent an Accept state
run     :: Automaton a  -- ^ initial machine state
        -> [a] -- ^ stream of input
        -> Maybe (Automaton a) -- ^ reached machine state 

run m [] = Just m -- end of input

run (Automaton m) xt@(x:xs) =  case m x of
        Accept -> Nothing
        Hold s -> run s xt
        Step s -> run s xs 



-- | build a Automaton from a pattern zipeed with the prefix
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