-- | 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