AhoCorasick 0.0.3 → 0.0.4

raw patch · 4 files changed

+159/−63 lines, 4 filesdep +AhoCorasickdep +containersdep +tastydep ~basenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: AhoCorasick, containers, tasty, tasty-hunit

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• AhoCorasick.cabal +27/−11
• CHANGELOG.md +20/−0
• Text/AhoCorasick.hs +58/−52
• test/unit/Main.hs +54/−0

@@ -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 <sergey.lymar@gmail.com>-maintainer:      Sergey S Lymar <sergey.lymar@gmail.com>+maintainer:      Karl Ostmo <kostmo@gmail.com> 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: <http://github.com/lymar/AhoCorasick>+    +    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

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

@@ -1,17 +1,17 @@-{-# LANGUAGE RankNTypes, ScopedTypeVariables, ExistentialQuantification #-}--- Module:      Text.Hastache--- Copyright:   Sergey S Lymar (c) 2012--- License:     BSD3--- Maintainer:  Sergey S Lymar <sergey.lymar@gmail.com>--- 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 <sergey.lymar@gmail.com>+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 

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