-- | Perform KMP matching
module Algorithms.DFA.KMP where

import Data.List (mapAccumL)
import Algorithms.DFA.KMP.Automaton
import Data.List.NonEmpty (NonEmpty (..), toList)
import qualified Data.List.NonEmpty as NE

-- | given a kmp table produce an interface
-- errors: indexes pointing outside the length, first index not 0
unsafeFrom ::  NonEmpty (a,Index) -> NonEmpty (Interface a)
-- a pattern of one element, Step as falling back to self or Accept
unsafeFrom ((x,0) :| []) = Interface [] (Right 0) [x] :| []
-- a bigger pattern, the initial elem is still different from the rest
unsafeFrom ((x,0) :| xs) = Interface [(x,1)] (Right 0) [] :|  core (zip [2..] xs) where
    -- last pattern element is Accept or Hold on falling back to lpws
    core [(_,(x,i))] = [Interface  [] (Left i) [x]] 
    -- Step to next  or Hold on falling back to the lpws 
    core ((n,(x,i)) : xs) = Interface [(x,n)] (Left i) [] : core xs 


-- | A list of lpws. This is the KMP table with indexes row shifted right by one
table  :: Eq a 
        => NonEmpty a  -- pattern
        -> NonEmpty Index
table xt@(x :| xs) = (0 :| ) . snd . mapAccumL f (0, toList xt) $ xs where
        f (n, z:zs)  x
                | x == z = ((n + 1, zs), n)
                | otherwise = ((0, xs), n)        

-- | use kmp to check any (isPrefixOf pattern) $ tails stream
-- | use kmp to check any (isPrefixOf pattern) $ tails stream

match   :: Eq a 
        => NonEmpty a -- ^ pattern
        -> [a] -- ^ pattern
        -> Bool
match p s = case run (automaton . unsafeFrom $ NE.zip <*> table $ p) s of
        Nothing -> True
        _ -> False
        

-- | error on empty patterns
(==!) :: Eq a 
        => [a] -- ^ pattern
        -> [a] -- ^ pattern
        -> Bool
(p:ps) ==! xs = match (p :| ps) xs