diff --git a/AhoCorasick.cabal b/AhoCorasick.cabal --- a/AhoCorasick.cabal +++ b/AhoCorasick.cabal @@ -1,25 +1,26 @@ +cabal-version: 3.0 name: AhoCorasick -version: 0.0.3 -license: BSD3 +version: 0.0.4 +license: BSD-3-Clause license-file: LICENSE category: Text copyright: Sergey S Lymar (c) 2012 author: Sergey S Lymar -maintainer: Sergey S Lymar +maintainer: Karl Ostmo stability: experimental -tested-with: GHC == 7.0.3 +tested-with: GHC == 9.4.5 synopsis: Aho-Corasick string matching algorithm -cabal-version: >= 1.8 -homepage: http://github.com/lymar/AhoCorasick -bug-reports: http://github.com/lymar/AhoCorasick/issues +homepage: http://github.com/kostmo/AhoCorasick +bug-reports: http://github.com/kostmo/AhoCorasick/issues build-type: Simple description: Aho-Corasick string matching algorithm. - . - See homepage for examples of usage: + + See usage examples in "Text.AhoCorasick". -extra-source-files: +extra-doc-files: README.md + CHANGELOG.md library exposed-modules: @@ -35,6 +36,21 @@ ,array ,mtl + default-language: Haskell2010 + +test-suite unit-tests + main-is: Main.hs + type: exitcode-stdio-1.0 + build-depends: tasty >= 0.10 && < 1.5, + tasty-hunit >= 0.10 && < 0.11, + -- Imports shared with the library don't need bounds + base, + containers, + AhoCorasick + hs-source-dirs: test/unit + default-language: Haskell2010 + ghc-options: -threaded + source-repository head type: git - location: http://github.com/lymar/AhoCorasick + location: http://github.com/kostmo/AhoCorasick diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,20 @@ +# Revision history for AhoCorasick + +## **0.4** - 2023-10-8 +* Compilation fixed by DarinM223 +* Updated Cabal version +* Added unit tests + +## **0.3** - 2012-11-09 + +* Export StateMachine datatype +* comment in Deque.hs +* readme fix + +## **0.2** - 2012-03-15 + +* Haddock fixes + +## **0.1** - 2012-03-14 + +* Initial Hackage release diff --git a/Text/AhoCorasick.hs b/Text/AhoCorasick.hs --- a/Text/AhoCorasick.hs +++ b/Text/AhoCorasick.hs @@ -1,17 +1,17 @@ -{-# LANGUAGE RankNTypes, ScopedTypeVariables, ExistentialQuantification #-} --- Module: Text.Hastache --- Copyright: Sergey S Lymar (c) 2012 --- License: BSD3 --- Maintainer: Sergey S Lymar --- Stability: experimental --- Portability: portable --- --- Aho-Corasick string matching algorithm +{-# LANGUAGE FlexibleContexts, RankNTypes, ScopedTypeVariables, ExistentialQuantification #-} +{- | -{- | Aho-Corasick string matching algorithm +Module: Text.AhoCorasick +Copyright: Sergey S Lymar (c) 2012 +License: BSD-3-Clause +Maintainer: Sergey S Lymar +Stability: experimental +Portability: portable -Simplest example: +Aho-Corasick string matching algorithm += Simplest example + @ example1 = mapM_ print $ findAll simpleSM \"ushers\" where simpleSM = makeSimpleStateMachine [\"he\",\"she\",\"his\",\"hers\"] @@ -23,7 +23,7 @@ Position {pIndex = 2, pLength = 4, pVal = \"hers\"} @ -With data: += With data @ example2 = mapM_ print $ findAll sm \"ushers\" where @@ -36,7 +36,7 @@ Position {pIndex = 2, pLength = 4, pVal = 3} @ -Step-by-step state machine evaluation: += Step-by-step state machine evaluation @ example3 = mapM_ print $ next sm \"ushers\" where @@ -56,21 +56,25 @@ @ -} module Text.AhoCorasick ( - StateMachine - , makeStateMachine + -- ** Basic interface + makeStateMachine , makeSimpleStateMachine , findAll , Position(..) + -- ** Low-level interface , stateMachineStep - , KeyLength , 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) @@ -78,7 +82,7 @@ import Text.AhoCorasick.Internal.Deque (mkDQ, pushBack, popFront, dqLength, DQ) -data (Eq keySymb, Hashable keySymb) => TNode keySymb s = +data (Eq keySymb, Hashable keySymb) => TNode keySymb s = TNode { tnId :: Int , tnLinks :: M.HashMap keySymb (STRef s (TNode keySymb s)) @@ -88,7 +92,7 @@ type KeyLength = Int -data (Eq keySymb, Hashable keySymb) => TTree keySymb val s = +data (Eq keySymb, Hashable keySymb) => TTree keySymb val s = TTree { ttRoot :: STRef s (TNode keySymb s) , ttLastId :: STRef s Int @@ -97,21 +101,21 @@ type NodeIndex = Int -data (Eq keySymb, Hashable keySymb) => SMElem keySymb = +data (Eq keySymb, Hashable keySymb) => SMElem keySymb = SMElem { smeLinks :: M.HashMap keySymb NodeIndex , smeFail :: NodeIndex , smeValuesIds :: [Int] } - -data (Eq keySymb, Hashable keySymb) => StateMachine keySymb val = + +data (Eq keySymb, Hashable keySymb) => StateMachine keySymb val = StateMachine { smStates :: Array NodeIndex (SMElem keySymb) , smValues :: Array Int (KeyLength, val) , smState :: Int } -data (Eq keySymb, Hashable keySymb) => SMStepRes keySymb val = +data (Eq keySymb, Hashable keySymb) => SMStepRes keySymb val = SMStepRes { smsrMatch :: [(KeyLength, val)] , smsrNextSM :: StateMachine keySymb val @@ -124,18 +128,18 @@ , pVal :: val } -instance (Eq keySymb, Hashable keySymb, Show keySymb) => +instance (Eq keySymb, Hashable keySymb, Show keySymb) => Show (SMElem keySymb) where show (SMElem l f v) = concat ["SMElem {smeLinks = ", show l, ", smeFail = ", show f,", smeValuesIds = ", show v, "}"] -instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) => +instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) => Show (StateMachine keySymb val) where show (StateMachine st vals state) = concat [ "StateMachine {smStates = ", show st, ", smValues = ", show vals, ", smState = ", show state,"}"] -instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) => +instance (Eq keySymb, Hashable keySymb, Show keySymb, Show val) => Show (SMStepRes keySymb val) where show (SMStepRes f n) = concat [ "StateMachineStepRes {smsrFound = ", show f, @@ -147,6 +151,7 @@ ", pLength = ", show l, ", pVal = ", show v,"}"] +(~>) :: t1 -> (t1 -> t2) -> t2 x ~> f = f x infixl 9 ~> @@ -157,10 +162,9 @@ initNewTTree = do root <- newSTRef $ TNode rootNodeId M.empty Nothing [] lid <- newSTRef rootNodeId - kw <- mkDQ - return $ TTree root lid kw - -mkNewTNode :: (Eq keySymb, Hashable keySymb) => + TTree root lid <$> mkDQ + +mkNewTNode :: (Eq keySymb, Hashable keySymb) => TTree keySymb a s -> ST s (TNode keySymb s) mkNewTNode tree = do modifySTRef lid (+1) @@ -169,7 +173,7 @@ where lid = ttLastId tree -addKeyVal :: forall val s keySymb. (Eq keySymb, Hashable keySymb) => +addKeyVal :: forall val s keySymb. (Eq keySymb, Hashable keySymb) => TTree keySymb val s -> [keySymb] -> val -> ST s () addKeyVal tree key val = addSymb (ttRoot tree) key where @@ -210,10 +214,10 @@ pushBack dq link fRef <- findParentFail link (tnFail node) symb f <- readSTRef fRef - modifySTRef link (\n -> n {tnFail = Just fRef, - tnValuesIds = (tnValuesIds n) ++ (tnValuesIds f)}) + modifySTRef link (\n -> n {tnFail = Just fRef, + tnValuesIds = tnValuesIds n ++ tnValuesIds f}) ) $ tnLinks node ~> M.toList - return () + findParentFail link (Just cfRef) symb = do cf <- readSTRef cfRef case (M.lookup symb (tnLinks cf), cfRef == root) of @@ -223,19 +227,19 @@ (Nothing, True) -> return root _ -> findParentFail link (tnFail cf) symb -convertToStateMachine :: forall val s keySymb. (Eq keySymb, Hashable keySymb) => - TTree keySymb val s -> +convertToStateMachine :: forall val s keySymb. (Eq keySymb, Hashable keySymb) => + TTree keySymb val s -> ST s (StateMachine keySymb val) convertToStateMachine tree = do size <- readSTRef $ ttLastId tree nds <- execStateT (convertNode $ ttRoot tree) [] - + vlsSize <- dqLength $ ttValues tree vls <- mapM (\i -> do k <- popFront (ttValues tree) return (i,fromJust k) ) [0..(vlsSize-1)] - + StateMachine (array (0, size) nds) (array (0, vlsSize-1) vls) rootNodeId ~> return where @@ -243,7 +247,7 @@ (n,l,fail) <- lift $ do n <- readSTRef node l <- tnLinks n ~> convertLinks - fail <- tnFail n ~> fromJust ~> readSTRef >>= return . tnId + fail <- (tnFail n ~> fromJust ~> readSTRef) <&> tnId return (n,l,fail) v <- get put $ (tnId n, SMElem l fail (tnValuesIds n)) : v @@ -254,42 +258,43 @@ convertLinks lnksMap = do nl <- mapM (\(symb, link) -> do l <- readSTRef link - return $ (symb, tnId l) + return (symb, tnId l) ) $ M.toList lnksMap return $ M.fromList nl -resetStateMachine :: (Eq keySymb, Hashable keySymb) => +resetStateMachine :: (Eq keySymb, Hashable keySymb) => StateMachine keySymb val -> StateMachine keySymb val resetStateMachine m = m { smState = rootNodeId } -stateMachineStep :: (Eq keySymb, Hashable keySymb) => +stateMachineStep :: (Eq keySymb, Hashable keySymb) => StateMachine keySymb val -> keySymb -> SMStepRes keySymb val stateMachineStep sm symb = case (M.lookup symb links, currentState == rootNodeId) of (Just nextState, _) -> SMStepRes - ((smStates sm) ! nextState ~> smeValuesIds ~> convertToVals) + (smStates sm ! nextState ~> smeValuesIds ~> convertToVals) (sm { smState = nextState }) (Nothing, True) -> SMStepRes [] sm - (Nothing, False) -> stateMachineStep - (sm { smState = smeFail currentNode}) symb + (Nothing, False) -> stateMachineStep + (sm { smState = smeFail currentNode}) symb where currentState = smState sm - currentNode = (smStates sm) ! currentState + currentNode = smStates sm ! currentState links = smeLinks currentNode - convertToVals idx = map (\i -> smValues sm ! i) idx + convertToVals = map (\i -> smValues sm ! i) -findAll :: (Eq keySymb, Hashable keySymb) => +findAll :: (Eq keySymb, Hashable keySymb) => StateMachine keySymb val -> [keySymb] -> [Position val] -findAll sm str = +findAll sm str = step (resetStateMachine sm) (zip [0..] str) ~> concat where step _ [] = [] step csm ((idx,symb):next) = case stateMachineStep csm symb of SMStepRes [] newsm -> step newsm next - SMStepRes r newsm -> (map (cnvToPos idx) r) : (step newsm next) + SMStepRes r newsm -> map (cnvToPos idx) r : step newsm next cnvToPos idx (keyLength, val) = Position (idx - keyLength + 1) keyLength val -makeSimpleStateMachine :: (Eq keySymb, Hashable keySymb) => +-- | Returns search keys as values +makeSimpleStateMachine :: (Eq keySymb, Hashable keySymb) => [[keySymb]] -> StateMachine keySymb [keySymb] makeSimpleStateMachine keys = runST $ do tree <- initNewTTree @@ -297,11 +302,12 @@ findFailures tree convertToStateMachine tree -makeStateMachine :: (Eq keySymb, Hashable keySymb) => +-- | Associate custom values with the search keys +makeStateMachine :: (Eq keySymb, Hashable keySymb) => [([keySymb], val)] -> StateMachine keySymb val makeStateMachine kv = runST $ do tree <- initNewTTree - mapM_ (\(s,v) -> addKeyVal tree s v) kv + mapM_ (uncurry (addKeyVal tree)) kv findFailures tree convertToStateMachine tree diff --git a/test/unit/Main.hs b/test/unit/Main.hs new file mode 100644 --- /dev/null +++ b/test/unit/Main.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- BoolExpr unit tests +module Main where + +import qualified Data.Map as M +import Data.Either (isRight) +import Data.List (isInfixOf) +import Test.Tasty (TestTree, defaultMain, testGroup) +import Test.Tasty.HUnit + +import Text.AhoCorasick + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Main" [ + testCase "Simplest example" $ + assertEqual "Found strings not equal!" + ["she", "he", "hers"] example1 + , testCase "With data" $ + assertEqual "Found strings not equal!" + [1, 0, 3] example2 + , testCase "Step-by-step state machine evaluation" $ + assertEqual "Steps were not equal!" + [ ('u',[]) + , ('s',[]) + , ('h',[]) + , ('e',[(3,"she"),(2,"he")]) + , ('r',[]) + , ('s',[(4,"hers")]) + ] + example3 + ] + +example1 :: [String] +example1 = map pVal $ findAll simpleSM "ushers" + where + simpleSM = makeSimpleStateMachine ["he","she","his","hers"] + +example2 :: [Int] +example2 = map pVal $ findAll sm "ushers" where + sm = makeStateMachine [("he",0),("she",1),("his",2),("hers",3)] + +example3 :: [(Char, [(Int, String)])] +example3 = 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