alfred-margaret 1.1.2.0 → 2.0.0.0

raw patch · 27 files changed

+782/−3567 lines, 27 filesdep −bytestringdep ~hashabledep ~textbinary-addedPVP ok

version bump matches the API change (PVP)

Dependencies removed: bytestring

Dependency ranges changed: hashable, text

API changes (from Hackage documentation)

Files

• alfred-margaret.cabal +15/−23
• app/dump-automaton/Main.hs +1/−1
• performance.png binary
• src/Data/Text/AhoCorasick/Automaton.hs +209/−177
• src/Data/Text/AhoCorasick/Replacer.hs +23/−25
• src/Data/Text/AhoCorasick/Searcher.hs +10/−13
• src/Data/Text/AhoCorasick/Splitter.hs +15/−15
• src/Data/Text/BoyerMoore/Automaton.hs +56/−88
• src/Data/Text/BoyerMoore/Replacer.hs +14/−21
• src/Data/Text/BoyerMoore/Searcher.hs +20/−44
• src/Data/Text/Utf16.hs +0/−233
• src/Data/Text/Utf8.hs +78/−202
• src/Data/Text/Utf8/AhoCorasick/Automaton.hs +0/−545
• src/Data/Text/Utf8/AhoCorasick/Replacer.hs +0/−219
• src/Data/Text/Utf8/AhoCorasick/Searcher.hs +0/−178
• src/Data/Text/Utf8/AhoCorasick/Splitter.hs +0/−189
• src/Data/Text/Utf8/BoyerMoore/Automaton.hs +0/−335
• src/Data/Text/Utf8/BoyerMoore/Replacer.hs +0/−91
• src/Data/Text/Utf8/BoyerMoore/Searcher.hs +0/−121
• tests/Data/Text/AhoCorasickSpec.hs +165/−363
• tests/Data/Text/BoyerMooreSpec.hs +62/−51
• tests/Data/Text/Orphans.hs +3/−8
• tests/Data/Text/Utf8/AhoCorasickSpec.hs +0/−248
• tests/Data/Text/Utf8/BoyerMooreSpec.hs +0/−262
• tests/Data/Text/Utf8/Utf8Spec.hs +0/−106
• tests/Data/Text/Utf8Spec.hs +106/−0
• tests/Main.hs +5/−9

@@ -1,5 +1,5 @@ name:                alfred-margaret-version:             1.1.2.0+version:             2.0.0.0 synopsis:            Fast Aho-Corasick string searching description:         An efficient implementation of the Aho-Corasick                      string searching algorithm.@@ -12,14 +12,15 @@ category:            Data, Text build-type:          Simple extra-source-files:  README.md+                   , performance.png cabal-version:       >=1.10 tested-with:-                     -- Stackage LTS 13.10.-                     GHC == 8.6.3-                     -- Stackage LTS 16.18.-                   , GHC == 8.8.4-                     -- Stackage LTS 18.27+                     -- Nixpkgs unstable (Updated 2022-04-14)+                     GHC == 8.8.4+                     -- Nixpkgs unstable (Updated 2022-04-14)                    , GHC == 8.10.7+                     -- Nixpkgs unstable (Updated 2022-04-14)+                   , GHC == 9.0.2  source-repository head   type:     git@@ -41,37 +42,30 @@  library   hs-source-dirs:      src-  exposed-modules:     Data.Text.AhoCorasick.Automaton+  exposed-modules:     Data.Text.CaseSensitivity+                     , Data.Text.Utf8+                     , Data.Text.AhoCorasick.Automaton                      , Data.Text.AhoCorasick.Replacer                      , Data.Text.AhoCorasick.Searcher                      , Data.Text.AhoCorasick.Splitter                      , Data.Text.BoyerMoore.Automaton                      , Data.Text.BoyerMoore.Replacer                      , Data.Text.BoyerMoore.Searcher-                     , Data.Text.CaseSensitivity-                     , Data.Text.Utf16-                     , Data.Text.Utf8-                     , Data.Text.Utf8.AhoCorasick.Automaton-                     , Data.Text.Utf8.AhoCorasick.Replacer-                     , Data.Text.Utf8.AhoCorasick.Searcher-                     , Data.Text.Utf8.AhoCorasick.Splitter-                     , Data.Text.Utf8.BoyerMoore.Automaton-                     , Data.Text.Utf8.BoyerMoore.Replacer-                     , Data.Text.Utf8.BoyerMoore.Searcher                      , Data.TypedByteArray   build-depends:       base             >= 4.7 && < 5     , containers       >= 0.6 && < 0.7     , deepseq          >= 1.4 && < 1.5-    , hashable         >= 1.2.7 && < 1.4+    , hashable         >= 1.4.0.2 && < 1.5     , primitive        >= 0.6.4 && < 0.8-    , text             >= 1.2.3 && < 1.3+    , text             >= 2.0 && < 2.1     , unordered-containers >= 0.2.9 && < 0.3     , vector           >= 0.12 && < 0.13-    , bytestring       >= 0.10.12 && < 1   ghc-options:         -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -O2   default-language:    Haskell2010   if flag(aeson) {+                       -- Even an older version of aeson is fine since+                       -- we only use it for instances   build-depends:       aeson >= 1.4.2 && < 3   cpp-options:         -DHAS_AESON   }@@ -84,9 +78,7 @@   main-is:             Main.hs   other-modules:       Data.Text.AhoCorasickSpec                      , Data.Text.BoyerMooreSpec-                     , Data.Text.Utf8.AhoCorasickSpec-                     , Data.Text.Utf8.BoyerMooreSpec-                     , Data.Text.Utf8.Utf8Spec+                     , Data.Text.Utf8Spec                      , Data.Text.Orphans   hs-source-dirs:      tests   ghc-options:         -Wall -Wincomplete-record-updates -Wno-orphans

@@ -2,7 +2,7 @@  import Control.Monad (forM) import qualified Data.Text.Utf8 as Utf8-import Data.Text.Utf8.AhoCorasick.Automaton (debugBuildDot)+import Data.Text.AhoCorasick.Automaton (debugBuildDot) import System.Environment (getArgs) import System.IO (hPrint, hPutStr, stderr) 

binary file changed (absent → 10353 bytes)

@@ -1,11 +1,10 @@ -- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable+-- Copyright 2022 Channable -- -- Licensed under the 3-clause BSD license, see the LICENSE file in the -- repository root.  {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -26,6 +25,9 @@ -- Therefore construction is a two-step process, where first we build the -- automaton as int maps, which are convenient for incremental construction. -- Afterwards we pack the automaton into unboxed vectors.+--+-- This module is a rewrite of the previous version which used an older version of+-- the 'text' package which in turn used UTF-16 internally. module Data.Text.AhoCorasick.Automaton     ( AcMachine (..)     , CaseSensitivity (..)@@ -36,50 +38,56 @@     , debugBuildDot     , runLower     , runText+    , runWithCase     ) where -import Prelude hiding (length)- import Control.DeepSeq (NFData)-import Data.Bits (shiftL, shiftR, (.&.), (.|.))+import Data.Bits (Bits (shiftL, shiftR, (.&.), (.|.)))+import Data.Char (chr) import Data.Foldable (foldl') import Data.IntMap.Strict (IntMap)-import Data.Text.Internal (Text (..))-import Data.Word (Word64)+import Data.Word (Word32, Word64) import GHC.Generics (Generic) +import qualified Data.Char as Char import qualified Data.IntMap.Strict as IntMap import qualified Data.List as List import qualified Data.Vector as Vector  import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf16 (CodeUnit, CodeUnitIndex (..), indexTextArray, lowerCodeUnit)+import Data.Text.Utf8 (CodePoint, CodeUnitIndex (CodeUnitIndex), Text (..)) import Data.TypedByteArray (Prim, TypedByteArray) +import qualified Data.Text.Utf8 as Utf8 import qualified Data.TypedByteArray as TBA +-- TYPES -- | A numbered state in the Aho-Corasick automaton. type State = Int --- | A transition is a pair of (code unit, next state). The code unit is 16 bits,--- and the state index is 32 bits. We pack these together as a manually unlifted--- tuple, because an unboxed Vector of tuples is a tuple of vectors, but we want--- the elements of the tuple to be adjacent in memory. (The Word64 still needs--- to be unpacked in the places where it is used.) The code unit is stored in--- the least significant 32 bits, with the special value 2^16 indicating a--- wildcard; the "failure" transition. Bit 17 through 31 (starting from zero,+-- | A transition is a pair of (code point, next state). The code point is 21 bits,+-- and the state index is 32 bits. The code point is stored in+-- the least significant 32 bits, with the special value 2^21 indicating a+-- wildcard; the "failure" transition. Bits 22 through 31 (starting from zero, -- both bounds inclusive) are always 0. -----  Bit 63 (most significant)                 Bit 0 (least significant)---  |                                                                 |---  v                                                                 v--- |<--       goto state         -->|<-- zeros   -->| |<--   input  -->|--- |SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS|000000000000000|W|IIIIIIIIIIIIIIII|---                                                   |---                                                   Wildcard bit (bit 16) --+-- >  Bit 63 (most significant)                 Bit 0 (least significant)+-- >  |                                                                 |+-- >  v                                                                 v+-- > |<--       goto state         -->|<-- 0s -->| |<--     input     -->|+-- > |SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS|0000000000|W|IIIIIIIIIIIIIIIIIIIII|+-- >                                              |+-- >                                        Wildcard bit (bit 21)+--+-- If you change this representation, make sure to update 'transitionCodeUnit',+-- 'wildcard', 'transitionState', 'transitionIsWildcard', 'newTransition' and+-- 'newWildcardTransition' as well. Those functions form the interface used to+-- construct and read transitions. type Transition = Word64 +type Offset = Word32+ data Match v = Match   { matchPos   :: {-# UNPACK #-} !CodeUnitIndex   -- ^ The code unit index past the last code unit of the match. Note that this@@ -87,18 +95,18 @@   -- as up to four code units.   , matchValue :: v   -- ^ The payload associated with the matched needle.-  } deriving (Show, Eq)+  }  -- | An Aho-Corasick automaton. data AcMachine v = AcMachine-  { machineValues :: !(Vector.Vector [v])+  { machineValues               :: !(Vector.Vector [v])   -- ^ For every state, the values associated with its needles. If the state is   -- not a match state, the list is empty.-  , machineTransitions :: !(TypedByteArray Transition)+  , machineTransitions          :: !(TypedByteArray Transition)   -- ^ A packed vector of transitions. For every state, there is a slice of this   -- vector that starts at the offset given by `machineOffsets`, and ends at the   -- first wildcard transition.-  , machineOffsets :: !(TypedByteArray Int)+  , machineOffsets              :: !(TypedByteArray Offset)   -- ^ For every state, the index into `machineTransitions` where the transition   -- list for that state starts.   , machineRootAsciiTransitions :: !(TypedByteArray Transition)@@ -109,14 +117,16 @@  instance NFData v => NFData (AcMachine v) --- | The wildcard value is 2^16, one more than the maximal 16-bit code unit.+-- AUTOMATON CONSTRUCTION++-- | The wildcard value is 2^21, one more than the maximal 21-bit code point. wildcard :: Integral a => a-wildcard = 0x10000+wildcard = 0x200000  -- | Extract the code unit from a transition. The special wildcard transition -- will return 0.-transitionCodeUnit :: Transition -> CodeUnit-transitionCodeUnit t = fromIntegral (t .&. 0xffff)+transitionCodeUnit :: Transition -> CodePoint+transitionCodeUnit t = Char.chr $ fromIntegral (t .&. 0x1fffff)  -- | Extract the goto state from a transition. transitionState :: Transition -> State@@ -127,10 +137,10 @@ transitionIsWildcard :: Transition -> Bool transitionIsWildcard t = (t .&. wildcard) == wildcard -newTransition :: CodeUnit -> State -> Transition+newTransition :: CodePoint -> State -> Transition newTransition input state =   let-    input64 = fromIntegral input :: Word64+    input64 = fromIntegral $ Char.ord input :: Word64     state64 = fromIntegral state :: Word64   in     (state64 `shiftL` 32) .|. input64@@ -146,20 +156,17 @@ -- the transitions for a specific state, we also produce a vector of start -- indices. All transition lists are terminated by a wildcard transition, so -- there is no need to record the length.-packTransitions :: [[Transition]] -> (TypedByteArray Transition, TypedByteArray Int)+packTransitions :: [[Transition]] -> (TypedByteArray Transition, TypedByteArray Offset) packTransitions transitions =   let     packed = TBA.fromList $ concat transitions-    offsets = TBA.fromList $ scanl (+) 0 $ fmap List.length transitions+    offsets = TBA.fromList $ map fromIntegral $ scanl (+) 0 $ fmap List.length transitions   in     (packed, offsets)  -- | Construct an Aho-Corasick automaton for the given needles.--- Takes a list of code units rather than `Text`, to allow mapping the code--- units before construction, for example to lowercase individual code points,--- rather than doing proper case folding (which might change the number of code--- units).-build :: [([CodeUnit], v)] -> AcMachine v+-- The automaton uses Unicode code points to match the input.+build :: [(Text, v)] -> AcMachine v build needlesWithValues =   let     -- Construct the Aho-Corasick automaton using IntMaps, which are a suitable@@ -173,7 +180,7 @@     -- Convert the map of transitions, and the map of fallback states, into a     -- list of transition lists, where every transition list is terminated by     -- a wildcard transition to the fallback state.-    prependTransition ts input state = newTransition (fromIntegral input) state : ts+    prependTransition ts input state = newTransition (Char.chr input) state : ts     makeTransitions fallback ts = IntMap.foldlWithKey' prependTransition [newWildcardTransition fallback] ts     transitionsList = zipWith makeTransitions (IntMap.elems fallbackMap) (IntMap.elems transitionMap) @@ -186,7 +193,7 @@     AcMachine values transitions offsets rootTransitions  -- | Build the automaton, and format it as Graphviz Dot, for visual debugging.-debugBuildDot :: [[CodeUnit]] -> String+debugBuildDot :: [Text] -> String debugBuildDot needles =   let     (_numStates, transitionMap, initialValueMap) =@@ -195,16 +202,18 @@     valueMap = buildValueMap transitionMap fallbackMap initialValueMap      dotEdge extra state nextState =-      "  " ++ (show state) ++ " -> " ++ (show nextState) ++ " [" ++ extra ++ "];"+      "  " ++ show state ++ " -> " ++ show nextState ++ " [" ++ extra ++ "];"      dotFallbackEdge :: [String] -> State -> State -> [String]     dotFallbackEdge edges state nextState =-      (dotEdge "style = dashed" state nextState) : edges+      dotEdge "style = dashed" state nextState : edges      dotTransitionEdge :: State -> [String] -> Int -> State -> [String]     dotTransitionEdge state edges input nextState =-      (dotEdge ("label = \"" ++ show input ++ "\"") state nextState) : edges+      dotEdge ("label = \"" ++ showInput input ++ "\"") state nextState : edges +    showInput input = [chr input]+     prependTransitionEdges edges state =       IntMap.foldlWithKey' (dotTransitionEdge state) edges (transitionMap IntMap.! state) @@ -220,7 +229,7 @@     -- bottom. I have dual widescreen monitors and I don't use them in portrait     -- mode. Reverse the instructions because order affects node lay-out, and by     -- prepending we built up a reversed list.-    unlines $ ["digraph {", "  rankdir = \"LR\";"] ++ (reverse dot2) ++ ["}"]+    unlines $ ["digraph {", "  rankdir = \"LR\";"] ++ reverse dot2 ++ ["}"]  -- Different int maps that are used during constuction of the automaton. The -- transition map represents the trie of states, the fallback map contains the@@ -230,49 +239,48 @@ type ValuesMap v = IntMap [v]  -- | Build the trie of the Aho-Corasick state machine for all input needles.-buildTransitionMap :: forall v. [([CodeUnit], v)] -> (Int, TransitionMap, ValuesMap v)+buildTransitionMap :: forall v. [(Text, v)] -> (Int, TransitionMap, ValuesMap v) buildTransitionMap =   let-    go :: State-      -> (Int, TransitionMap, ValuesMap v)-      -> ([CodeUnit], v)-      -> (Int, TransitionMap, ValuesMap v)--    -- End of the current needle, insert the associated payload value.-    -- If a needle occurs multiple times, then at this point we will merge-    -- their payload values, so the needle is reported twice, possibly with-    -- different payload values.-    go !state (!numStates, transitions, values) ([], v) =-      (numStates, transitions, IntMap.insertWith (++) state [v] values)+    -- | Inserts a single needle into the given transition and values map.+    insertNeedle :: (Int, TransitionMap, ValuesMap v) -> (Text, v) -> (Int, TransitionMap, ValuesMap v)+    insertNeedle !acc (!needle, !value) = go stateInitial 0 acc+      where+        !needleLen = Utf8.lengthUtf8 needle -    -- Follow the edge for the given input from the current state, creating it-    -- if it does not exist.-    go !state (!numStates, transitions, values) (!input : needleTail, vs) =-      let-        transitionsFromState = transitions IntMap.! state-      in-        case IntMap.lookup (fromIntegral input) transitionsFromState of-          Just nextState ->-            go nextState (numStates, transitions, values) (needleTail, vs)-          Nothing ->-            let+        go !state !index (!numStates, !transitions, !values)+          -- End of the current needle, insert the associated payload value.+          -- If a needle occurs multiple times, then at this point we will merge+          -- their payload values, so the needle is reported twice, possibly with+          -- different payload values.+          | index >= needleLen = (numStates, transitions, IntMap.insertWith (++) state [value] values)+        go !state !index (!numStates, !transitions, !values) =+          let+            !transitionsFromState = transitions IntMap.! state+            (!codeUnits, !input) = Utf8.unsafeIndexCodePoint needle index+          in+            case IntMap.lookup (Char.ord input) transitionsFromState of+              -- Transition already exists, follow it and continue from there.+              Just !nextState ->+                go nextState (index + codeUnits) (numStates, transitions, values)+              -- Transition for input does not exist at state:               -- Allocate a new state, and insert a transition to it.               -- Also insert an empty transition map for it.-              nextState = numStates-              transitionsFromState' = IntMap.insert (fromIntegral input) nextState transitionsFromState-              transitions'-                = IntMap.insert state transitionsFromState'-                $ IntMap.insert nextState IntMap.empty-                $ transitions-            in-              go nextState (numStates + 1, transitions', values) (needleTail, vs)+              Nothing ->+                let+                  !nextState = numStates+                  !transitionsFromState' = IntMap.insert (Char.ord input) nextState transitionsFromState+                  !transitions'+                    = IntMap.insert state transitionsFromState'+                    $ IntMap.insert nextState IntMap.empty transitions+                in+                  go nextState (index + codeUnits) (numStates + 1, transitions', values)      -- Initially, the root state (state 0) exists, and it has no transitions     -- to anywhere.     stateInitial = 0     initialTransitions = IntMap.singleton stateInitial IntMap.empty     initialValues = IntMap.empty-    insertNeedle = go stateInitial   in     foldl' insertNeedle (1, initialTransitions, initialValues) @@ -280,14 +288,15 @@ asciiCount :: Integral a => a asciiCount = 128 --- | Build a lookup table for the first 128 code units, that can be used for+-- | Build a lookup table for the first 128 code points, that can be used for -- O(1) lookup of a transition, rather than doing a linear scan over all -- transitions. The fallback goes back to the initial state, state 0.+{-# NOINLINE buildAsciiTransitionLookupTable  #-} buildAsciiTransitionLookupTable :: IntMap State -> TypedByteArray Transition buildAsciiTransitionLookupTable transitions = TBA.generate asciiCount $ \i ->   case IntMap.lookup i transitions of-    Just state -> newTransition (fromIntegral i) state-    Nothing -> newWildcardTransition 0+    Just state -> newTransition (Char.chr i) state+    Nothing    -> newWildcardTransition 0  -- | Traverse the state trie in breadth-first order. foldBreadthFirst :: (a -> State -> a) -> a -> TransitionMap -> a@@ -367,6 +376,7 @@ -- in one place. We ran this code with `Vector.!` (bounds-checked indexing) in -- production for two months without failing the bounds check, so we have turned -- the check off for performance now.+{-# INLINE at #-} at :: forall a. Vector.Vector a -> Int -> a at = Vector.unsafeIndex @@ -374,124 +384,148 @@ uAt :: Prim a => TypedByteArray a -> Int -> a uAt = TBA.unsafeIndex +-- RUNNING THE MACHINE+ -- | Result of handling a match: stepping the automaton can exit early by -- returning a `Done`, or it can continue with a new accumulator with `Step`.-data Next a-  = Done !a-  | Step !a+data Next a = Done !a | Step !a  -- | Run the automaton, possibly lowercasing the input text on the fly if case--- insensitivity is desired. See also `lowerCodeUnit` and `runLower`.+-- insensitivity is desired. See also `runLower`.+--+-- The code of this function itself is organized as a state machine as well.+-- Each state in the diagram below corresponds to a function defined in+-- `runWithCase`. These functions are written in a way such that GHC identifies them+-- as [join points](https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/).+-- This means that they can be compiled to jumps instead of function calls, which helps performance a lot.+--+-- @+--   ┌─────────────────────────────┐+--   │                             │+-- ┌─▼──────────┐   ┌──────────────┴─┐   ┌──────────────┐+-- │consumeInput├───►lookupTransition├───►collectMatches│+-- └─▲──────────┘   └─▲────────────┬─┘   └────────────┬─┘+--   │                │            │                  │+--   │                └────────────┘                  │+--   │                                                │+--   └────────────────────────────────────────────────┘+-- @+--+-- * @consumeInput@ decodes a code point of up to four code units and possibly lowercases it.+--   It passes this code point to @followCodePoint@, which in turn calls @lookupTransition@.+-- * @lookupTransition@ checks whether the given code point matches any transitions at the given state.+--   If so, it follows the transition and calls @collectMatches@. Otherwise, it follows the fallback transition+--   and calls @followCodePoint@ or @consumeInput@.+-- * @collectMatches@ checks whether the current state is accepting and updates the accumulator accordingly.+--   Afterwards it loops back to @consumeInput@.+--+-- NOTE: @followCodePoint@ is actually inlined into @consumeInput@ by GHC.+-- It is included in the diagram for illustrative reasons only.+--+-- All of these functions have the arguments @offset@, @state@ and @acc@ which encode the current input+-- position and the accumulator, which contains the matches. If you change any of the functions above,+-- make sure to check the Core dumps afterwards that @offset@ and @state@ were turned+-- into unboxed @Int#@ by GHC. If any of them aren't, the program will constantly allocate and deallocate heap space for them.+-- You can nudge GHC in the right direction by using bang patterns on these arguments.+-- -- WARNING: Run benchmarks when modifying this function; its performance is -- fragile. It took many days to discover the current formulation which compiles -- to fast code; removing the wrong bang pattern could cause a 10% performance -- regression. {-# INLINE runWithCase #-}-runWithCase-  :: forall a v-  .  CaseSensitivity-  -> a-  -> (a -> Match v -> Next a)-  -> AcMachine v-  -> Text-  -> a-runWithCase caseSensitivity seed f machine text =-  let-    Text u16data !initialOffset !initialRemaining = text-    !values = machineValues machine-    !transitions = machineTransitions machine-    !offsets = machineOffsets machine-    !rootAsciiTransitions = machineRootAsciiTransitions machine-    !stateInitial = 0+runWithCase :: forall a v. CaseSensitivity -> a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a+runWithCase !caseSensitivity !seed !f !machine !text =+  consumeInput initialOffset seed initialState+  where+    initialState = 0 +    Text !u8data !off !len = text+    AcMachine !values !transitions !offsets !rootAsciiTransitions = machine++    !initialOffset = CodeUnitIndex off+    !limit = CodeUnitIndex $ off + len+     -- NOTE: All of the arguments are strict here, because we want to compile     -- them down to unpacked variables on the stack, or even registers.-    -- The INLINE / NOINLINE annotations here were added to fix a regression we-    -- observed when going from GHC 8.2 to GHC 8.6, and this particular-    -- combination of INLINE and NOINLINE is the fastest one. Removing increases-    -- the benchmark running time by about 9%. +    -- When we follow an edge, we look in the transition table and do a+    -- linear scan over all transitions until we find the right one, or+    -- until we hit the wildcard transition at the end. For 0 or 1 or 2+    -- transitions that is fine, but the initial state often has more+    -- transitions, so we have a dedicated lookup table for it, that takes+    -- up a bit more space, but provides O(1) lookup of the next state. We+    -- only do this for the first 128 code units (all of ascii).++    -- | Consume a code unit sequence that constitutes a full code point.+    -- If the code unit at @offset@ is ASCII, we can lower it using 'Utf8.toLowerAscii'.     {-# NOINLINE consumeInput #-}-    consumeInput :: Int -> Int -> a -> State -> a-    consumeInput !offset !remaining !acc !state =-      let-        inputCodeUnit = fromIntegral $ indexTextArray u16data offset-        -- NOTE: Although doing this match here entangles the automaton a bit-        -- with case sensitivity, doing so is faster than passing in a function-        -- that transforms each code unit.-        casedCodeUnit = case caseSensitivity of-          IgnoreCase -> lowerCodeUnit inputCodeUnit-          CaseSensitive -> inputCodeUnit-      in-        case remaining of-          0 -> acc-          _ -> followEdge (offset + 1) (remaining - 1) acc state casedCodeUnit+    consumeInput :: CodeUnitIndex -> a -> State -> a+    consumeInput !offset !acc !_state+      | offset >= limit = acc+    consumeInput !offset !acc !state =+      followCodePoint (offset + codeUnits) acc possiblyLoweredCp state -    {-# INLINE followEdge #-}-    followEdge :: Int -> Int -> a -> State -> CodeUnit -> a-    followEdge !offset !remaining !acc !state !input =-      let-        !tssOffset = offsets `uAt` state-      in-        -- When we follow an edge, we look in the transition table and do a-        -- linear scan over all transitions until we find the right one, or-        -- until we hit the wildcard transition at the end. For 0 or 1 or 2-        -- transitions that is fine, but the initial state often has more-        -- transitions, so we have a dedicated lookup table for it, that takes-        -- up a bit more space, but provides O(1) lookup of the next state. We-        -- only do this for the first 128 code units (all of ascii).-        if state == stateInitial && input < asciiCount-          then lookupRootAsciiTransition offset remaining acc input-          else lookupTransition offset remaining acc state input tssOffset+      where+        (!codeUnits, !cp) = Utf8.unsafeIndexCodePoint' u8data offset +        !possiblyLoweredCp = case caseSensitivity of+          CaseSensitive -> cp+          IgnoreCase -> Utf8.lowerCodePoint cp++    {-# INLINE followCodePoint #-}+    followCodePoint :: CodeUnitIndex -> a -> CodePoint -> State -> a+    followCodePoint !offset !acc !cp !state+      | state == initialState && Char.ord cp < asciiCount = lookupRootAsciiTransition offset acc cp+      | otherwise = lookupTransition offset acc cp state $ offsets `uAt` state++    -- NOTE: This function can't be inlined since it is self-recursive.+    {-# NOINLINE lookupTransition #-}+    lookupTransition :: CodeUnitIndex -> a -> CodePoint -> State -> Offset -> a+    lookupTransition !offset !acc !cp !state !i+      -- There is no transition for the given input. Follow the fallback edge,+      -- and try again from that state, etc. If we are in the base state+      -- already, then nothing matched, so move on to the next input.+      | transitionIsWildcard t =+        if state == initialState+          then consumeInput offset acc state+          else followCodePoint offset acc cp (transitionState t)+      -- We found the transition, switch to that new state, possibly matching the rest of cus.+      -- NOTE: This comes after wildcard checking, because the code unit of+      -- the wildcard transition is 0, which is a valid input.+      | transitionCodeUnit t == cp =+        collectMatches offset acc (transitionState t)+      -- The transition we inspected is not for the current input, and it is not+      -- a wildcard either; look at the next transition then.+      | otherwise =+        lookupTransition offset acc cp state $ i + 1++      where+        !t = transitions `uAt` fromIntegral i++    -- NOTE: there is no `state` argument here, because this case applies only+    -- to the root state `stateInitial`.+    {-# INLINE lookupRootAsciiTransition #-}+    lookupRootAsciiTransition !offset !acc !cp+      -- Given code unit does not match at root ==> Repeat at offset from initial state+      | transitionIsWildcard t = consumeInput offset acc initialState+      -- Transition matched!+      | otherwise = collectMatches offset acc $ transitionState t+      where !t = rootAsciiTransitions `uAt` Char.ord cp+     {-# NOINLINE collectMatches #-}-    collectMatches :: Int -> Int -> a -> State -> a-    collectMatches !offset !remaining !acc !state =+    collectMatches !offset !acc !state =       let         matchedValues = values `at` state         -- Fold over the matched values. If at any point the user-supplied fold         -- function returns `Done`, then we early out. Otherwise continue.         handleMatch !acc' vs = case vs of-          []     -> consumeInput offset remaining acc' state-          v:more -> case f acc' (Match (CodeUnitIndex $ offset - initialOffset) v) of+          []     -> consumeInput offset acc' state+          v:more -> case f acc' (Match (offset - initialOffset) v) of             Step newAcc -> handleMatch newAcc more             Done finalAcc -> finalAcc       in         handleMatch acc matchedValues -    -- NOTE: there is no `state` argument here, because this case applies only-    -- to the root state `stateInitial`.-    {-# INLINE lookupRootAsciiTransition #-}-    lookupRootAsciiTransition :: Int -> Int -> a -> CodeUnit -> a-    lookupRootAsciiTransition !offset !remaining !acc !input =-      case rootAsciiTransitions `uAt` fromIntegral input of-        t | transitionIsWildcard t -> consumeInput offset remaining acc stateInitial-          | otherwise -> collectMatches offset remaining acc (transitionState t)--    {-# INLINE lookupTransition #-}-    lookupTransition :: Int -> Int -> a -> State -> CodeUnit -> Int -> a-    lookupTransition !offset !remaining !acc !state !input !i =-      case transitions `uAt` i of-        -- There is no transition for the given input. Follow the fallback edge,-        -- and try again from that state, etc. If we are in the base state-        -- already, then nothing matched, so move on to the next input.-        t | transitionIsWildcard t ->-              if state == stateInitial-                then consumeInput offset remaining acc state-                else followEdge offset remaining acc (transitionState t) input--        -- We found the transition, switch to that new state, collecting matches.-        -- NOTE: This comes after wildcard checking, because the code unit of-        -- the wildcard transition is 0, which is a valid input.-        t | transitionCodeUnit t == input ->-              collectMatches offset remaining acc (transitionState t)--        -- The transition we inspected is not for the current input, and it is not-        -- a wildcard either; look at the next transition then.-        _ -> lookupTransition offset remaining acc state input (i + 1)-  in-    consumeInput initialOffset initialRemaining seed stateInitial- -- NOTE: To get full advantage of inlining this function, you probably want to -- compile the compiling module with -fllvm and the same optimization flags as -- this module.@@ -499,12 +533,10 @@ runText :: forall a v. a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a runText = runWithCase CaseSensitive --- Finds all matches in the lowercased text. This function lowercases the text--- on the fly to avoid allocating a second lowercased text array. Lowercasing is--- applied to individual code units, so the indexes into the lowercased text can--- be used to index into the original text. It is still the responsibility of--- the caller to lowercase the needles. Needles that contain uppercase code--- points will not match.+-- Finds all matches in the lowercased text. This function lowercases the input text+-- on the fly to avoid allocating a second lowercased text array.  It is still the+-- responsibility of  the caller to lowercase the needles. Needles that contain+-- uppercase code  points will not match. -- -- NOTE: To get full advantage of inlining this function, you probably want to -- compile the compiling module with -fllvm and the same optimization flags as

@@ -12,36 +12,34 @@  -- | Implements sequential string replacements based on the Aho-Corasick algorithm. module Data.Text.AhoCorasick.Replacer-  ( -- * State machine-    Replacer (..)-  , build-  , compose-  , run-  , runWithLimit-  , Needle-  , Replacement-  , Payload (..)-  ) where+    ( -- * State machine+      Needle+    , Payload (..)+    , Replacement+    , Replacer (..)+    , build+    , compose+    , run+    , runWithLimit+    ) where  import Control.DeepSeq (NFData) import Data.Hashable (Hashable) import Data.List (sort) import Data.Maybe (fromJust)-import Data.Text (Text) import GHC.Generics (Generic)  #if defined(HAS_AESON) import qualified Data.Aeson as AE #endif -import qualified Data.Text as Text--import Data.Text.AhoCorasick.Automaton (CaseSensitivity (..), CodeUnitIndex)+import Data.Text.CaseSensitivity (CaseSensitivity (..))+import Data.Text.Utf8 (CodeUnitIndex, Text) import Data.Text.AhoCorasick.Searcher (Searcher) +import qualified Data.Text.Utf8 as Utf8 import qualified Data.Text.AhoCorasick.Automaton as Aho import qualified Data.Text.AhoCorasick.Searcher as Searcher-import qualified Data.Text.Utf16 as Utf16  -- | Descriptive type alias for strings to search for. type Needle = Text@@ -80,8 +78,8 @@ -- | Build an Aho-Corasick automaton that can be used for performing fast -- sequential replaces. ----- Case-insensitive matching performs per-letter language-agnostic case folding.--- Therefore, it will work in most cases, but not in languages where case folding+-- Case-insensitive matching performs per-letter language-agnostic lower-casing.+-- Therefore, it will work in most cases, but not in languages where lower-casing -- depends on the context of the character in question. -- -- We need to revisit this algorithm when we want to implement full Unicode@@ -94,12 +92,12 @@       let         needle' = case caseSensitivity of           CaseSensitive -> needle-          IgnoreCase -> Utf16.lowerUtf16 needle+          IgnoreCase -> Utf8.lowerUtf8 needle       in         -- Note that we negate i: earlier needles have a higher priority. We         -- could avoid it and define larger integers to be lower priority, but         -- that made the terminology in this module very confusing.-        (needle', Payload (-i) (Utf16.lengthUtf16 needle') replacement)+        (needle', Payload (-i) (Utf8.lengthUtf8 needle') replacement)  -- | Return the composition `replacer2` after `replacer1`, if they have the same -- case sensitivity. If the case sensitivity differs, Nothing is returned.@@ -125,7 +123,7 @@ -- | Apply replacements of all matches. Assumes that the matches are ordered by -- match position, and that no matches overlap. replace :: [Match] -> Text -> Text-replace matches haystack = Text.concat $ go 0 matches haystack+replace matches haystack = Utf8.concat $ go 0 matches haystack   where     -- At every match, cut the string into three pieces, removing the match.     -- Because a Text is a buffer pointer and (offset, length), cutting does not@@ -139,23 +137,23 @@     go !_offset [] remainder = [remainder]     go !offset ((Match pos len replacement) : ms) remainder =       let-        (prefix, suffix) = Utf16.unsafeCutUtf16 (pos - offset) len remainder+        (prefix, suffix) = Utf8.unsafeCutUtf8 (pos - offset) len remainder       in         prefix : replacement : go (pos + len) ms suffix  -- | Compute the length of the string resulting from applying the replacements. replacementLength :: [Match] -> Text -> CodeUnitIndex-replacementLength matches initial  = go matches (Utf16.lengthUtf16 initial)+replacementLength matches initial  = go matches (Utf8.lengthUtf8 initial)   where     go [] !acc = acc-    go (Match _ matchLen repl : rest) !acc = go rest (acc - matchLen + Utf16.lengthUtf16 repl)+    go (Match _ matchLen repl : rest) !acc = go rest (acc - matchLen + Utf8.lengthUtf8 repl)  -- | Given a list of matches sorted on start position, remove matches that start -- within an earlier match. removeOverlap :: [Match] -> [Match] removeOverlap matches = case matches of   [] -> []-  m:[] -> m:[]+  [m] -> [m]   (m0@(Match pos0 len0 _) : m1@(Match pos1 _ _) : ms) ->     if pos1 >= pos0 + len0       then m0 : removeOverlap (m1:ms)@@ -173,7 +171,7 @@ prependMatch :: Priority -> (Priority, [Match]) -> Aho.Match Payload -> Aho.Next (Priority, [Match]) prependMatch !threshold (!pBest, !matches) (Aho.Match pos (Payload pMatch len replacement))   | pMatch < threshold && pMatch >  pBest = Aho.Step (pMatch, [Match (pos - len) len replacement])-  | pMatch < threshold && pMatch == pBest = Aho.Step (pMatch, (Match (pos - len) len replacement) : matches)+  | pMatch < threshold && pMatch == pBest = Aho.Step (pMatch, Match (pos - len) len replacement : matches)   | otherwise = Aho.Step (pBest, matches)  run :: Replacer -> Text -> Text

@@ -1,5 +1,5 @@ -- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable+-- Copyright 2022 Channable -- -- Licensed under the 3-clause BSD license, see the LICENSE file in the -- repository root.@@ -27,19 +27,19 @@  import Control.DeepSeq (NFData) import Data.Hashable (Hashable (hashWithSalt), Hashed, hashed, unhashed)-import Data.Text (Text) import GHC.Generics (Generic) -import qualified Data.IntSet as IS- #if defined(HAS_AESON) import Data.Aeson ((.:), (.=)) import qualified Data.Aeson as AE #endif-import Data.Text.AhoCorasick.Automaton (CaseSensitivity (..)) +import qualified Data.IntSet as IS++import Data.Text.CaseSensitivity (CaseSensitivity (..))+import Data.Text.Utf8 (Text)+ import qualified Data.Text.AhoCorasick.Automaton as Aho-import qualified Data.Text.Utf16 as Utf16  -- | A set of needles with associated values, and an Aho-Corasick automaton to -- efficiently find those needles.@@ -113,10 +113,7 @@ buildWithValues :: Hashable v => CaseSensitivity -> [(Text, v)] -> Searcher v {-# INLINABLE buildWithValues #-} buildWithValues case_ ns =-  let-    unpack (text, value) = (Utf16.unpackUtf16 text, value)-  in-    Searcher case_ (hashed ns) (length ns) $ Aho.build $ fmap unpack ns+  Searcher case_ (hashed ns) (length ns) $ Aho.build ns  needles :: Searcher v -> [(Text, v)] needles = unhashed . searcherNeedles@@ -154,8 +151,8 @@     -- On the first match, return True immediately.     f _acc _match = Aho.Done True   in case caseSensitivity searcher of-    CaseSensitive -> Aho.runText False f (automaton searcher) text-    IgnoreCase   -> Aho.runLower False f (automaton searcher) text+    CaseSensitive  -> Aho.runText False f (automaton searcher) text+    IgnoreCase      -> Aho.runLower False f (automaton searcher) text  -- | Build a 'Searcher' that returns the needle's index in the needle list when it matches. buildNeedleIdSearcher :: CaseSensitivity -> [Text] -> Searcher Int@@ -178,4 +175,4 @@    in IS.null $ case caseSensitivity searcher of     CaseSensitive -> Aho.runText initial f ac haystack-    IgnoreCase   -> Aho.runLower initial f ac haystack+    IgnoreCase -> Aho.runLower initial f ac haystack

@@ -9,21 +9,21 @@  -- | Splitting strings using Aho–Corasick. module Data.Text.AhoCorasick.Splitter-  ( Splitter-  , build-  , automaton-  , separator-  , split-  , splitIgnoreCase-  , splitReverse-  , splitReverseIgnoreCase-  ) where+    ( Splitter+    , automaton+    , build+    , separator+    , split+    , splitIgnoreCase+    , splitReverse+    , splitReverseIgnoreCase+    ) where  import Control.DeepSeq (NFData (..)) import Data.Function (on) import Data.Hashable (Hashable (..)) import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Text (Text)+import Data.Text.Utf8 (Text)  #if defined(HAS_AESON) import qualified Data.Aeson as AE@@ -33,8 +33,8 @@  import Data.Text.AhoCorasick.Automaton (AcMachine) +import qualified Data.Text.Utf8 as Utf8 import qualified Data.Text.AhoCorasick.Automaton as Aho-import qualified Data.Text.Utf16 as Utf16  -------------------------------------------------------------------------------- -- Splitter@@ -58,7 +58,7 @@ {-# INLINE build #-} build :: Text -> Splitter build sep =-  let !auto = Aho.build [(Utf16.unpackUtf16 sep, ())] in+  let !auto = Aho.build [(sep, ())] in   Splitter auto sep  -- | Get the automaton that would be used for finding separators.@@ -134,13 +134,13 @@   -- Once we have processed all the matches, there is still the substring after   -- the final match. This substring is always included in the result, even   -- when there were no matches. Hence we can return a non-empty list.-  let !str = Utf16.unsafeSliceUtf16 prevEnd (Utf16.lengthUtf16 hay - prevEnd) hay in+  let !str = Utf8.unsafeSliceUtf8 prevEnd (Utf8.lengthUtf8 hay - prevEnd) hay in   str :| res  -- | The initial accumulator begins at the begin of the haystack. {-# INLINE zeroAccum #-} zeroAccum :: Text -> Text -> Accum-zeroAccum sep hay = Accum (Utf16.lengthUtf16 sep) hay [] 0+zeroAccum sep hay = Accum (Utf8.lengthUtf8 sep) hay [] 0  -- | Step the accumulator using the next match. Overlapping matches will be -- ignored. Overlapping matches may occur when the separator has a non-empty@@ -157,7 +157,7 @@   -- The match is behind the current offset, so we slice the haystack until the   -- begin of the match and include that as a result.   | otherwise =-      let !str = Utf16.unsafeSliceUtf16 prevEnd (sepEnd - sepLen - prevEnd) hay in+      let !str = Utf8.unsafeSliceUtf8 prevEnd (sepEnd - sepLen - prevEnd) hay in       Aho.Step acc { accumResult = str : res, accumPrevEnd = sepEnd }  --------------------------------------------------------------------------------

@@ -28,7 +28,6 @@     , buildAutomaton     , patternLength     , patternText-    , runLower     , runText     ) where @@ -38,21 +37,23 @@ import Control.Monad (when) import Control.Monad.ST (runST) import Data.Hashable (Hashable (..), Hashed, hashed, unhashed)-import Data.Text.Internal (Text (..))-import Data.TypedByteArray (Prim, TypedByteArray) import GHC.Generics (Generic)  #if defined(HAS_AESON) import qualified Data.Aeson as AE #endif-import qualified Data.HashMap.Strict as HashMap -import Data.Text.AhoCorasick.Automaton (Next (..)) import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf16 (CodeUnit, CodeUnitIndex (..), lengthUtf16, lowerCodeUnit, unsafeIndexUtf16)+import Data.Text.Utf8 (CodeUnit, CodeUnitIndex (..), Text)+import Data.TypedByteArray (Prim, TypedByteArray) +import qualified Data.Text.Utf8 as Utf8 import qualified Data.TypedByteArray as TBA +data Next a+  = Done !a+  | Step !a+ -- | A Boyer-Moore automaton is based on lookup-tables that allow skipping through the haystack. -- This allows for sub-linear matching in some cases, as we do not have to look at every input -- character.@@ -88,36 +89,46 @@ buildAutomaton :: Text -> Automaton buildAutomaton pattern = Automaton (hashed pattern) (buildSuffixTable pattern) (buildBadCharTable pattern) -runWithCase-  :: forall a-  .  CaseSensitivity-  -> a+-- | Finds all matches in the text, calling the match callback with the *first*+-- matched character of each match of the pattern.+--+-- NOTE: This is unlike Aho-Corasick, which reports the index of the character+-- right after a match.+--+-- NOTE: In the UTF-16 version of this module, there is a function 'Data.Text.BoyerMoore.Automaton.runLower'+-- which does lower-case matching. This function does not exist for the UTF-8 version since it is very+-- tricky to skip code points going backwards without preprocessing the whole input first.+--+-- NOTE: To get full advantage of inlining this function, you probably want to+-- compile the compiling module with -fllvm and the same optimization flags as+-- this module.+runText  :: forall a+  . a   -> (a -> CodeUnitIndex -> Next a)   -> Automaton   -> Text   -> a-{-# INLINE runWithCase #-}-runWithCase caseSensitivity seed f automaton text+{-# INLINE runText #-}+runText seed f automaton text   | patLen == 0 = seed   | otherwise = go seed (patLen - 1)   where     Automaton patternHashed suffixTable badCharTable = automaton-    pattern = unhashed patternHashed-    patLen = lengthUtf16 pattern-    stringLen = lengthUtf16 text+    -- Use needle as identifier since pattern is potentially a keyword+    needle = unhashed patternHashed+    patLen = Utf8.lengthUtf8 needle+    stringLen = Utf8.lengthUtf8 text -    inputCasedAt = case caseSensitivity of-      CaseSensitive -> indexCodePoint text-      IgnoreCase -> lowerCodeUnit . indexCodePoint text+    codeUnitAt = Utf8.unsafeIndexCodeUnit text +    {-# INLINE go #-}     go result haystackIndex       | haystackIndex < stringLen = matchLoop result haystackIndex (patLen - 1)       | otherwise = result-    {-# INLINE go #-}      -- Compare the needle back-to-front with the haystack     matchLoop result haystackIndex needleIndex-      | needleIndex >= 0 && inputCasedAt haystackIndex == indexCodePoint pattern needleIndex =+      | needleIndex >= 0 && codeUnitAt haystackIndex == Utf8.unsafeIndexCodeUnit needle needleIndex =         -- Characters match, try the pair before         matchLoop result (haystackIndex - 1) (needleIndex - 1)       -- We found a match (all needle characters matched)@@ -137,42 +148,15 @@           -- is lined up with it's rightmost occurrence in the needle.           -- Note: we could end up left of were we started, essentially never making progress,           -- if we were to use this rule alone.-          badCharSkip = badCharLookup badCharTable (inputCasedAt haystackIndex)+          badCharSkip = badCharLookup badCharTable (codeUnitAt haystackIndex)           suffixSkip = suffixLookup suffixTable needleIndex           skip = max badCharSkip suffixSkip         in           go result (haystackIndex + skip) --- | Finds all matches in the text, calling the match callback with the *first*--- matched character of each match of the pattern.------ NOTE: This is unlike Aho-Corasick, which reports the index of the character--- right after a match.------ NOTE: To get full advantage of inlining this function, you probably want to--- compile the compiling module with -fllvm and the same optimization flags as--- this module.-{-# INLINE runText #-}-runText :: forall a. a -> (a -> CodeUnitIndex -> Next a) -> Automaton -> Text -> a-runText = runWithCase CaseSensitive---- | Finds all matches in the lowercased text. This function lowercases the text--- on the fly to avoid allocating a second lowercased text array. Lowercasing is--- applied to individual code units, so the indexes into the lowercased text can--- be used to index into the original text. It is still the responsibility of--- the caller to lowercase the needles. Needles that contain uppercase code--- points will not match.------ NOTE: To get full advantage of inlining this function, you probably want to--- compile the compiling module with -fllvm and the same optimization flags as--- this module.-{-# INLINE runLower #-}-runLower :: forall a. a -> (a -> CodeUnitIndex -> Next a) -> Automaton -> Text -> a-runLower = runWithCase IgnoreCase---- | Length of the matched pattern measured in Utf16 code units.+-- | Length of the matched pattern measured in UTF-8 code units (bytes). patternLength :: Automaton -> CodeUnitIndex-patternLength = lengthUtf16 . patternText+patternLength = Utf8.lengthUtf8 . patternText  -- | Return the pattern that was used to construct the automaton. patternText :: Automaton -> Text@@ -191,7 +175,7 @@  buildSuffixTable :: Text -> SuffixTable buildSuffixTable pattern = runST $ do-  let patLen = lengthUtf16 pattern+  let patLen = Utf8.lengthUtf8 pattern    table <- TBA.newTypedByteArray $ codeUnitIndex patLen @@ -231,7 +215,7 @@       | p < patLen - 1 = do         let           suffixLen = suffixLength pattern p-        when (indexCodePoint pattern (p - suffixLen) /= indexCodePoint pattern (patLen - 1 - suffixLen)) $+        when (Utf8.unsafeIndexCodeUnit pattern (p - suffixLen) /= Utf8.unsafeIndexCodeUnit pattern (patLen - 1 - suffixLen)) $           TBA.writeTypedByteArray table (codeUnitIndex $ patLen - 1 - suffixLen) (codeUnitIndex $ patLen - 1 - p + suffixLen)         init2 (p + 1)       | otherwise = pure ()@@ -246,38 +230,36 @@ -- in the input string. For example, if there's a character that is not contained in the pattern at -- all, we can skip ahead until after that character. data BadCharTable = BadCharTable-  { badCharTableAscii :: {-# UNPACK #-} !(TypedByteArray Int)+  { badCharTableEntries :: {-# UNPACK #-} !(TypedByteArray Int)     -- ^ The element type should be CodeUnitIndex, but there's no unboxed vector for that type, and     -- defining it would be a lot of boilerplate.-  , badCharTableNonAscii :: !(HashMap.HashMap CodeUnit CodeUnitIndex)   , badCharTablePatternLen :: CodeUnitIndex   }   deriving stock (Generic, Show)   deriving anyclass (NFData)  -- | Number of entries in the fixed-size lookup-table of the bad char table.-asciiCount :: Int-{-# INLINE asciiCount #-}-asciiCount = 128+badcharTableSize :: Int+{-# INLINE badcharTableSize #-}+badcharTableSize = 256  -- | Lookup an entry in the bad char table. badCharLookup :: BadCharTable -> CodeUnit -> CodeUnitIndex {-# INLINE badCharLookup #-}-badCharLookup (BadCharTable asciiTable nonAsciis patLen) char-  | intChar < asciiCount = CodeUnitIndex $ indexTable asciiTable intChar-  | otherwise = HashMap.lookupDefault patLen char nonAsciis+badCharLookup (BadCharTable asciiTable _patLen) char = CodeUnitIndex $ indexTable asciiTable intChar   where     intChar = fromIntegral char  -- | True if the suffix of the @pattern@ starting from @pos@ is a prefix of the pattern -- For example, @isPrefix \"aabbaa\" 4 == True@. isPrefix :: Text -> CodeUnitIndex -> Bool-isPrefix pattern pos = go 0+isPrefix needle pos = go 0   where-    suffixLen = lengthUtf16 pattern - pos+    suffixLen = Utf8.lengthUtf8 needle - pos     go i       | i < suffixLen =-        if indexCodePoint pattern i == indexCodePoint pattern (pos + i)+        -- FIXME: Check whether implementing the linter warning kills tco+        if Utf8.unsafeIndexCodeUnit needle i == Utf8.unsafeIndexCodeUnit needle (pos + i)           then go (i + 1)           else False       | otherwise = True@@ -288,18 +270,18 @@ suffixLength :: Text -> CodeUnitIndex -> CodeUnitIndex suffixLength pattern pos = go 0   where-    patLen = lengthUtf16 pattern+    patLen = Utf8.lengthUtf8 pattern     go i-      | indexCodePoint pattern (pos - i) == indexCodePoint pattern (patLen - 1 - i) && i < pos = go (i + 1)+      | Utf8.unsafeIndexCodeUnit pattern (pos - i) == Utf8.unsafeIndexCodeUnit pattern (patLen - 1 - i) && i < pos = go (i + 1)       | otherwise = i  buildBadCharTable :: Text -> BadCharTable buildBadCharTable pattern = runST $ do-  let patLen = lengthUtf16 pattern+  let patLen = Utf8.lengthUtf8 pattern    -- Initialize table with the maximum skip distance, which is the length of the pattern.   -- This applies to all characters that are not part of the pattern.-  asciiTable <- TBA.replicate asciiCount $ codeUnitIndex patLen+  asciiTable <- TBA.replicate badcharTableSize $ codeUnitIndex patLen    let     -- Fill the bad character table based on the rightmost occurrence of a character in the pattern.@@ -330,26 +312,20 @@      --    Haystack: aaadddabcdbb     --    Pattern:     adcd-    fillTable !i !nonAsciis+    fillTable !i       -- for(i = 0; i < patLen - 1; i++) {       | i < patLen - 1 = do-        let patChar = indexCodePoint pattern i-        if fromIntegral patChar < asciiCount-          then do-            TBA.writeTypedByteArray asciiTable (fromIntegral patChar) (codeUnitIndex $ patLen - 1 - i)-            fillTable (i + 1) nonAsciis-          else-            fillTable (i + 1) (HashMap.insert patChar (patLen - 1 - i) nonAsciis)-      -- }-      | otherwise = pure nonAsciis+        let patChar = Utf8.unsafeIndexCodeUnit pattern i+        TBA.writeTypedByteArray asciiTable (fromIntegral patChar) (codeUnitIndex $ patLen - 1 - i)+        fillTable (i + 1)+      | otherwise = pure () -  nonAsciis <- fillTable 0 HashMap.empty+  fillTable 0    asciiTableFrozen <- TBA.unsafeFreezeTypedByteArray asciiTable    pure BadCharTable-    { badCharTableAscii = asciiTableFrozen-    , badCharTableNonAscii = nonAsciis+    { badCharTableEntries = asciiTableFrozen     , badCharTablePatternLen = patLen     } @@ -360,11 +336,3 @@ indexTable :: Prim a => TypedByteArray a -> Int -> a {-# INLINE indexTable #-} indexTable = TBA.unsafeIndex----- | Read from a lookup table at the specified index.-indexCodePoint :: Text -> CodeUnitIndex -> CodeUnit-{-# INLINE indexCodePoint #-}-indexCodePoint text index-  | index < 0 || index >= lengthUtf16 text = error $ "Index out of bounds " ++ show index-  | otherwise = unsafeIndexUtf16 text index

@@ -8,40 +8,33 @@ {-# LANGUAGE FlexibleInstances #-}  module Data.Text.BoyerMoore.Replacer-  ( -- Replacer-  replaceSingleLimited-  )-  where+    ( -- Replacer+      replaceSingleLimited+    ) where -import Data.Text (Text)+import Data.Text.Utf8 (Text) import Data.Text.BoyerMoore.Automaton (Automaton, CodeUnitIndex) -import qualified Data.Text as Text--import Data.Text.BoyerMoore.Automaton (CaseSensitivity (..))-+import qualified Data.Text.Utf8 as Text+import qualified Data.Text.Utf8 as Utf8 import qualified Data.Text.BoyerMoore.Automaton as BoyerMoore-import qualified Data.Text.Utf16 as Utf16  -- | Replace all occurrences matched by the Boyer-Moore automaton -- with the given replacement text in some haystack.+-- Performs case-sensitive replacement. replaceSingleLimited-  :: CaseSensitivity-  -- ^ In case of 'IgnoreCase', the automaton must have been created with a lower-case needle-  -> Automaton -- ^ Matches the needles+  :: Automaton -- ^ Matches the needles   -> Text -- ^ Replacement string   -> Text -- ^ Haystack   -> CodeUnitIndex -- ^ Maximum number of code units in the returned text   -> Maybe Text-replaceSingleLimited caseSensitivity needle replacement haystack maxLength+replaceSingleLimited needle replacement haystack maxLength   | needleLength == 0 = Just $ if haystackLength == 0 then replacement else haystack-  | otherwise = finish $ case caseSensitivity of-      CaseSensitive -> BoyerMoore.runText initial foundMatch needle haystack-      IgnoreCase -> BoyerMoore.runLower initial foundMatch needle haystack+  | otherwise = finish $ BoyerMoore.runText initial foundMatch needle haystack   where     needleLength = BoyerMoore.patternLength needle-    haystackLength = Utf16.lengthUtf16 haystack-    replacementLength = Utf16.lengthUtf16 replacement+    haystackLength = Utf8.lengthUtf8 haystack+    replacementLength = Utf8.lengthUtf8 replacement      initial = ReplaceState       { rsChunks = []@@ -56,7 +49,7 @@         -- Slice the part of the haystack between the end of the previous match         -- and the start of the current match         haystackPartLength = matchStart - rsPreviousMatchEnd rs-        haystackPart = Utf16.unsafeSliceUtf16 (rsPreviousMatchEnd rs) haystackPartLength haystack+        haystackPart = Utf8.unsafeSliceUtf8 (rsPreviousMatchEnd rs) haystackPartLength haystack          -- Add the preceding part of the haystack and the replacement in reverse         -- order to the chunk list (all chunks will be reversed at once in the final step).@@ -79,7 +72,7 @@         -- to the end of the haystack.         haystackPartLength = haystackLength - rsPreviousMatchEnd rs         finalChunks-            = Utf16.unsafeSliceUtf16 (rsPreviousMatchEnd rs) haystackPartLength haystack+            = Utf8.unsafeSliceUtf8 (rsPreviousMatchEnd rs) haystackPartLength haystack             : rsChunks rs         finalLength = rsLength rs + haystackPartLength       in

@@ -14,24 +14,24 @@     , build     , buildNeedleIdSearcher     , buildWithValues-    , caseSensitivity     , containsAll     , containsAny     , needles     , numNeedles-    , setSearcherCaseSensitivity     ) where + import Control.DeepSeq (NFData) import Data.Bifunctor (first) import Data.Hashable (Hashable (hashWithSalt), Hashed, hashed, unhashed)-import Data.Text (Text) import GHC.Generics (Generic) -import Data.Text.BoyerMoore.Automaton (Automaton, CaseSensitivity (..))+import Data.Text.Utf8 (Text)+import Data.Text.BoyerMoore.Automaton (Automaton)  import qualified Data.Text.BoyerMoore.Automaton as BoyerMoore + -- | A set of needles with associated values, and Boyer-Moore automata to -- efficiently find those needles. --@@ -48,8 +48,7 @@ -- -- We also use Hashed to cache the hash of the needles. data Searcher v = Searcher-  { searcherCaseSensitive :: CaseSensitivity-  , searcherNeedles :: Hashed [(Text, v)]+  { searcherNeedles :: Hashed [(Text, v)]   , searcherNumNeedles :: Int   , searcherAutomata :: [(Automaton, v)]   } deriving (Generic)@@ -62,24 +61,22 @@   {-# INLINE hashWithSalt #-}  instance Eq v => Eq (Searcher v) where-  Searcher cx xs nx _ == Searcher cy ys ny _ = (cx, nx, xs) == (cy, ny, ys)+  Searcher xs nx _ == Searcher ys ny _ = (xs, nx) == (ys, ny)   {-# INLINE (==) #-}  instance NFData v => NFData (Searcher v) --- | Builds the Searcher for a list of needles--- The caller is responsible that the needles are lower case in case the IgnoreCase--- is used for case sensitivity-build :: CaseSensitivity -> [Text] -> Searcher ()+-- | Builds the Searcher for a list of needles without values.+-- This is useful for just checking whether the haystack contains the needles.+build :: [Text] -> Searcher () {-# INLINABLE build #-}-build case_ = buildWithValues case_ . flip zip (repeat ())+build = buildWithValues . flip zip (repeat ()) --- | The caller is responsible that the needles are lower case in case the IgnoreCase--- is used for case sensitivity-buildWithValues :: Hashable v => CaseSensitivity -> [(Text, v)] -> Searcher v+-- | Builds the Searcher for a list of needles.+buildWithValues :: Hashable v => [(Text, v)] -> Searcher v {-# INLINABLE buildWithValues #-}-buildWithValues case_ ns =-  Searcher case_ (hashed ns) (length ns) $ map (first BoyerMoore.buildAutomaton) ns+buildWithValues ns =+  Searcher (hashed ns) (length ns) $ map (first BoyerMoore.buildAutomaton) ns  needles :: Searcher v -> [(Text, v)] needles = unhashed . searcherNeedles@@ -90,20 +87,7 @@ numNeedles :: Searcher v -> Int numNeedles = searcherNumNeedles -caseSensitivity :: Searcher v -> CaseSensitivity-caseSensitivity = searcherCaseSensitive---- | Updates the case sensitivity of the searcher. Does not change the--- capitilization of the needles. The caller should be certain that if IgnoreCase--- is passed, the needles are already lower case.-setSearcherCaseSensitivity :: CaseSensitivity -> Searcher v -> Searcher v-setSearcherCaseSensitivity case_ searcher = searcher{-    searcherCaseSensitive = case_-  }-- -- | Return whether the haystack contains any of the needles.--- Case sensitivity depends on the properties of the searcher -- This function is marked noinline as an inlining boundary. BoyerMoore.runText is -- marked inline, so this function will be optimized to report only whether -- there is a match, and not construct a list of matches. We don't want this@@ -118,17 +102,13 @@     -- On the first match, return True immediately.     f _acc _match = BoyerMoore.Done True   in-    case caseSensitivity searcher of-      CaseSensitive ->-        any (\(automaton, ()) -> BoyerMoore.runText False f automaton text) (automata searcher)-      IgnoreCase ->-        any (\(automaton, ()) -> BoyerMoore.runLower False f automaton text) (automata searcher)-+    any (\(automaton, ()) -> BoyerMoore.runText False f automaton text) (automata searcher) -- | Build a 'Searcher' that returns the needle's index in the needle list when it matches.-buildNeedleIdSearcher :: CaseSensitivity -> [Text] -> Searcher Int-buildNeedleIdSearcher !case_ !ns =-  buildWithValues case_ $ zip ns [0..] +buildNeedleIdSearcher :: [Text] -> Searcher Int+buildNeedleIdSearcher !ns =+  buildWithValues $ zip ns [0..]+ -- | Like 'containsAny', but checks whether all needles match instead. -- Use 'buildNeedleIdSearcher' to get an appropriate 'Searcher'. {-# NOINLINE containsAll #-}@@ -138,8 +118,4 @@     -- On the first match, return True immediately.     f _acc _match = BoyerMoore.Done True   in-    case caseSensitivity searcher of-      CaseSensitive ->-        all (\(automaton, _) -> BoyerMoore.runText False f automaton text) (automata searcher)-      IgnoreCase ->-        all (\(automaton, _) -> BoyerMoore.runLower False f automaton text) (automata searcher)+    all (\(automaton, _) -> BoyerMoore.runText False f automaton text) (automata searcher)

@@ -1,233 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}---- | This module provides functions that allow treating Text values as series of UTF-16 codepoints--- instead of characters.-module Data.Text.Utf16-    ( CodeUnit-    , CodeUnitIndex (..)-    , indexTextArray-    , isCaseInvariant-    , lengthUtf16-    , lowerCodeUnit-    , lowerUtf16-    , unpackUtf16-    , unsafeCutUtf16-    , unsafeIndexUtf16-    , unsafeSliceUtf16-    , upperCodeUnit-    , upperUtf16-    ) where--import Prelude hiding (length)--import Control.DeepSeq (NFData)-import Control.Exception (assert)-import Data.Hashable (Hashable)-import Data.Primitive.ByteArray (ByteArray (..), sizeofByteArray)-import Data.Text.Internal (Text (..))-import Data.Word (Word16)-import GHC.Generics (Generic)--#if defined(HAS_AESON)-import qualified Data.Aeson as AE-#endif--import qualified Data.Char as Char-import qualified Data.Text as Text-import qualified Data.Text.Array as TextArray-import qualified Data.Text.Unsafe as TextUnsafe-import qualified Data.Vector.Primitive as PVector---- | A code unit is a 16-bit integer from which UTF-16 encoded text is built up.--- The `Text` type is represented as a UTF-16 string.-type CodeUnit = Word16---- | An index into the raw UTF-16 data of a `Text`. This is not the code point--- index as conventionally accepted by `Text`, so we wrap it to avoid confusing--- the two. Incorrect index manipulation can lead to surrogate pairs being--- sliced, so manipulate indices with care. This type is also used for lengths.-newtype CodeUnitIndex = CodeUnitIndex-  { codeUnitIndex :: Int-  }-  deriving stock (Eq, Ord, Show, Generic, Bounded)-#if defined(HAS_AESON)-  deriving newtype (Hashable, Num, NFData, AE.FromJSON, AE.ToJSON)-#else-  deriving newtype (Hashable, Num, NFData)-#endif----- | Return a 'Text' as a list of UTF-16 code units.-{-# INLINABLE unpackUtf16 #-}-unpackUtf16 :: Text -> [CodeUnit]-unpackUtf16 (Text u16data offset length) =-  let-    go _ 0 = []-    go i n = indexTextArray u16data i : go (i + 1) (n - 1)-  in-    go offset length---- | Return whether the code unit at the given index starts a surrogate pair.--- Such a code unit must be followed by a low surrogate in valid UTF-16.--- Returns false on out of bounds indices.-{-# INLINE isHighSurrogate #-}-isHighSurrogate :: Int -> Text -> Bool-isHighSurrogate !i (Text !u16data !offset !len) =-  let-    w = indexTextArray u16data (offset + i)-  in-    i >= 0 && i < len && w >= 0xd800 && w <= 0xdbff---- | Return whether the code unit at the given index ends a surrogate pair.--- Such a code unit must be preceded by a high surrogate in valid UTF-16.--- Returns false on out of bounds indices.-{-# INLINE isLowSurrogate #-}-isLowSurrogate :: Int -> Text -> Bool-isLowSurrogate !i (Text !u16data !offset !len) =-  let-    w = indexTextArray u16data (offset + i)-  in-    i >= 0 && i < len && w >= 0xdc00 && w <= 0xdfff---- | Extract a substring from a text, at a code unit offset and length.--- This is similar to `Text.take length . Text.drop begin`, except that the--- begin and length are in code *units*, not code points, so we can slice the--- UTF-16 array, and we don't have to walk the entire text to take surrogate--- pairs into account. It is the responsibility of the user to not slice--- surrogate pairs, and to ensure that the length is within bounds, hence this--- function is unsafe.-{-# INLINE unsafeSliceUtf16 #-}-unsafeSliceUtf16 :: CodeUnitIndex -> CodeUnitIndex -> Text -> Text-unsafeSliceUtf16 (CodeUnitIndex !begin) (CodeUnitIndex !length) !text-  = assert (begin + length <= TextUnsafe.lengthWord16 text)-  $ assert (not $ isLowSurrogate begin text)-  $ assert (not $ isHighSurrogate (begin + length - 1) text)-  $ TextUnsafe.takeWord16 length $ TextUnsafe.dropWord16 begin text---- | The complement of `unsafeSliceUtf16`: removes the slice, and returns the--- part before and after. See `unsafeSliceUtf16` for details.-{-# INLINE unsafeCutUtf16 #-}-unsafeCutUtf16 :: CodeUnitIndex -> CodeUnitIndex -> Text -> (Text, Text)-unsafeCutUtf16 (CodeUnitIndex !begin) (CodeUnitIndex !length) !text-  = assert (begin + length <= TextUnsafe.lengthWord16 text)-  $ assert (not $ isLowSurrogate begin text)-  $ assert (not $ isHighSurrogate (begin + length - 1) text)-    ( TextUnsafe.takeWord16 begin text-    , TextUnsafe.dropWord16 (begin + length) text-    )---- | Return the length of the text, in number of code units.-{-# INLINE lengthUtf16 #-}-lengthUtf16 :: Text -> CodeUnitIndex-lengthUtf16 = CodeUnitIndex . TextUnsafe.lengthWord16---- | Return the code unit (not character) with the given index.--- Note: The bounds are not checked.-unsafeIndexUtf16 :: Text -> CodeUnitIndex -> CodeUnit-{-# INLINE unsafeIndexUtf16 #-}-unsafeIndexUtf16 (Text arr off _) (CodeUnitIndex pos) = indexTextArray arr (pos + off)---- | Apply a function to each code unit of a text.-{-# INLINABLE mapUtf16 #-}-mapUtf16 :: (CodeUnit -> CodeUnit) -> Text -> Text-mapUtf16 f (Text u16data offset length) =-  let-    get !i = f $ indexTextArray u16data (offset + i)-    !(PVector.Vector !offset' !length' !(ByteArray !u16data')) =-      PVector.generate length get-  in-    Text (TextArray.Array u16data') offset' length'---- | Lowercase each individual code unit of a text without changing their index.--- This is not a proper case folding, but it does ensure that indices into the--- lowercased string correspond to indices into the original string.------ Differences from `Text.toLower` include code points in the BMP that lowercase--- to multiple code points, and code points outside of the BMP.------ For example, \"İ\" (U+0130), which `toLower` converts to \"i\" (U+0069, U+0307),--- is converted into U+0069 only by `lowerUtf16`.--- Also, \"𑢢\" (U+118A2), a code point from the Warang City writing system in the--- Supplementary Multilingual Plane, introduced in 2014 to Unicode 7. It would--- be lowercased to U+118C2 by `toLower`, but it is left untouched by--- `lowerUtf16`.-{-# INLINE lowerUtf16 #-}-lowerUtf16 :: Text -> Text-lowerUtf16 = mapUtf16 lowerCodeUnit---- | Convert CodeUnits that represent a character on their own (i.e. that are not part of a--- surrogate pair) to their lower case representation.------ This function has a special code path for ASCII characters, because Char.toLower--- is **incredibly** slow. It's implemented there if you want to see for yourself:--- (https://github.com/ghc/ghc/blob/ghc-8.6.3-release/libraries/base/cbits/WCsubst.c#L4732)--- (It does a binary search on 1276 casing rules)-{-# INLINE lowerCodeUnit #-}-lowerCodeUnit :: CodeUnit -> CodeUnit-lowerCodeUnit cu-  -- ASCII letters A..Z and a..z are two contiguous blocks.-  -- Converting to lower case amounts to adding a fixed offset.-  | fromIntegral cu >= Char.ord 'A' && fromIntegral cu <= Char.ord 'Z'-    = cu + fromIntegral (Char.ord 'a' - Char.ord 'A')--    -- Everything else in ASCII is invariant under toLower.-  -- The a..z range is already lower case, and all non-letter characters are case-invariant.-  | cu <= 127 = cu--  -- This code unit is part of a surrogate pair. Don't touch those, because-  -- we don't have all information required to decode the code point. Note-  -- that alphabets that need to be encoded as surrogate pairs are mostly-  -- archaic and obscure; all of the languages used by our customers have-  -- alphabets in the Basic Multilingual Plane, which does not need surrogate-  -- pairs. Note that the BMP is not just ascii or extended ascii. See also-  -- https://codepoints.net/basic_multilingual_plane.-  | cu >= 0xd800 && cu < 0xe000 = cu--  -- The code unit is a code point on its own (not part of a surrogate pair),-  -- lowercase the code point. These code points, which are all in the BMP,-  -- have the important property that lowercasing them is again a code point-  -- in the BMP, so the output can be encoded in exactly one code unit, just-  -- like the input. This property was verified by exhaustive testing; see-  -- also the test in AhoCorasickSpec.hs.-  | otherwise = fromIntegral $ Char.ord $ Char.toLower $ Char.chr $ fromIntegral cu---- | Lowercase each individual code unit of a text without changing their index.--- See also 'lowerUtf16' and 'lowerCodeUnit'.-{-# INLINE upperUtf16 #-}-upperUtf16 :: Text -> Text-upperUtf16 = mapUtf16 upperCodeUnit---- | Analogous to 'lowerCodeUnit'.-{-# INLINE upperCodeUnit #-}-upperCodeUnit :: CodeUnit -> CodeUnit-upperCodeUnit cu-  | fromIntegral cu >= Char.ord 'a' && fromIntegral cu <= Char.ord 'z'-    = cu - fromIntegral (Char.ord 'a' - Char.ord 'A')-  | cu <= 127 = cu-  | cu >= 0xd800 && cu < 0xe000 = cu-  | otherwise = fromIntegral $ Char.ord $ Char.toUpper $ Char.chr $ fromIntegral cu---- | Return whether text is the same lowercase as uppercase, such that this--- function will not return true when Aho–Corasick would differentiate when--- doing case-insensitive matching.-{-# INLINE isCaseInvariant #-}-isCaseInvariant :: Text -> Bool-isCaseInvariant = Text.all (\c -> Char.toLower c == Char.toUpper c)---- | Retrieve a code unit from 'Text's internal representation.-{-# INLINE indexTextArray #-}-indexTextArray :: TextArray.Array -> Int -> CodeUnit-indexTextArray array@(TextArray.Array byteArray) index-  = assert (2 * index < sizeofByteArray (ByteArray byteArray))-  $ assert (0 <= index)-  $ TextArray.unsafeIndex array index

@@ -9,15 +9,18 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}  -- | This module provides functions that allow treating 'Text' values as series of UTF-8 code units--- instead of characters. Currently, it also contains a stub 'Text' type which treats its internal byte array--- as UTF-8 encoded. We use this as a placeholder until we can use @text-2@.+-- instead of characters. Any calls to 'Text' in @alfred-margaret@ go through this module.+-- Therefore we re-export some 'Text' functions, e.g. 'Text.concat'. module Data.Text.Utf8     ( CodePoint     , CodeUnit     , CodeUnitIndex (..)     , Text (..)+    , fromByteList+    , isCaseInvariant     , lengthUtf8     , lowerCodePoint     , lowerUtf8@@ -31,53 +34,54 @@     , decode3     , decode4     , decodeUtf8-    , stringToByteArray       -- * Indexing       --       -- $indexing     , indexCodeUnit     , unsafeIndexCodePoint-    , unsafeIndexCodePoint'     , unsafeIndexCodeUnit-    , unsafeIndexCodeUnit'       -- * Slicing Functions       --       -- $slicingFunctions     , unsafeCutUtf8     , unsafeSliceUtf8+      -- * Functions on Arrays+      --+      -- $functionsOnArrays+    , arrayContents+    , isArrayPinned+    , unsafeIndexCodePoint'+    , unsafeIndexCodeUnit'       -- * General Functions       --       -- $generalFunctions-    , Data.Text.Utf8.concat-    , Data.Text.Utf8.dropWhile-    , Data.Text.Utf8.null-    , Data.Text.Utf8.readFile-    , Data.Text.Utf8.replicate-    , indices-    , isInfixOf-    , pack-    , unpack+    , Text.concat+    , Text.dropWhile+    , Text.isInfixOf+    , Text.null+    , Text.pack+    , Text.replicate+    , Text.unpack+    , TextSearch.indices     ) where -import Control.DeepSeq (NFData, rnf)+import Control.DeepSeq (NFData) import Data.Bits (Bits (shiftL), shiftR, (.&.), (.|.))-import Data.Char (ord)-import Data.Foldable (for_)-import Data.Hashable (Hashable (hashWithSalt), hashByteArrayWithSalt)-import Data.Primitive.ByteArray (ByteArray (ByteArray), byteArrayFromList, compareByteArrays,-                                 indexByteArray, newByteArray, sizeofByteArray,-                                 unsafeFreezeByteArray, writeByteArray)-import Data.String (IsString (fromString))+import Data.Hashable (Hashable)+import Data.Text.Internal (Text (..)) import Data.Word (Word8) import GHC.Generics (Generic)-import Prelude hiding (length)+import Data.Primitive (ByteArray(ByteArray), byteArrayFromList) #if defined(HAS_AESON)-import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON, toJSON, withText)+import Data.Aeson (FromJSON, ToJSON) #endif -import qualified Data.ByteString as BS import qualified Data.Char as Char-import qualified Data.Text as T+import qualified Data.Text as Text+import qualified Data.Text.Array as TextArray+import qualified Data.Text.Internal.Search as TextSearch+import qualified Data.Text.Unsafe as TextUnsafe+import qualified GHC.Exts as Exts  -- | A UTF-8 code unit is a byte. A Unicode code point can be encoded as up to four code units. type CodeUnit = Word8@@ -99,74 +103,19 @@     deriving newtype (Hashable, Num, NFData) #endif -data Text-  -- | A placeholder data type for UTF-8 encoded text until we can use text-2.0.-  = Text-      !ByteArray -- ^ Underlying array encoded using UTF-8.-      !Int -- ^ Starting position of the UTF-8 sequence in bytes.-      !Int -- ^ Length of the UTF-8 sequence in bytes.---- This instance, as well as the Show instance above, is necessary for the test suite.-instance Eq Text where-  (Text u8data offset length) == (Text u8data' offset' length') =-    length == length' && compareByteArrays u8data offset u8data' offset' length == EQ--instance Ord Text where-  compare (Text u8data offset length) (Text u8data' offset' length') =-    compareByteArrays u8data offset u8data' offset' (min length length') <> compare length length'--instance Show Text where-  show = show . unpack---- Instances required for the Searcher modules etc.--#if defined(HAS_AESON)--- NOTE: This is ugly and slow but will be removed once we move to text-2.0.-instance ToJSON Text where-  toJSON = String . T.pack . unpack--instance FromJSON Text where-  parseJSON = withText "Data.Text.Utf8.Text" (pure . pack . T.unpack)-#endif---- Copied from https://hackage.haskell.org/package/hashable-1.4.0.2/docs/src/Data.Hashable.Class.html#line-746-instance Hashable Text where-  hashWithSalt salt (Text (ByteArray arr) off len) =-    hashByteArrayWithSalt arr (off `shiftL` 1) (len `shiftL` 1) (hashWithSalt salt len)--instance NFData Text where-  rnf (Text (ByteArray !_) !_ !_) = ()--instance IsString Text where-  fromString = pack- {-# INLINABLE unpackUtf8 #-} unpackUtf8 :: Text -> [CodeUnit]-unpackUtf8 (Text u8data offset length) =+unpackUtf8 (Text u8data offset len) =   let     go _ 0 = []     go i n = unsafeIndexCodeUnit' u8data (CodeUnitIndex i) : go (i + 1) (n - 1)   in-    go offset length+    go offset len  -- | The return value of this function is not really an index. -- However the signature is supposed to make it clear that the length is returned in terms of code units, not code points. lengthUtf8 :: Text -> CodeUnitIndex-lengthUtf8 (Text _ _ !length) = CodeUnitIndex length---- | Convert a 'Text' value into a 'T.Text' value.-toUtf16Text :: Text -> T.Text-toUtf16Text (Text u8data off len) =-  T.unfoldr go 0-  where-    go :: CodeUnitIndex -> Maybe (Char, CodeUnitIndex)-    go i-      | i >= CodeUnitIndex len = Nothing-      | otherwise =-        let-          (codeUnits, codePoint) = unsafeIndexCodePoint' u8data $ CodeUnitIndex off + i-        in-          Just (codePoint, i + codeUnits)+lengthUtf8 (Text _ _ !len) = CodeUnitIndex len  -- | Lower-case the ASCII code points A-Z and leave the rest of ASCII intact. {-# INLINE toLowerAscii #-}@@ -175,10 +124,10 @@   | Char.isAsciiUpper cp = Char.chr (Char.ord cp + 0x20)   | otherwise = cp --- TODO: Slow placeholder implementation until we can use text-2.0+-- | Lowercase a 'Text' by applying 'lowerCodePoint' to each 'Char'. {-# INLINE lowerUtf8 #-} lowerUtf8 :: Text -> Text-lowerUtf8 = pack . map lowerCodePoint . unpack+lowerUtf8 = Text.map lowerCodePoint  asciiCount :: Int asciiCount = 128@@ -199,6 +148,17 @@     | c < 0x10000 = [0xe0 .|. (c `shiftR` 12), 0x80 .|. (0x3f .&. (c `shiftR` 6)), 0x80 .|. (0x3f .&. c)]     | otherwise   = [0xf0 .|. (c `shiftR` 18), 0x80 .|. (0x3f .&. (c `shiftR` 12)), 0x80 .|. (0x3f .&. (c `shiftR` 6)), 0x80 .|. (0x3f .&. c)] +fromByteList :: [Word8] -> Text+fromByteList byteList = Text (TextArray.ByteArray ba#) 0 (length byteList)+  where !(ByteArray ba#) = byteArrayFromList byteList++-- | Return whether text is the same lowercase as uppercase, such that this+-- function will not return true when Aho–Corasick would differentiate when+-- doing case-insensitive matching.+{-# INLINE isCaseInvariant #-}+isCaseInvariant :: Text -> Bool+isCaseInvariant = Text.all (\c -> Char.toLower c == Char.toUpper c)+ -- $decoding -- -- Functions that turns code unit sequences into code point sequences.@@ -245,34 +205,12 @@ decodeUtf8 (cu0 : cu1 : cu2 : cu3 : cus) | cu0 < 0xf8 = decode4 cu0 cu1 cu2 cu3 : decodeUtf8 cus decodeUtf8 cus = error $ "Invalid UTF-8 input sequence at " ++ show (take 4 cus) -stringToByteArray :: String -> ByteArray-stringToByteArray = byteArrayFromList . concatMap char2utf8-        -- See https://en.wikipedia.org/wiki/UTF-8-        where-            char2utf8 :: Char -> [Word8]-            char2utf8 = map fromIntegral . unicode2utf8 . ord- -- $indexing -- -- 'Text' can be indexed by code units or code points. -- A 'CodePoint' is a 21-bit Unicode code point and can consist of up to four code units. -- A 'CodeUnit' is a single byte. --- | Decode a code point at the given 'CodeUnitIndex'.--- Returns garbage if there is no valid code point at that position.--- Does not perform bounds checking.--- See 'decode2', 'decode3' and 'decode4' for the expected format of multi-byte code points.-{-# INLINE unsafeIndexCodePoint' #-}-unsafeIndexCodePoint' :: ByteArray -> CodeUnitIndex -> (CodeUnitIndex, CodePoint)-unsafeIndexCodePoint' !u8data (CodeUnitIndex !idx)-  | cu0 < 0xc0 = (1, Char.chr $ fromIntegral cu0)-  | cu0 < 0xe0 = (2, decode2 cu0 (cuAt 1))-  | cu0 < 0xf0 = (3, decode3 cu0 (cuAt 1) (cuAt 2))-  | otherwise = (4, decode4 cu0 (cuAt 1) (cuAt 2) (cuAt 3))-  where-    cuAt !i = unsafeIndexCodeUnit' u8data $ CodeUnitIndex $ idx + i-    !cu0 = cuAt 0- -- | Does exactly the same thing as 'unsafeIndexCodePoint'', but on 'Text' values. {-# INLINE unsafeIndexCodePoint #-} unsafeIndexCodePoint :: Text -> CodeUnitIndex -> (CodeUnitIndex, CodePoint)@@ -287,10 +225,6 @@   | index < 0 || index >= codeUnitIndex (lengthUtf8 text) = error $ "Index out of bounds " ++ show index   | otherwise = unsafeIndexCodeUnit text $ CodeUnitIndex index -{-# INLINE unsafeIndexCodeUnit' #-}-unsafeIndexCodeUnit' :: ByteArray -> CodeUnitIndex -> CodeUnit-unsafeIndexCodeUnit' !u8data (CodeUnitIndex !idx) = indexByteArray u8data idx- {-# INLINE unsafeIndexCodeUnit #-} unsafeIndexCodeUnit :: Text -> CodeUnitIndex -> CodeUnit unsafeIndexCodeUnit (Text !u8data !off !_len) (CodeUnitIndex !index) =@@ -326,108 +260,50 @@ -- -- __WARNING__: As their name implies, these functions are not (necessarily) bounds-checked. Use at your own risk. --- TODO: Make this more readable once we have text-2.0. unsafeCutUtf8 :: CodeUnitIndex -- ^ Starting position of substring.   -> CodeUnitIndex -- ^ Length of substring.   -> Text -- ^ Initial string.   -> (Text, Text)-unsafeCutUtf8 (CodeUnitIndex !begin) (CodeUnitIndex !length) (Text !u8data !off !len) =-  ( Text u8data off begin-  , Text u8data (off + begin + length) (len - begin - length)+unsafeCutUtf8 (CodeUnitIndex !begin) (CodeUnitIndex !len) !text =+  ( TextUnsafe.takeWord8 begin text+  , TextUnsafe.dropWord8 (begin + len) text   ) --- TODO: Make this more readable once we have text-2.0. unsafeSliceUtf8 :: CodeUnitIndex -> CodeUnitIndex -> Text -> Text-unsafeSliceUtf8 (CodeUnitIndex !begin) (CodeUnitIndex !length) (Text !u8data !off !_len) =-  Text u8data (off + begin) length+unsafeSliceUtf8 (CodeUnitIndex !begin) (CodeUnitIndex !len) !text =+  TextUnsafe.takeWord8 len $ TextUnsafe.dropWord8 begin text --- $generalFunctions------ These functions are available in @text@ as well and should be removed once this library moves to @text-2@.--- You should be able to use these by doing @import qualified Data.Text.Utf8 as Text@ just like you would with @text@.+-- $functionsOnArrays ----- NOTE: The 'Text' instances for @Show@, @Eq@, @Ord@, @IsString@, @FromJSON@, @ToJSON@ and @Hashable@ in this file also fall in this category.---- | TODO: Inefficient placeholder implementation.-concat :: [Text] -> Text-concat = pack . concatMap unpack---- | See 'Data.Text.dropWhile'.-dropWhile :: (Char -> Bool) -> Text -> Text-dropWhile predicate text =-  let-    len = codeUnitIndex (lengthUtf8 text)-    go i-      | i >= CodeUnitIndex len = i-      | otherwise =-        let-          (codeUnits, codePoint) = unsafeIndexCodePoint text i-        in-          if predicate codePoint then-            go $ i + codeUnits-          else-            i--    prefixEnd = go 0-  in-    unsafeSliceUtf8 prefixEnd (CodeUnitIndex len - prefixEnd) text---- | Checks whether a text is the empty string.-null :: Text -> Bool-null (Text _ _ len) = len == 0+-- Functions for working with 'TextArray.Array' values. --- | TODO: Inefficient placeholder implementation.-pack :: String -> Text-pack = go . stringToByteArray-  where-    go !arr = Text arr 0 $ sizeofByteArray arr+-- | See 'Data.Primitive.isByteArrayPinned'.+isArrayPinned :: TextArray.Array -> Bool+isArrayPinned (TextArray.ByteArray ba#) = Exts.isTrue# (Exts.isByteArrayPinned# ba#) --- | TODO: Inefficient placeholder implementation.--- See 'Data.Text.replicate'-replicate :: Int -> Text -> Text-replicate n = pack . Prelude.concat . Prelude.replicate n . unpack+-- | See 'Data.Primitive.byteArrayContents'.+arrayContents :: TextArray.Array -> Exts.Ptr Word8+arrayContents (TextArray.ByteArray ba#) = Exts.Ptr (Exts.byteArrayContents# ba#) --- | TODO: Inefficient placeholder implementation.--- This function implements very basic string search. It's @text@ counterpart is 'Data.Text.Internal.Search.indices', which implements the Boyer-Moore algorithm.--- Since we have this function only to check whether our own Boyer-Moore implementation works, it would not make much sense to implement it using the same algorithm.--- Once we can use @text-2@, we can compare our implementation to the official @text@ one which presumably works.-indices :: Text -> Text -> [Int]-indices needle haystack-  | needleLen == 0 = []-  | otherwise = go 0 0+-- | Decode a code point at the given 'CodeUnitIndex'.+-- Returns garbage if there is no valid code point at that position.+-- Does not perform bounds checking.+-- See 'decode2', 'decode3' and 'decode4' for the expected format of multi-byte code points.+{-# INLINE unsafeIndexCodePoint' #-}+unsafeIndexCodePoint' :: TextArray.Array -> CodeUnitIndex -> (CodeUnitIndex, CodePoint)+unsafeIndexCodePoint' !u8data (CodeUnitIndex !idx)+  | cu0 < 0xc0 = (1, Char.chr $ fromIntegral cu0)+  | cu0 < 0xe0 = (2, decode2 cu0 (cuAt 1))+  | cu0 < 0xf0 = (3, decode3 cu0 (cuAt 1) (cuAt 2))+  | otherwise = (4, decode4 cu0 (cuAt 1) (cuAt 2) (cuAt 3))   where-    needleLen = lengthUtf8 needle-    haystackLen = lengthUtf8 haystack--    go startIdx needleIdx-      -- needle is longer than remaining haystack-      | startIdx + needleLen > haystackLen = []-      -- whole needle matched-      | needleIdx >= needleLen = codeUnitIndex startIdx : go (startIdx + needleLen) 0-      -- charachter mismatch-      | needleCp /= haystackCp = go (startIdx + 1) 0-      -- advance-      | otherwise = go startIdx $ needleIdx + codeUnits-      where-        (codeUnits, needleCp) = unsafeIndexCodePoint needle needleIdx-        (_, haystackCp) = unsafeIndexCodePoint haystack $ startIdx + needleIdx---- | TODO: Inefficient placeholder implementation.-isInfixOf :: Text -> Text -> Bool-isInfixOf needle haystack = T.isInfixOf (toUtf16Text needle) (toUtf16Text haystack)+    cuAt !i = unsafeIndexCodeUnit' u8data $ CodeUnitIndex $ idx + i+    !cu0 = cuAt 0 --- | See 'Data.Text.IO.readFile'.--- TODO: Uses 'Data.ByteString.readFile' and loops through each byte individually.--- Use 'Data.Primitive.Ptr.copyPtrToMutableByteArray' here if possible.-readFile :: FilePath -> IO Text-readFile path = do-  contents <- BS.readFile path-  array <- newByteArray $ BS.length contents-  for_ [0..BS.length contents - 1] $ \i -> do-    writeByteArray array i $ BS.index contents i-  array' <- unsafeFreezeByteArray array-  pure $ Text array' 0 $ BS.length contents+{-# INLINE unsafeIndexCodeUnit' #-}+unsafeIndexCodeUnit' :: TextArray.Array -> CodeUnitIndex -> CodeUnit+unsafeIndexCodeUnit' !u8data (CodeUnitIndex !idx) = TextArray.unsafeIndex u8data idx --- | TODO: Inefficient placeholder implementation.-unpack :: Text -> String-unpack = decodeUtf8 . unpackUtf8+-- $generalFunctions+--+-- Re-exported from 'Text'.

@@ -1,545 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2022 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | An efficient implementation of the Aho-Corasick string matching algorithm.--- See http://web.stanford.edu/class/archive/cs/cs166/cs166.1166/lectures/02/Small02.pdf--- for a good explanation of the algorithm.------ The memory layout of the automaton, and the function that steps it, were--- optimized to the point where string matching compiles roughly to a loop over--- the code units in the input text, that keeps track of the current state.--- Lookup of the next state is either just an array index (for the root state),--- or a linear scan through a small array (for non-root states). The pointer--- chases that are common for traversing Haskell data structures have been--- eliminated.------ The construction of the automaton has not been optimized that much, because--- construction time is usually negligible in comparison to matching time.--- Therefore construction is a two-step process, where first we build the--- automaton as int maps, which are convenient for incremental construction.--- Afterwards we pack the automaton into unboxed vectors.------ This module is a rewrite of the previous version which used an older version of--- the 'text' package which in turn used UTF-16 internally.-module Data.Text.Utf8.AhoCorasick.Automaton-    ( AcMachine (..)-    , CaseSensitivity (..)-    , CodeUnitIndex (..)-    , Match (..)-    , Next (..)-    , build-    , debugBuildDot-    , runLower-    , runText-    , runWithCase-    ) where--import Control.DeepSeq (NFData)-import Data.Bits (Bits (shiftL, shiftR, (.&.), (.|.)))-import Data.Char (chr)-import Data.Foldable (foldl')-import Data.IntMap.Strict (IntMap)-import Data.Word (Word32, Word64)-import GHC.Generics (Generic)--import qualified Data.Char as Char-import qualified Data.IntMap.Strict as IntMap-import qualified Data.List as List-import qualified Data.Vector as Vector--import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf8 (CodePoint, CodeUnitIndex (CodeUnitIndex), Text (..))-import Data.TypedByteArray (Prim, TypedByteArray)--import qualified Data.Text.Utf8 as Utf8-import qualified Data.TypedByteArray as TBA---- TYPES--- | A numbered state in the Aho-Corasick automaton.-type State = Int---- | A transition is a pair of (code point, next state). The code point is 21 bits,--- and the state index is 32 bits. The code point is stored in--- the least significant 32 bits, with the special value 2^21 indicating a--- wildcard; the "failure" transition. Bits 22 through 31 (starting from zero,--- both bounds inclusive) are always 0.--------- >  Bit 63 (most significant)                 Bit 0 (least significant)--- >  |                                                                 |--- >  v                                                                 v--- > |<--       goto state         -->|<-- 0s -->| |<--     input     -->|--- > |SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS|0000000000|W|IIIIIIIIIIIIIIIIIIIII|--- >                                              |--- >                                        Wildcard bit (bit 21)------ If you change this representation, make sure to update 'transitionCodeUnit',--- 'wildcard', 'transitionState', 'transitionIsWildcard', 'newTransition' and--- 'newWildcardTransition' as well. Those functions form the interface used to--- construct and read transitions.-type Transition = Word64--type Offset = Word32--data Match v = Match-  { matchPos   :: {-# UNPACK #-} !CodeUnitIndex-  -- ^ The code unit index past the last code unit of the match. Note that this-  -- is not a code *point* (Haskell `Char`) index; a code point might be encoded-  -- as up to four code units.-  , matchValue :: v-  -- ^ The payload associated with the matched needle.-  }---- | An Aho-Corasick automaton.-data AcMachine v = AcMachine-  { machineValues               :: !(Vector.Vector [v])-  -- ^ For every state, the values associated with its needles. If the state is-  -- not a match state, the list is empty.-  , machineTransitions          :: !(TypedByteArray Transition)-  -- ^ A packed vector of transitions. For every state, there is a slice of this-  -- vector that starts at the offset given by `machineOffsets`, and ends at the-  -- first wildcard transition.-  , machineOffsets              :: !(TypedByteArray Offset)-  -- ^ For every state, the index into `machineTransitions` where the transition-  -- list for that state starts.-  , machineRootAsciiTransitions :: !(TypedByteArray Transition)-  -- ^ A lookup table for transitions from the root state, an optimization to-  -- avoid having to walk all transitions, at the cost of using a bit of-  -- additional memory.-  } deriving (Generic)--instance NFData v => NFData (AcMachine v)---- AUTOMATON CONSTRUCTION---- | The wildcard value is 2^21, one more than the maximal 21-bit code point.-wildcard :: Integral a => a-wildcard = 0x200000---- | Extract the code unit from a transition. The special wildcard transition--- will return 0.-transitionCodeUnit :: Transition -> CodePoint-transitionCodeUnit t = Char.chr $ fromIntegral (t .&. 0x1fffff)---- | Extract the goto state from a transition.-transitionState :: Transition -> State-transitionState t = fromIntegral (t `shiftR` 32)---- | Test if the transition is not for a specific code unit, but the wildcard--- transition to take if nothing else matches.-transitionIsWildcard :: Transition -> Bool-transitionIsWildcard t = (t .&. wildcard) == wildcard--newTransition :: CodePoint -> State -> Transition-newTransition input state =-  let-    input64 = fromIntegral $ Char.ord input :: Word64-    state64 = fromIntegral state :: Word64-  in-    (state64 `shiftL` 32) .|. input64--newWildcardTransition :: State -> Transition-newWildcardTransition state =-  let-    state64 = fromIntegral state :: Word64-  in-    (state64 `shiftL` 32) .|. wildcard---- | Pack transitions for each state into one contiguous array. In order to find--- the transitions for a specific state, we also produce a vector of start--- indices. All transition lists are terminated by a wildcard transition, so--- there is no need to record the length.-packTransitions :: [[Transition]] -> (TypedByteArray Transition, TypedByteArray Offset)-packTransitions transitions =-  let-    packed = TBA.fromList $ concat transitions-    offsets = TBA.fromList $ map fromIntegral $ scanl (+) 0 $ fmap List.length transitions-  in-    (packed, offsets)---- | Construct an Aho-Corasick automaton for the given needles.--- The automaton uses Unicode code points to match the input.-build :: [(Text, v)] -> AcMachine v-build needlesWithValues =-  let-    -- Construct the Aho-Corasick automaton using IntMaps, which are a suitable-    -- representation when building the automaton. We use int maps rather than-    -- hash maps to ensure that the iteration order is the same as that of a-    -- vector.-    (numStates, transitionMap, initialValueMap) = buildTransitionMap needlesWithValues-    fallbackMap = buildFallbackMap transitionMap-    valueMap = buildValueMap transitionMap fallbackMap initialValueMap--    -- Convert the map of transitions, and the map of fallback states, into a-    -- list of transition lists, where every transition list is terminated by-    -- a wildcard transition to the fallback state.-    prependTransition ts input state = newTransition (Char.chr input) state : ts-    makeTransitions fallback ts = IntMap.foldlWithKey' prependTransition [newWildcardTransition fallback] ts-    transitionsList = zipWith makeTransitions (IntMap.elems fallbackMap) (IntMap.elems transitionMap)--    -- Pack the transition lists into one contiguous array, and build the lookup-    -- table for the transitions from the root state.-    (transitions, offsets) = packTransitions transitionsList-    rootTransitions = buildAsciiTransitionLookupTable $ transitionMap IntMap.! 0-    values = Vector.generate numStates (valueMap IntMap.!)-  in-    AcMachine values transitions offsets rootTransitions---- | Build the automaton, and format it as Graphviz Dot, for visual debugging.-debugBuildDot :: [Text] -> String-debugBuildDot needles =-  let-    (_numStates, transitionMap, initialValueMap) =-      buildTransitionMap $ zip needles ([0..] :: [Int])-    fallbackMap = buildFallbackMap transitionMap-    valueMap = buildValueMap transitionMap fallbackMap initialValueMap--    dotEdge extra state nextState =-      "  " ++ show state ++ " -> " ++ show nextState ++ " [" ++ extra ++ "];"--    dotFallbackEdge :: [String] -> State -> State -> [String]-    dotFallbackEdge edges state nextState =-      dotEdge "style = dashed" state nextState : edges--    dotTransitionEdge :: State -> [String] -> Int -> State -> [String]-    dotTransitionEdge state edges input nextState =-      dotEdge ("label = \"" ++ showInput input ++ "\"") state nextState : edges--    showInput input = [chr input]--    prependTransitionEdges edges state =-      IntMap.foldlWithKey' (dotTransitionEdge state) edges (transitionMap IntMap.! state)--    dotMatchState :: [String] -> State -> [Int] -> [String]-    dotMatchState edges _ [] = edges-    dotMatchState edges state _ = ("  " ++ show state ++ " [shape = doublecircle];") : edges--    dot0 = foldBreadthFirst prependTransitionEdges [] transitionMap-    dot1 = IntMap.foldlWithKey' dotFallbackEdge dot0 fallbackMap-    dot2 = IntMap.foldlWithKey' dotMatchState dot1 valueMap-  in-    -- Set rankdir = "LR" to prefer a left-to-right graph, rather than top to-    -- bottom. I have dual widescreen monitors and I don't use them in portrait-    -- mode. Reverse the instructions because order affects node lay-out, and by-    -- prepending we built up a reversed list.-    unlines $ ["digraph {", "  rankdir = \"LR\";"] ++ reverse dot2 ++ ["}"]---- Different int maps that are used during constuction of the automaton. The--- transition map represents the trie of states, the fallback map contains the--- fallback (or "failure" or "suffix") edge for every state.-type TransitionMap = IntMap (IntMap State)-type FallbackMap = IntMap State-type ValuesMap v = IntMap [v]---- | Build the trie of the Aho-Corasick state machine for all input needles.-buildTransitionMap :: forall v. [(Text, v)] -> (Int, TransitionMap, ValuesMap v)-buildTransitionMap =-  let-    -- | Inserts a single needle into the given transition and values map.-    insertNeedle :: (Int, TransitionMap, ValuesMap v) -> (Text, v) -> (Int, TransitionMap, ValuesMap v)-    insertNeedle !acc (!needle, !value) = go stateInitial 0 acc-      where-        !needleLen = Utf8.lengthUtf8 needle--        go !state !index (!numStates, !transitions, !values)-          -- End of the current needle, insert the associated payload value.-          -- If a needle occurs multiple times, then at this point we will merge-          -- their payload values, so the needle is reported twice, possibly with-          -- different payload values.-          | index >= needleLen = (numStates, transitions, IntMap.insertWith (++) state [value] values)-        go !state !index (!numStates, !transitions, !values) =-          let-            !transitionsFromState = transitions IntMap.! state-            (!codeUnits, !input) = Utf8.unsafeIndexCodePoint needle index-          in-            case IntMap.lookup (Char.ord input) transitionsFromState of-              -- Transition already exists, follow it and continue from there.-              Just !nextState ->-                go nextState (index + codeUnits) (numStates, transitions, values)-              -- Transition for input does not exist at state:-              -- Allocate a new state, and insert a transition to it.-              -- Also insert an empty transition map for it.-              Nothing ->-                let-                  !nextState = numStates-                  !transitionsFromState' = IntMap.insert (Char.ord input) nextState transitionsFromState-                  !transitions'-                    = IntMap.insert state transitionsFromState'-                    $ IntMap.insert nextState IntMap.empty transitions-                in-                  go nextState (index + codeUnits) (numStates + 1, transitions', values)--    -- Initially, the root state (state 0) exists, and it has no transitions-    -- to anywhere.-    stateInitial = 0-    initialTransitions = IntMap.singleton stateInitial IntMap.empty-    initialValues = IntMap.empty-  in-    foldl' insertNeedle (1, initialTransitions, initialValues)---- Size of the ascii transition lookup table.-asciiCount :: Integral a => a-asciiCount = 128---- | Build a lookup table for the first 128 code points, that can be used for--- O(1) lookup of a transition, rather than doing a linear scan over all--- transitions. The fallback goes back to the initial state, state 0.-{-# NOINLINE buildAsciiTransitionLookupTable  #-}-buildAsciiTransitionLookupTable :: IntMap State -> TypedByteArray Transition-buildAsciiTransitionLookupTable transitions = TBA.generate asciiCount $ \i ->-  case IntMap.lookup i transitions of-    Just state -> newTransition (Char.chr i) state-    Nothing    -> newWildcardTransition 0---- | Traverse the state trie in breadth-first order.-foldBreadthFirst :: (a -> State -> a) -> a -> TransitionMap -> a-foldBreadthFirst f seed transitions = go [0] [] seed-  where-    -- For the traversal, we keep a queue of states to vitit. Every iteration we-    -- take one off the front, and all states reachable from there get added to-    -- the back. Rather than using a list for this, we use the functional-    -- amortized queue to avoid O(n²) append. This makes a measurable difference-    -- when the backlog can grow large. In one of our benchmark inputs for-    -- example, we have roughly 160 needles that are 10 characters each (but-    -- with some shared prefixes), and the backlog size grows to 148 during-    -- construction. Construction time goes down from ~0.80 ms to ~0.35 ms by-    -- using the amortized queue.-    -- See also section 3.1.1 of Purely Functional Data Structures by Okasaki-    -- https://www.cs.cmu.edu/~rwh/theses/okasaki.pdf.-    go [] [] !acc = acc-    go [] revBacklog !acc = go (reverse revBacklog) [] acc-    go (state : backlog) revBacklog !acc =-      let-        -- Note that the backlog never contains duplicates, because we traverse-        -- a trie that only branches out. For every state, there is only one-        -- path from the root that leads to it.-        extra = IntMap.elems $ transitions IntMap.! state-      in-        go backlog (extra ++ revBacklog) (f acc state)---- | Determine the fallback transition for every state, by traversing the--- transition trie breadth-first.-buildFallbackMap :: TransitionMap -> FallbackMap-buildFallbackMap transitions =-  let-    -- Suppose that in state `state`, there is a transition for input `input`-    -- to state `nextState`, and we already know the fallback for `state`. Then-    -- this function returns the fallback state for `nextState`.-    getFallback :: FallbackMap -> State -> Int -> State-    -- All the states after the root state (state 0) fall back to the root state.-    getFallback _ 0 _ = 0-    getFallback fallbacks !state !input =-      let-        fallback = fallbacks IntMap.! state-        transitionsFromFallback = transitions IntMap.! fallback-      in-        case IntMap.lookup input transitionsFromFallback of-          Just st -> st-          Nothing -> getFallback fallbacks fallback input--    insertFallback :: State -> FallbackMap -> Int -> State -> FallbackMap-    insertFallback !state fallbacks !input !nextState =-      IntMap.insert nextState (getFallback fallbacks state input) fallbacks--    insertFallbacks :: FallbackMap -> State -> FallbackMap-    insertFallbacks fallbacks !state =-      IntMap.foldlWithKey' (insertFallback state) fallbacks (transitions IntMap.! state)-  in-    foldBreadthFirst insertFallbacks (IntMap.singleton 0 0) transitions---- | Determine which matches to report at every state, by traversing the--- transition trie breadth-first, and appending all the matches from a fallback--- state to the matches for the current state.-buildValueMap :: forall v. TransitionMap -> FallbackMap -> ValuesMap v -> ValuesMap v-buildValueMap transitions fallbacks valuesInitial =-  let-    insertValues :: ValuesMap v -> State -> ValuesMap v-    insertValues values !state =-      let-        fallbackValues = values IntMap.! (fallbacks IntMap.! state)-        valuesForState = case IntMap.lookup state valuesInitial of-          Just vs -> vs ++ fallbackValues-          Nothing -> fallbackValues-      in-        IntMap.insert state valuesForState values-  in-    foldBreadthFirst insertValues (IntMap.singleton 0 []) transitions---- Define aliases for array indexing so we can turn bounds checks on and off--- in one place. We ran this code with `Vector.!` (bounds-checked indexing) in--- production for two months without failing the bounds check, so we have turned--- the check off for performance now.-{-# INLINE at #-}-at :: forall a. Vector.Vector a -> Int -> a-at = Vector.unsafeIndex--{-# INLINE uAt #-}-uAt :: Prim a => TypedByteArray a -> Int -> a-uAt = TBA.unsafeIndex---- RUNNING THE MACHINE---- | Result of handling a match: stepping the automaton can exit early by--- returning a `Done`, or it can continue with a new accumulator with `Step`.-data Next a = Done !a | Step !a---- | Run the automaton, possibly lowercasing the input text on the fly if case--- insensitivity is desired. See also `runLower`.------ The code of this function itself is organized as a state machine as well.--- Each state in the diagram below corresponds to a function defined in--- `runWithCase`. These functions are written in a way such that GHC identifies them--- as [join points](https://www.microsoft.com/en-us/research/publication/compiling-without-continuations/).--- This means that they can be compiled to jumps instead of function calls, which helps performance a lot.------ @---   ┌─────────────────────────────┐---   │                             │--- ┌─▼──────────┐   ┌──────────────┴─┐   ┌──────────────┐--- │consumeInput├───►lookupTransition├───►collectMatches│--- └─▲──────────┘   └─▲────────────┬─┘   └────────────┬─┘---   │                │            │                  │---   │                └────────────┘                  │---   │                                                │---   └────────────────────────────────────────────────┘--- @------ * @consumeInput@ decodes a code point of up to four code units and possibly lowercases it.---   It passes this code point to @followCodePoint@, which in turn calls @lookupTransition@.--- * @lookupTransition@ checks whether the given code point matches any transitions at the given state.---   If so, it follows the transition and calls @collectMatches@. Otherwise, it follows the fallback transition---   and calls @followCodePoint@ or @consumeInput@.--- * @collectMatches@ checks whether the current state is accepting and updates the accumulator accordingly.---   Afterwards it loops back to @consumeInput@.------ NOTE: @followCodePoint@ is actually inlined into @consumeInput@ by GHC.--- It is included in the diagram for illustrative reasons only.------ All of these functions have the arguments @offset@, @remaining@, @state@ and @acc@ which encode the current input--- position and the accumulator, which contains the matches. If you change any of the functions above,--- make sure to check the Core dumps afterwards that @offset@, @remaining@ and @state@ were turned--- into unboxed @Int#@ by GHC. If any of them aren't, the program will constantly allocate and deallocate heap space for them.--- You can nudge GHC in the right direction by using bang patterns on these arguments.------ WARNING: Run benchmarks when modifying this function; its performance is--- fragile. It took many days to discover the current formulation which compiles--- to fast code; removing the wrong bang pattern could cause a 10% performance--- regression.-{-# INLINE runWithCase #-}-runWithCase :: forall a v. CaseSensitivity -> a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a-runWithCase !caseSensitivity !seed !f !machine !text =-  consumeInput initialOffset initialRemaining seed initialState-  where-    initialState = 0--    Text !u8data !off !len = text-    AcMachine !values !transitions !offsets !rootAsciiTransitions = machine--    !initialOffset = CodeUnitIndex off-    !initialRemaining = CodeUnitIndex len--    -- NOTE: All of the arguments are strict here, because we want to compile-    -- them down to unpacked variables on the stack, or even registers.--    -- When we follow an edge, we look in the transition table and do a-    -- linear scan over all transitions until we find the right one, or-    -- until we hit the wildcard transition at the end. For 0 or 1 or 2-    -- transitions that is fine, but the initial state often has more-    -- transitions, so we have a dedicated lookup table for it, that takes-    -- up a bit more space, but provides O(1) lookup of the next state. We-    -- only do this for the first 128 code units (all of ascii).--    -- | Consume a code unit sequence that constitutes a full code point.-    -- If the code unit at @offset@ is ASCII, we can lower it using 'Utf8.toLowerAscii'.-    {-# NOINLINE consumeInput #-}-    consumeInput :: CodeUnitIndex -> CodeUnitIndex -> a -> State -> a-    consumeInput !_offset 0 !acc !_state = acc-    consumeInput !offset !remaining !acc !state =-      followCodePoint (offset + codeUnits) (remaining - codeUnits) acc possiblyLoweredCp state--      where-        (!codeUnits, !cp) = Utf8.unsafeIndexCodePoint' u8data offset--        !possiblyLoweredCp = case caseSensitivity of-          CaseSensitive -> cp-          IgnoreCase -> Utf8.lowerCodePoint cp--    {-# INLINE followCodePoint #-}-    followCodePoint :: CodeUnitIndex -> CodeUnitIndex -> a -> CodePoint -> State -> a-    followCodePoint !offset !remaining !acc !cp !state-      | state == initialState && Char.ord cp < asciiCount = lookupRootAsciiTransition offset remaining acc cp-      | otherwise = lookupTransition offset remaining acc cp state $ offsets `uAt` state--    -- NOTE: This function can't be inlined since it is self-recursive.-    {-# NOINLINE lookupTransition #-}-    lookupTransition :: CodeUnitIndex -> CodeUnitIndex -> a -> CodePoint -> State -> Offset -> a-    lookupTransition !offset !remaining !acc !cp !state !i-      -- There is no transition for the given input. Follow the fallback edge,-      -- and try again from that state, etc. If we are in the base state-      -- already, then nothing matched, so move on to the next input.-      | transitionIsWildcard t =-        if state == initialState-          then consumeInput offset remaining acc state-          else followCodePoint offset remaining acc cp (transitionState t)-      -- We found the transition, switch to that new state, possibly matching the rest of cus.-      -- NOTE: This comes after wildcard checking, because the code unit of-      -- the wildcard transition is 0, which is a valid input.-      | transitionCodeUnit t == cp =-        collectMatches offset remaining acc (transitionState t)-      -- The transition we inspected is not for the current input, and it is not-      -- a wildcard either; look at the next transition then.-      | otherwise =-        lookupTransition offset remaining acc cp state $ i + 1--      where-        !t = transitions `uAt` fromIntegral i--    -- NOTE: there is no `state` argument here, because this case applies only-    -- to the root state `stateInitial`.-    {-# INLINE lookupRootAsciiTransition #-}-    lookupRootAsciiTransition !offset !remaining !acc !cp-      -- Given code unit does not match at root ==> Repeat at offset from initial state-      | transitionIsWildcard t = consumeInput offset remaining acc initialState-      -- Transition matched!-      | otherwise = collectMatches offset remaining acc $ transitionState t-      where !t = rootAsciiTransitions `uAt` Char.ord cp--    {-# NOINLINE collectMatches #-}-    collectMatches !offset !remaining !acc !state =-      let-        matchedValues = values `at` state-        -- Fold over the matched values. If at any point the user-supplied fold-        -- function returns `Done`, then we early out. Otherwise continue.-        handleMatch !acc' vs = case vs of-          []     -> consumeInput offset remaining acc' state-          v:more -> case f acc' (Match (offset - initialOffset) v) of-            Step newAcc -> handleMatch newAcc more-            Done finalAcc -> finalAcc-      in-        handleMatch acc matchedValues---- NOTE: To get full advantage of inlining this function, you probably want to--- compile the compiling module with -fllvm and the same optimization flags as--- this module.-{-# INLINE runText #-}-runText :: forall a v. a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a-runText = runWithCase CaseSensitive---- Finds all matches in the lowercased text. This function lowercases the input text--- on the fly to avoid allocating a second lowercased text array.  It is still the--- responsibility of  the caller to lowercase the needles. Needles that contain--- uppercase code  points will not match.------ NOTE: To get full advantage of inlining this function, you probably want to--- compile the compiling module with -fllvm and the same optimization flags as--- this module.-{-# INLINE runLower #-}-runLower :: forall a v. a -> (a -> Match v -> Next a) -> AcMachine v -> Text -> a-runLower = runWithCase IgnoreCase

@@ -1,219 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}---- | Implements sequential string replacements based on the Aho-Corasick algorithm.-module Data.Text.Utf8.AhoCorasick.Replacer-    ( -- * State machine-      Needle-    , Payload (..)-    , Replacement-    , Replacer (..)-    , build-    , compose-    , run-    , runWithLimit-    ) where--import Control.DeepSeq (NFData)-import Data.Hashable (Hashable)-import Data.List (sort)-import Data.Maybe (fromJust)-import GHC.Generics (Generic)--#if defined(HAS_AESON)-import qualified Data.Aeson as AE-#endif--import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf8 (CodeUnitIndex, Text)-import Data.Text.Utf8.AhoCorasick.Searcher (Searcher)--import qualified Data.Text.Utf8 as Utf8-import qualified Data.Text.Utf8.AhoCorasick.Automaton as Aho-import qualified Data.Text.Utf8.AhoCorasick.Searcher as Searcher---- | Descriptive type alias for strings to search for.-type Needle = Text---- | Descriptive type alias for replacements.-type Replacement = Text---- | Priority of a needle. Higher integers indicate higher priorities.--- Replacement order is such that all matches of priority p are replaced before--- replacing any matches of priority q where p > q.-type Priority = Int--data Payload = Payload-  { needlePriority    :: {-# UNPACK #-} !Priority-  , needleLength      :: {-# UNPACK #-} !CodeUnitIndex-  , needleReplacement :: !Replacement-  }-#if defined(HAS_AESON)-  deriving (Eq, Generic, Hashable, NFData, Show, AE.FromJSON, AE.ToJSON)-#else-  deriving (Eq, Generic, Hashable, NFData, Show)-#endif---- | A state machine used for efficient replacements with many different needles.-data Replacer = Replacer-  { replacerCaseSensitivity :: CaseSensitivity-  , replacerSearcher :: Searcher Payload-  }-  deriving stock (Show, Eq, Generic)-#if defined(HAS_AESON)-  deriving (Hashable, NFData, AE.FromJSON, AE.ToJSON)-#else-  deriving (Hashable, NFData)-#endif---- | Build an Aho-Corasick automaton that can be used for performing fast--- sequential replaces.------ Case-insensitive matching performs per-letter language-agnostic lower-casing.--- Therefore, it will work in most cases, but not in languages where lower-casing--- depends on the context of the character in question.------ We need to revisit this algorithm when we want to implement full Unicode--- support.-build :: CaseSensitivity -> [(Needle, Replacement)] -> Replacer-build caseSensitivity replaces = Replacer caseSensitivity searcher-  where-    searcher = Searcher.buildWithValues caseSensitivity $ zipWith mapNeedle [0..] replaces-    mapNeedle i (needle, replacement) =-      let-        needle' = case caseSensitivity of-          CaseSensitive -> needle-          IgnoreCase -> Utf8.lowerUtf8 needle-      in-        -- Note that we negate i: earlier needles have a higher priority. We-        -- could avoid it and define larger integers to be lower priority, but-        -- that made the terminology in this module very confusing.-        (needle', Payload (-i) (Utf8.lengthUtf8 needle') replacement)---- | Return the composition `replacer2` after `replacer1`, if they have the same--- case sensitivity. If the case sensitivity differs, Nothing is returned.-compose :: Replacer -> Replacer -> Maybe Replacer-compose (Replacer case1 searcher1) (Replacer case2 searcher2)-  | case1 /= case2 = Nothing-  | otherwise =-      let-        -- Replace the priorities of the second machine, so they all come after-        -- the first.-        renumber i (needle, Payload _ len replacement) = (needle, Payload (-i) len replacement)-        needles1 = Searcher.needles searcher1-        needles2 = Searcher.needles searcher2-        searcher = Searcher.buildWithValues case1 $ zipWith renumber [0..] (needles1 ++ needles2)-      in-        Just $ Replacer case1 searcher---- A match collected while running replacements. It is isomorphic to the Match--- reported by the automaton, but the data is arranged in a more useful way:--- as the start index and length of the match, and the replacement.-data Match = Match !CodeUnitIndex !CodeUnitIndex !Text deriving (Eq, Ord, Show)---- | Apply replacements of all matches. Assumes that the matches are ordered by--- match position, and that no matches overlap.-replace :: [Match] -> Text -> Text-replace matches haystack = Utf8.concat $ go 0 matches haystack-  where-    -- At every match, cut the string into three pieces, removing the match.-    -- Because a Text is a buffer pointer and (offset, length), cutting does not-    -- involve string copies. Only at the very end we piece together the strings-    -- again, so Text can allocate a buffer of the right length and memcpy the-    -- parts into the new target string.-    -- If `k` is a code unit index into the original text, then `k - offset`-    -- is an index into `remainder`. In other words, `offset` is the index into-    -- the original text where `remainder` starts.-    go :: CodeUnitIndex -> [Match] -> Text -> [Text]-    go !_offset [] remainder = [remainder]-    go !offset ((Match pos len replacement) : ms) remainder =-      let-        (prefix, suffix) = Utf8.unsafeCutUtf8 (pos - offset) len remainder-      in-        prefix : replacement : go (pos + len) ms suffix---- | Compute the length of the string resulting from applying the replacements.-replacementLength :: [Match] -> Text -> CodeUnitIndex-replacementLength matches initial  = go matches (Utf8.lengthUtf8 initial)-  where-    go [] !acc = acc-    go (Match _ matchLen repl : rest) !acc = go rest (acc - matchLen + Utf8.lengthUtf8 repl)---- | Given a list of matches sorted on start position, remove matches that start--- within an earlier match.-removeOverlap :: [Match] -> [Match]-removeOverlap matches = case matches of-  [] -> []-  [m] -> [m]-  (m0@(Match pos0 len0 _) : m1@(Match pos1 _ _) : ms) ->-    if pos1 >= pos0 + len0-      then m0 : removeOverlap (m1:ms)-      else removeOverlap (m0:ms)---- | When we iterate through all matches, keep track only of the matches with--- the highest priority: those are the ones that we will replace first. If we--- find multiple matches with that priority, remember all of them. If we find a--- match with lower priority, ignore it, because we already have a more--- important match. Also, if the priority is `threshold` or higher, ignore the--- match, so we can exclude matches if we already did a round of replacements--- for that priority. This way we don't have to build a new automaton after--- every round of replacements.-{-# INLINE prependMatch #-}-prependMatch :: Priority -> (Priority, [Match]) -> Aho.Match Payload -> Aho.Next (Priority, [Match])-prependMatch !threshold (!pBest, !matches) (Aho.Match pos (Payload pMatch len replacement))-  | pMatch < threshold && pMatch >  pBest = Aho.Step (pMatch, [Match (pos - len) len replacement])-  | pMatch < threshold && pMatch == pBest = Aho.Step (pMatch, Match (pos - len) len replacement : matches)-  | otherwise = Aho.Step (pBest, matches)--run :: Replacer -> Text -> Text-run replacer = fromJust . runWithLimit replacer maxBound--{-# NOINLINE runWithLimit #-}-runWithLimit :: Replacer -> CodeUnitIndex -> Text -> Maybe Text-runWithLimit (Replacer case_ searcher) maxLength = go initialThreshold-  where-    !automaton = Searcher.automaton searcher--    -- Priorities are 0 or lower, so an initial threshold of 1 keeps all-    -- matches.-    !initialThreshold = 1--    -- Needle priorities go from 0 for the highest priority to (-numNeedles + 1)-    -- for the lowest priority. That means that if we find a match with-    -- minPriority, we don't need to do another pass afterwards, because there-    -- are no remaining needles.-    !minPriority = 1 - Searcher.numNeedles searcher--    go :: Priority -> Text -> Maybe Text-    go !threshold haystack =-      let-        seed = (minBound :: Priority, [])-        matchesWithPriority = case case_ of-          CaseSensitive -> Aho.runText seed (prependMatch threshold) automaton haystack-          IgnoreCase -> Aho.runLower seed (prependMatch threshold) automaton haystack-      in-        case matchesWithPriority of-          -- No match at the given threshold, there is nothing left to do.-          -- Return the input string unmodified.-          (_, []) -> Just haystack-          -- We found matches at priority p. Remove overlapping matches, then-          -- apply all replacements. Next, we need to go again, this time-          -- considering only needles with a lower priority than p. As an-          -- optimization (which matters mainly for the single needle case),-          -- if we find a match at the lowest priority, we don't need another-          -- pass. Note that if in `rawMatches` we find only matches of priority-          -- p > minPriority, then we do still need another pass, because the-          -- replacements could create new matches.-          (p, matches)-            | replacementLength matches haystack > maxLength -> Nothing-            | p == minPriority -> Just $ replace (removeOverlap $ sort matches) haystack-            | otherwise -> go p $ replace (removeOverlap $ sort matches) haystack

@@ -1,178 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2022 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}--module Data.Text.Utf8.AhoCorasick.Searcher-    ( Searcher-    , automaton-    , build-    , buildNeedleIdSearcher-    , buildWithValues-    , caseSensitivity-    , containsAll-    , containsAny-    , needles-    , numNeedles-    , setSearcherCaseSensitivity-    ) where--import Control.DeepSeq (NFData)-import Data.Hashable (Hashable (hashWithSalt), Hashed, hashed, unhashed)-import GHC.Generics (Generic)--#if defined(HAS_AESON)-import Data.Aeson ((.:), (.=))-import qualified Data.Aeson as AE-#endif--import qualified Data.IntSet as IS--import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf8 (Text)--import qualified Data.Text.Utf8.AhoCorasick.Automaton as Aho---- | A set of needles with associated values, and an Aho-Corasick automaton to--- efficiently find those needles.------ INVARIANT: searcherAutomaton = Aho.build . searcherNeedles--- To enforce this invariant, the fields are not exposed from this module.--- There is a separate constructor function.------ The purpose of this wrapper is to have a type that is Hashable and Eq, so we--- can derive those for types that embed the searcher, whithout requiring the--- automaton itself to be Hashable or Eq, which would be both wasteful and--- tedious. Because the automaton is fully determined by the needles and--- associated values, it is sufficient to implement Eq and Hashable in terms of--- the needles only.------ We also use Hashed to cache the hash of the needles.-data Searcher v = Searcher-  { searcherCaseSensitive :: CaseSensitivity-  , searcherNeedles :: Hashed [(Text, v)]-  , searcherNumNeedles :: Int-  , searcherAutomaton :: Aho.AcMachine v-  } deriving (Generic)--#if defined(HAS_AESON)-instance AE.ToJSON v => AE.ToJSON (Searcher v) where-  toJSON s = AE.object-    [ "needles" .= needles s-    , "caseSensitivity" .= caseSensitivity s-    ]--instance (Hashable v, AE.FromJSON v) => AE.FromJSON (Searcher v) where-  parseJSON = AE.withObject "Searcher" $ \o -> buildWithValues <$> o .: "caseSensitivity" <*> o .: "needles"-#endif--instance Show (Searcher v) where-  show _ = "Searcher _ _ _"--instance Hashable v => Hashable (Searcher v) where-  hashWithSalt salt searcher = hashWithSalt salt $ searcherNeedles searcher-  {-# INLINE hashWithSalt #-}--instance Eq v => Eq (Searcher v) where-  -- Since we store the length of the needle list anyway,-  -- we can use it to early out if there is a length mismatch.-  Searcher cx xs nx _ == Searcher cy ys ny _ = (nx, xs, cx) == (ny, ys, cy)-  {-# INLINE (==) #-}--instance NFData v => NFData (Searcher v)---- NOTE: Although we could implement Semigroup for every v by just concatenating--- needle lists, we don't, because this might lead to unexpected results. For--- example, if v is (Int, a) where the Int is a priority, combining two--- searchers might want to discard priorities, concatenate the needle lists, and--- reassign priorities, rather than concatenating the needle lists as-is and--- possibly having duplicate priorities in the resulting searcher.-instance Semigroup (Searcher ()) where-  x <> y-    | caseSensitivity x == caseSensitivity y-      = buildWithValues (searcherCaseSensitive x) (needles x <> needles y)-    | otherwise = error "Combining searchers of different case sensitivity"-  {-# INLINE (<>) #-}---- | Builds the Searcher for a list of needles--- The caller is responsible that the needles are lower case in case the IgnoreCase--- is used for case sensitivity-build :: CaseSensitivity -> [Text] -> Searcher ()-build case_ = buildWithValues case_ . fmap (, ())---- | The caller is responsible that the needles are lower case in case the IgnoreCase--- is used for case sensitivity-buildWithValues :: Hashable v => CaseSensitivity -> [(Text, v)] -> Searcher v-{-# INLINABLE buildWithValues #-}-buildWithValues case_ ns =-  Searcher case_ (hashed ns) (length ns) $ Aho.build ns--needles :: Searcher v -> [(Text, v)]-needles = unhashed . searcherNeedles--numNeedles :: Searcher v -> Int-numNeedles = searcherNumNeedles--automaton :: Searcher v -> Aho.AcMachine v-automaton = searcherAutomaton--caseSensitivity :: Searcher v -> CaseSensitivity-caseSensitivity = searcherCaseSensitive---- | Updates the case sensitivity of the searcher. Does not change the--- capitilization of the needles. The caller should be certain that if IgnoreCase--- is passed, the needles are already lower case.-setSearcherCaseSensitivity :: CaseSensitivity -> Searcher v -> Searcher v-setSearcherCaseSensitivity case_ searcher = searcher{-    searcherCaseSensitive = case_-  }---- | Return whether the haystack contains any of the needles.--- Case sensitivity depends on the properties of the searcher--- This function is marked noinline as an inlining boundary. Aho.runText is--- marked inline, so this function will be optimized to report only whether--- there is a match, and not construct a list of matches. We don't want this--- function be inline, to make sure that the conditions of the caller don't--- affect how this function is optimized. There is little to gain from--- additional inlining. The pragma is not an optimization in itself, rather it--- is a defence against fragile optimizer decisions.-{-# NOINLINE containsAny #-}-containsAny :: Searcher () -> Text -> Bool-containsAny !searcher !text =-  let-    -- On the first match, return True immediately.-    f _acc _match = Aho.Done True-  in case caseSensitivity searcher of-    CaseSensitive  -> Aho.runText False f (automaton searcher) text-    IgnoreCase      -> Aho.runLower False f (automaton searcher) text---- | Build a 'Searcher' that returns the needle's index in the needle list when it matches.-buildNeedleIdSearcher :: CaseSensitivity -> [Text] -> Searcher Int-buildNeedleIdSearcher !case_ !ns =-  buildWithValues case_ $ zip ns [0..]---- | Returns whether the haystack contains all of the needles.--- This function expects the passed 'Searcher' to be constructed using 'buildNeedleIdAutomaton'.-containsAll :: Searcher Int -> Text -> Bool-containsAll !searcher !haystack =-  let-    initial = IS.fromDistinctAscList [0..numNeedles searcher - 1]-    ac = automaton searcher--    f !acc (Aho.Match _index !needleId)-      | IS.null acc' = Aho.Done acc'-      | otherwise = Aho.Step acc'-      where-        !acc' = IS.delete needleId acc--  in IS.null $ case caseSensitivity searcher of-    CaseSensitive -> Aho.runText initial f ac haystack-    IgnoreCase   -> Aho.runLower initial f ac haystack

@@ -1,189 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}---- | Splitting strings using Aho–Corasick.-module Data.Text.Utf8.AhoCorasick.Splitter-    ( Splitter-    , automaton-    , build-    , separator-    , split-    , splitIgnoreCase-    , splitReverse-    , splitReverseIgnoreCase-    ) where--import Control.DeepSeq (NFData (..))-import Data.Function (on)-import Data.Hashable (Hashable (..))-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Text.Utf8 (Text)--#if defined(HAS_AESON)-import qualified Data.Aeson as AE-#endif--import qualified Data.List.NonEmpty as NonEmpty--import Data.Text.Utf8.AhoCorasick.Automaton (AcMachine)--import qualified Data.Text.Utf8 as Utf8-import qualified Data.Text.Utf8.AhoCorasick.Automaton as Aho------------------------------------------------------------------------------------- Splitter---- | Build a splitter once, then use it many times!-data Splitter =-  Splitter-    { splitterAutomaton :: AcMachine () -- INVARIANT: Exactly one needle.-    , splitterSeparator :: Text         -- INVARIANT: Equivalent to needle.-    }--#if defined(HAS_AESON)-instance AE.ToJSON Splitter where-  toJSON = AE.toJSON . separator--instance AE.FromJSON Splitter where-  parseJSON v = build <$> AE.parseJSON v-#endif---- | Construct a splitter with a single separator.-{-# INLINE build #-}-build :: Text -> Splitter-build sep =-  let !auto = Aho.build [(sep, ())] in-  Splitter auto sep---- | Get the automaton that would be used for finding separators.-{-# INLINE automaton #-}-automaton :: Splitter -> AcMachine ()-automaton = splitterAutomaton---- | What is the separator we are splitting on?-{-# INLINE separator #-}-separator :: Splitter -> Text-separator = splitterSeparator---- | Split the given string into strings separated by the separator.------ If the order of the results is not important, use the faster function--- 'splitReverse' instead.-{-# INLINE split #-}-split :: Splitter -> Text -> NonEmpty Text-split = (NonEmpty.reverse .) . splitReverse---- | Split the given string into strings separated by the separator.------ If the order of the results is not important, use the faster function--- 'splitReverseIgnoreCase' instead.------ The separator is matched case-insensitively, but the splitter must have been--- constructed with a lowercase needle.-{-# INLINE splitIgnoreCase #-}-splitIgnoreCase :: Splitter -> Text -> NonEmpty Text-splitIgnoreCase = (NonEmpty.reverse .) . splitReverseIgnoreCase---- | Like 'split', but return the substrings in reverse order.-{-# INLINE splitReverse #-}-splitReverse :: Splitter -> Text -> NonEmpty Text-splitReverse s t =-  finalizeAccum $-    Aho.runText-      (zeroAccum (separator s) t)-      stepAccum-      (automaton s)-      t---- | Like 'splitIgnoreCase', but return the substrings in reverse order.-{-# INLINE splitReverseIgnoreCase #-}-splitReverseIgnoreCase :: Splitter -> Text -> NonEmpty Text-splitReverseIgnoreCase s t =-  finalizeAccum $-    Aho.runLower-      (zeroAccum (separator s) t)-      stepAccum-      (automaton s)-      t------------------------------------------------------------------------------------- Fold---- | The accumulator is used as state when processing the matches from left to--- right. While the matches are fed to us ordered by end offset, all matches--- have the same length because there is only one needle.-data Accum =-  Accum-    { _accumSepLen   :: !Aho.CodeUnitIndex -- ^ Length of separator.-    , _accumHaystack :: !Text              -- ^ Haystack to slice off of.-    , accumResult    :: ![Text]            -- ^ Match-separated strings.-    , accumPrevEnd   :: !Aho.CodeUnitIndex -- ^ Offset at end of last match.-    }---- | Finalizing the accumulator does more than just 'accumResult', hence this--- is a separate function.-{-# INLINE finalizeAccum #-}-finalizeAccum :: Accum -> NonEmpty Text-finalizeAccum (Accum _ hay res prevEnd) =-  -- Once we have processed all the matches, there is still the substring after-  -- the final match. This substring is always included in the result, even-  -- when there were no matches. Hence we can return a non-empty list.-  let !str = Utf8.unsafeSliceUtf8 prevEnd (Utf8.lengthUtf8 hay - prevEnd) hay in-  str :| res---- | The initial accumulator begins at the begin of the haystack.-{-# INLINE zeroAccum #-}-zeroAccum :: Text -> Text -> Accum-zeroAccum sep hay = Accum (Utf8.lengthUtf8 sep) hay [] 0---- | Step the accumulator using the next match. Overlapping matches will be--- ignored. Overlapping matches may occur when the separator has a non-empty--- prefix that is also a suffix.-{-# INLINE stepAccum #-}-stepAccum :: Accum -> Aho.Match v -> Aho.Next Accum-stepAccum acc@(Accum sepLen hay res prevEnd) (Aho.Match sepEnd _)--  -- When the match begins before the current offset, it overlaps a match that-  -- we processed before, and so we ignore it.-  | sepEnd - sepLen < prevEnd =-      Aho.Step acc--  -- The match is behind the current offset, so we slice the haystack until the-  -- begin of the match and include that as a result.-  | otherwise =-      let !str = Utf8.unsafeSliceUtf8 prevEnd (sepEnd - sepLen - prevEnd) hay in-      Aho.Step acc { accumResult = str : res, accumPrevEnd = sepEnd }------------------------------------------------------------------------------------- Instances--instance Eq Splitter where-  {-# INLINE (==) #-}-  (==) = (==) `on` separator--instance Ord Splitter where-  {-# INLINE compare #-}-  compare = compare `on` separator--instance Hashable Splitter where-  {-# INLINE hashWithSalt #-}-  hashWithSalt salt searcher =-    salt `hashWithSalt` separator searcher--instance NFData Splitter where-  {-# INLINE rnf #-}-  rnf (Splitter searcher sepLength) =-    rnf searcher `seq`-    rnf sepLength--instance Show Splitter where-  showsPrec p splitter =-    showParen (p > 10) $-      showString "build " .-        showsPrec 11 (separator splitter)

@@ -1,335 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | An efficient implementation of the Boyer-Moore string search algorithm.--- http://www-igm.univ-mlv.fr/~lecroq/string/node14.html#SECTION00140--- https://en.wikipedia.org/wiki/Boyer%E2%80%93Moore_string-search_algorithm------ This module contains a almost 1:1 translation from the C example code in the--- wikipedia article.------ The algorithm here can be potentially improved by including the Galil rule--- (https://en.wikipedia.org/wiki/Boyer%E2%80%93Moore_string-search_algorithm#The_Galil_rule)-module Data.Text.Utf8.BoyerMoore.Automaton-    ( Automaton-    , CaseSensitivity (..)-    , CodeUnitIndex (..)-    , Next (..)-    , buildAutomaton-    , patternLength-    , patternText-    , runText-    ) where--import Prelude hiding (length)--import Control.DeepSeq (NFData)-import Control.Monad (when)-import Control.Monad.ST (runST)-import Data.Hashable (Hashable (..), Hashed, hashed, unhashed)-import GHC.Generics (Generic)--#if defined(HAS_AESON)-import qualified Data.Aeson as AE-#endif--import Data.Text.AhoCorasick.Automaton (Next (..))-import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Utf8 (CodeUnit, CodeUnitIndex (..), Text)-import Data.TypedByteArray (Prim, TypedByteArray)--import qualified Data.Text.Utf8 as Utf8-import qualified Data.TypedByteArray as TBA---- | A Boyer-Moore automaton is based on lookup-tables that allow skipping through the haystack.--- This allows for sub-linear matching in some cases, as we do not have to look at every input--- character.------ NOTE: Unlike the AcMachine, a Boyer-Moore automaton only returns non-overlapping matches.--- This means that a Boyer-Moore automaton is not a 100% drop-in replacement for Aho-Corasick.------ Returning overlapping matches would degrade the performance to /O(nm)/ in pathological cases like--- finding @aaaa@ in @aaaaa....aaaaaa@ as for each match it would scan back the whole /m/ characters--- of the pattern.-data Automaton = Automaton-  { automatonPattern :: Hashed Text-  , automatonSuffixTable :: SuffixTable-  , automatonBadCharTable :: BadCharTable-  }-  deriving stock (Generic, Show)-  deriving anyclass (NFData)--instance Hashable Automaton where-  hashWithSalt salt (Automaton pattern _ _) = hashWithSalt salt pattern--instance Eq Automaton where-  (Automaton pat1 _ _) == (Automaton pat2 _ _) = pat1 == pat2--#if defined(HAS_AESON)-instance AE.FromJSON Automaton where-  parseJSON v = buildAutomaton <$> AE.parseJSON v--instance AE.ToJSON Automaton where-  toJSON = AE.toJSON . unhashed . automatonPattern-#endif--buildAutomaton :: Text -> Automaton-buildAutomaton pattern = Automaton (hashed pattern) (buildSuffixTable pattern) (buildBadCharTable pattern)---- | Finds all matches in the text, calling the match callback with the *first*--- matched character of each match of the pattern.------ NOTE: This is unlike Aho-Corasick, which reports the index of the character--- right after a match.------ NOTE: In the UTF-16 version of this module, there is a function 'Data.Text.BoyerMoore.Automaton.runLower'--- which does lower-case matching. This function does not exist for the UTF-8 version since it is very--- tricky to skip code points going backwards without preprocessing the whole input first.------ NOTE: To get full advantage of inlining this function, you probably want to--- compile the compiling module with -fllvm and the same optimization flags as--- this module.-runText  :: forall a-  . a-  -> (a -> CodeUnitIndex -> Next a)-  -> Automaton-  -> Text-  -> a-{-# INLINE runText #-}-runText seed f automaton text-  | patLen == 0 = seed-  | otherwise = go seed (patLen - 1)-  where-    Automaton patternHashed suffixTable badCharTable = automaton-    -- Use needle as identifier since pattern is potentially a keyword-    needle = unhashed patternHashed-    patLen = Utf8.lengthUtf8 needle-    stringLen = Utf8.lengthUtf8 text--    codeUnitAt = Utf8.unsafeIndexCodeUnit text--    {-# INLINE go #-}-    go result haystackIndex-      | haystackIndex < stringLen = matchLoop result haystackIndex (patLen - 1)-      | otherwise = result--    -- Compare the needle back-to-front with the haystack-    matchLoop result haystackIndex needleIndex-      | needleIndex >= 0 && codeUnitAt haystackIndex == Utf8.unsafeIndexCodeUnit needle needleIndex =-        -- Characters match, try the pair before-        matchLoop result (haystackIndex - 1) (needleIndex - 1)-      -- We found a match (all needle characters matched)-      | needleIndex < 0 =-        case f result (haystackIndex + 1) of-          Done final -> final-          -- `haystackIndex` now points to the character just before the match starts-          -- Adding `patLen` once points to the last character of the match,-          -- Adding `patLen` once more points to the earliest character where-          -- we can find a non-overlapping match.-          Step intermediate -> go intermediate (haystackIndex + 2 * patLen)-      -- We know it's not a match, the characters differ at the current position-      | otherwise =-        let-          -- The bad character table tells us how far we can advance to the right so that the-          -- character at the current position in the input string, where matching failed,-          -- is lined up with it's rightmost occurrence in the needle.-          -- Note: we could end up left of were we started, essentially never making progress,-          -- if we were to use this rule alone.-          badCharSkip = badCharLookup badCharTable (codeUnitAt haystackIndex)-          suffixSkip = suffixLookup suffixTable needleIndex-          skip = max badCharSkip suffixSkip-        in-          go result (haystackIndex + skip)---- | Length of the matched pattern measured in UTF-8 code units (bytes).-patternLength :: Automaton -> CodeUnitIndex-patternLength = Utf8.lengthUtf8 . patternText---- | Return the pattern that was used to construct the automaton.-patternText :: Automaton -> Text-patternText (Automaton pattern _ _) = unhashed pattern---- | The suffix table tells us for each character of the pattern how many characters we can--- jump ahead if the match fails at that point.-newtype SuffixTable = SuffixTable (TypedByteArray Int)-  deriving stock (Generic, Show)-  deriving anyclass (NFData)---- | Lookup an entry in the suffix table.-suffixLookup :: SuffixTable -> CodeUnitIndex -> CodeUnitIndex-{-# INLINE suffixLookup #-}-suffixLookup (SuffixTable table) = CodeUnitIndex . indexTable table . codeUnitIndex--buildSuffixTable :: Text -> SuffixTable-buildSuffixTable pattern = runST $ do-  let patLen = Utf8.lengthUtf8 pattern--  table <- TBA.newTypedByteArray $ codeUnitIndex patLen--  let-    -- Case 1: For each position of the pattern we record the shift that would align the pattern so-    -- that it starts at the longest suffix that is at the same time a prefix, if a mismatch would-    -- happen at that position.-    ---    -- Suppose the length of the pattern is n, a mismatch occurs at position i in the pattern and j-    -- in the haystack, then we know that pattern[i+1..n] == haystack[j+1..j+n-i]. That is, we know-    -- that the part of the haystack that we already matched is a suffix of the pattern.-    -- If the pattern happens to have a prefix that is equal to or a shorter suffix of that matched-    -- suffix, we can shift the pattern to the right so that the pattern starts at the longest-    -- suffix that we have seen that conincides with a prefix of the pattern.-    ---    -- Consider the pattern `ababa`. Then we get-    ---    -- p:                0  1  2  3  4-    -- Pattern:          a  b  a  b  a-    -- lastPrefixIndex:  2  2  4  4  5-    -- table:            6  5  6  5  5-    init1 lastPrefixIndex p-      | p >= 0 = do-        let-          prefixIndex-            | isPrefix pattern (p + 1) = p + 1-            | otherwise = lastPrefixIndex-        TBA.writeTypedByteArray table (codeUnitIndex p) (codeUnitIndex $ prefixIndex + patLen - 1 - p)-        init1 prefixIndex (p - 1)-      | otherwise = pure ()--    -- Case 2: We also have to account for the fact that the matching suffix of the pattern might-    -- occur again somewhere within the pattern. In that case, we may not shift as far as if it was-    -- a prefix. That is why the `init2` loop is run after `init1`, potentially overwriting some-    -- entries with smaller shifts.-    init2 p-      | p < patLen - 1 = do-        let-          suffixLen = suffixLength pattern p-        when (Utf8.unsafeIndexCodeUnit pattern (p - suffixLen) /= Utf8.unsafeIndexCodeUnit pattern (patLen - 1 - suffixLen)) $-          TBA.writeTypedByteArray table (codeUnitIndex $ patLen - 1 - suffixLen) (codeUnitIndex $ patLen - 1 - p + suffixLen)-        init2 (p + 1)-      | otherwise = pure ()--  init1 (patLen - 1) (patLen - 1)-  init2 0--  SuffixTable <$> TBA.unsafeFreezeTypedByteArray table----- | The bad char table tells us how far we may skip ahead when encountering a certain character--- in the input string. For example, if there's a character that is not contained in the pattern at--- all, we can skip ahead until after that character.-data BadCharTable = BadCharTable-  { badCharTableEntries :: {-# UNPACK #-} !(TypedByteArray Int)-    -- ^ The element type should be CodeUnitIndex, but there's no unboxed vector for that type, and-    -- defining it would be a lot of boilerplate.-  , badCharTablePatternLen :: CodeUnitIndex-  }-  deriving stock (Generic, Show)-  deriving anyclass (NFData)---- | Number of entries in the fixed-size lookup-table of the bad char table.-badcharTableSize :: Int-{-# INLINE badcharTableSize #-}-badcharTableSize = 256---- | Lookup an entry in the bad char table.-badCharLookup :: BadCharTable -> CodeUnit -> CodeUnitIndex-{-# INLINE badCharLookup #-}-badCharLookup (BadCharTable asciiTable _patLen) char = CodeUnitIndex $ indexTable asciiTable intChar-  where-    intChar = fromIntegral char---- | True if the suffix of the @pattern@ starting from @pos@ is a prefix of the pattern--- For example, @isPrefix \"aabbaa\" 4 == True@.-isPrefix :: Text -> CodeUnitIndex -> Bool-isPrefix needle pos = go 0-  where-    suffixLen = Utf8.lengthUtf8 needle - pos-    go i-      | i < suffixLen =-        -- FIXME: Check whether implementing the linter warning kills tco-        if Utf8.unsafeIndexCodeUnit needle i == Utf8.unsafeIndexCodeUnit needle (pos + i)-          then go (i + 1)-          else False-      | otherwise = True---- | Length of the longest suffix of the pattern ending on @pos@.--- For example, @suffixLength \"abaacbbaac\" 4 == 4@, because the substring \"baac\" ends at position--- 4 and is at the same time the longest suffix that does so, having length 4.-suffixLength :: Text -> CodeUnitIndex -> CodeUnitIndex-suffixLength pattern pos = go 0-  where-    patLen = Utf8.lengthUtf8 pattern-    go i-      | Utf8.unsafeIndexCodeUnit pattern (pos - i) == Utf8.unsafeIndexCodeUnit pattern (patLen - 1 - i) && i < pos = go (i + 1)-      | otherwise = i--buildBadCharTable :: Text -> BadCharTable-buildBadCharTable pattern = runST $ do-  let patLen = Utf8.lengthUtf8 pattern--  -- Initialize table with the maximum skip distance, which is the length of the pattern.-  -- This applies to all characters that are not part of the pattern.-  asciiTable <- TBA.replicate badcharTableSize $ codeUnitIndex patLen--  let-    -- Fill the bad character table based on the rightmost occurrence of a character in the pattern.-    -- Note that there is also a variant of Boyer-Moore that records all positions (see Wikipedia,-    -- but that requires even more storage space).-    -- Also note that we exclude the last character of the pattern when building the table.-    -- This is because-    ---    -- 1. If the last character does not occur anywhere else in the pattern and we encounter it-    --    during a mismatch, we can advance the pattern to just after that character:-    ---    --    Haystack: aaadcdabcdbb-    --    Pattern:    abcd-    ---    --    In the above example, we would match `d` and `c`, but then fail because `d` != `b`.-    --    Since `d` only occurs at the very last position of the pattern, we can shift to-    ---    --    Haystack: aaadcdabcdbb-    --    Pattern:      abcd-    ---    -- 2. If it does occur anywhere else in the pattern, we can only shift as far as it's necessary-    --    to align it with the haystack:-    ---    --    Haystack: aaadddabcdbb-    --    Pattern:    adcd-    ---    --    We match `d`, and then there is a mismatch `d` != `c`, which allows us to shift only up to:--    --    Haystack: aaadddabcdbb-    --    Pattern:     adcd-    fillTable !i-      -- for(i = 0; i < patLen - 1; i++) {-      | i < patLen - 1 = do-        let patChar = Utf8.unsafeIndexCodeUnit pattern i-        TBA.writeTypedByteArray asciiTable (fromIntegral patChar) (codeUnitIndex $ patLen - 1 - i)-        fillTable (i + 1)-      | otherwise = pure ()--  fillTable 0--  asciiTableFrozen <- TBA.unsafeFreezeTypedByteArray asciiTable--  pure BadCharTable-    { badCharTableEntries = asciiTableFrozen-    , badCharTablePatternLen = patLen-    }----- Helper functions for easily toggling the safety of this module---- | Read from a lookup table at the specified index.-indexTable :: Prim a => TypedByteArray a -> Int -> a-{-# INLINE indexTable #-}-indexTable = TBA.unsafeIndex

@@ -1,91 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Text.Utf8.BoyerMoore.Replacer-    ( -- Replacer-      replaceSingleLimited-    ) where--import Data.Text.Utf8 (Text)-import Data.Text.Utf8.BoyerMoore.Automaton (Automaton, CodeUnitIndex)--import qualified Data.Text.Utf8 as Text-import qualified Data.Text.Utf8 as Utf8-import qualified Data.Text.Utf8.BoyerMoore.Automaton as BoyerMoore---- | Replace all occurrences matched by the Boyer-Moore automaton--- with the given replacement text in some haystack.--- Performs case-sensitive replacement.-replaceSingleLimited-  :: Automaton -- ^ Matches the needles-  -> Text -- ^ Replacement string-  -> Text -- ^ Haystack-  -> CodeUnitIndex -- ^ Maximum number of code units in the returned text-  -> Maybe Text-replaceSingleLimited needle replacement haystack maxLength-  | needleLength == 0 = Just $ if haystackLength == 0 then replacement else haystack-  | otherwise = finish $ BoyerMoore.runText initial foundMatch needle haystack-  where-    needleLength = BoyerMoore.patternLength needle-    haystackLength = Utf8.lengthUtf8 haystack-    replacementLength = Utf8.lengthUtf8 replacement--    initial = ReplaceState-      { rsChunks = []-      , rsPreviousMatchEnd = 0-      , rsLength = 0-      }--    foundMatch rs matchStart =-      let-        matchEnd = matchStart + needleLength--        -- Slice the part of the haystack between the end of the previous match-        -- and the start of the current match-        haystackPartLength = matchStart - rsPreviousMatchEnd rs-        haystackPart = Utf8.unsafeSliceUtf8 (rsPreviousMatchEnd rs) haystackPartLength haystack--        -- Add the preceding part of the haystack and the replacement in reverse-        -- order to the chunk list (all chunks will be reversed at once in the final step).-        newChunks = replacement : haystackPart : rsChunks rs-        newLength = replacementLength + haystackPartLength + rsLength rs--        newState = ReplaceState-          { rsChunks = newChunks-          , rsPreviousMatchEnd = matchEnd-          , rsLength = newLength-          }-      in-        if newLength > maxLength-          then BoyerMoore.Done newState-          else BoyerMoore.Step newState--    finish rs =-      let-        -- Slice the remaining part of the haystack from the end of the last match-        -- to the end of the haystack.-        haystackPartLength = haystackLength - rsPreviousMatchEnd rs-        finalChunks-            = Utf8.unsafeSliceUtf8 (rsPreviousMatchEnd rs) haystackPartLength haystack-            : rsChunks rs-        finalLength = rsLength rs + haystackPartLength-      in-        if finalLength > maxLength-          then Nothing-          else Just $ Text.concat $ reverse finalChunks---- | Internal accumulator state for performing a replace while stepping an automaton-data ReplaceState = ReplaceState-  { rsChunks :: [Text]-    -- ^ Chunks of the final text, in reverse order so that we can efficiently prepend-  , rsPreviousMatchEnd :: !CodeUnitIndex-    -- ^ Index one past the end of the last match.-  , rsLength :: !CodeUnitIndex-    -- ^ Length of the newly build string so far, measured in CodeUnits-  }

@@ -1,121 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}--module Data.Text.Utf8.BoyerMoore.Searcher-    ( Searcher-    , automata-    , build-    , buildNeedleIdSearcher-    , buildWithValues-    , containsAll-    , containsAny-    , needles-    , numNeedles-    ) where---import Control.DeepSeq (NFData)-import Data.Bifunctor (first)-import Data.Hashable (Hashable (hashWithSalt), Hashed, hashed, unhashed)-import GHC.Generics (Generic)--import Data.Text.Utf8 (Text)-import Data.Text.Utf8.BoyerMoore.Automaton (Automaton)--import qualified Data.Text.Utf8.BoyerMoore.Automaton as BoyerMoore----- | A set of needles with associated values, and Boyer-Moore automata to--- efficiently find those needles.------ INVARIANT: searcherAutomaton = BoyerMoore.buildAutomaton . searcherNeedles--- To enforce this invariant, the fields are not exposed from this module.--- There is a separate constructor function.------ The purpose of this wrapper is to have a type that is Hashable and Eq, so we--- can derive those for the types that embed the searcher, whithout--- requiring the automaton itself to be Hashable or Eq, which would be both--- wasteful and tedious. Because the automaton is fully determined by the--- needles and associated values, it is sufficient to implement Eq and Hashable--- in terms of the needles only.------ We also use Hashed to cache the hash of the needles.-data Searcher v = Searcher-  { searcherNeedles :: Hashed [(Text, v)]-  , searcherNumNeedles :: Int-  , searcherAutomata :: [(Automaton, v)]-  } deriving (Generic)--instance Show (Searcher v) where-  show _ = "Searcher _ _ _"--instance Hashable v => Hashable (Searcher v) where-  hashWithSalt salt searcher = hashWithSalt salt $ searcherNeedles searcher-  {-# INLINE hashWithSalt #-}--instance Eq v => Eq (Searcher v) where-  Searcher xs nx _ == Searcher ys ny _ = (xs, nx) == (ys, ny)-  {-# INLINE (==) #-}--instance NFData v => NFData (Searcher v)---- | Builds the Searcher for a list of needles without values.--- This is useful for just checking whether the haystack contains the needles.-build :: [Text] -> Searcher ()-{-# INLINABLE build #-}-build = buildWithValues . flip zip (repeat ())---- | Builds the Searcher for a list of needles.-buildWithValues :: Hashable v => [(Text, v)] -> Searcher v-{-# INLINABLE buildWithValues #-}-buildWithValues ns =-  Searcher (hashed ns) (length ns) $ map (first BoyerMoore.buildAutomaton) ns--needles :: Searcher v -> [(Text, v)]-needles = unhashed . searcherNeedles--automata :: Searcher v -> [(Automaton, v)]-automata = searcherAutomata--numNeedles :: Searcher v -> Int-numNeedles = searcherNumNeedles---- | Return whether the haystack contains any of the needles.--- This function is marked noinline as an inlining boundary. BoyerMoore.runText is--- marked inline, so this function will be optimized to report only whether--- there is a match, and not construct a list of matches. We don't want this--- function be inline, to make sure that the conditions of the caller don't--- affect how this function is optimized. There is little to gain from--- additional inlining. The pragma is not an optimization in itself, rather it--- is a defence against fragile optimizer decisions.-{-# NOINLINE containsAny #-}-containsAny :: Searcher () -> Text -> Bool-containsAny !searcher !text =-  let-    -- On the first match, return True immediately.-    f _acc _match = BoyerMoore.Done True-  in-    any (\(automaton, ()) -> BoyerMoore.runText False f automaton text) (automata searcher)--- | Build a 'Searcher' that returns the needle's index in the needle list when it matches.--buildNeedleIdSearcher :: [Text] -> Searcher Int-buildNeedleIdSearcher !ns =-  buildWithValues $ zip ns [0..]---- | Like 'containsAny', but checks whether all needles match instead.--- Use 'buildNeedleIdSearcher' to get an appropriate 'Searcher'.-{-# NOINLINE containsAll #-}-containsAll :: Searcher Int -> Text -> Bool-containsAll !searcher !text =-  let-    -- On the first match, return True immediately.-    f _acc _match = BoyerMoore.Done True-  in-    all (\(automaton, _) -> BoyerMoore.runText False f automaton text) (automata searcher)

@@ -1,439 +1,241 @@ -- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2019 Channable+-- Copyright 2022 Channable -- -- Licensed under the 3-clause BSD license, see the LICENSE file in the -- repository root. +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -module Data.Text.AhoCorasickSpec-    ( spec-    ) where+module Data.Text.AhoCorasickSpec where -import Control.DeepSeq (rnf)-import Control.Monad (forM_, unless)+import Control.Monad (forM_) import Data.Foldable (foldl') import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Text (Text)-import Data.Word (Word16)-import GHC.Stack (HasCallStack)-import Prelude hiding (replicate)-import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe)-import Test.Hspec.Expectations (shouldMatchList, shouldSatisfy)-import Test.Hspec.QuickCheck (modifyMaxSize, modifyMaxSuccess, prop)-import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAll, forAllShrink, (==>))-import Test.QuickCheck.Gen (Gen)+import Test.Hspec (Expectation, Spec, describe, it, shouldBe)+import Test.Hspec.QuickCheck (modifyMaxSize, prop)+import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAll, forAllShrink) import Test.QuickCheck.Instances () -import qualified Data.Char as Char-import qualified Data.Text as Text-import qualified Data.Text.Internal.Search as TextSearch-import qualified Data.Text.Unsafe as TextUnsafe-import qualified Test.QuickCheck as QuickCheck+import qualified Data.Text as T import qualified Test.QuickCheck.Gen as Gen -import Data.Text.AhoCorasick.Automaton (CaseSensitivity (..))+import Data.Text.CaseSensitivity (CaseSensitivity (..)) import Data.Text.Orphans ()+import Data.Text.Utf8 (Text) +import qualified Data.Text.Utf8 as Text+import qualified Data.Text.Utf8 as Utf8 import qualified Data.Text.AhoCorasick.Automaton as Aho import qualified Data.Text.AhoCorasick.Replacer as Replacer import qualified Data.Text.AhoCorasick.Searcher as Searcher import qualified Data.Text.AhoCorasick.Splitter as Splitter-import qualified Data.Text.Utf16 as Utf16 --- | Test that for a single needle which equals the haystack, we find a single--- match. Does not apply to the empty needle.-needleIsHaystackMatches :: HasCallStack => Text -> Expectation-needleIsHaystackMatches needle =-  let-    needleUtf16 = Utf16.unpackUtf16 needle-    len = Utf16.lengthUtf16 needle-    prependMatch ms match = Aho.Step (match : ms)-    matches = Aho.runText [] prependMatch (Aho.build [(needleUtf16, ())]) needle-  in-    matches `shouldBe` [Aho.Match len ()]--ahoMatch :: [(Text, a)] -> Text -> [Aho.Match a]-ahoMatch needles haystack =-  let-    makeNeedle (text, value) = (Utf16.unpackUtf16 text, value)-    needlesUtf16 = fmap makeNeedle needles-    prependMatch matches match = Aho.Step (match : matches)-  in-    Aho.runText [] prependMatch (Aho.build needlesUtf16) haystack---- | Match without a payload, return only the match positions.-matchPositions :: [Text] -> Text -> [Int]-matchPositions needles haystack =-  let-    withUnit x = (x, ())-    matches = ahoMatch (fmap withUnit needles) haystack-  in-    fmap (Utf16.codeUnitIndex . Aho.matchPos) matches---- | `matchPositions` implemented naively in terms of Text's functionality,--- which we assume to be correct.-naiveMatchPositions :: [Text] -> Text -> [Int]-naiveMatchPositions needles haystack =-  let-    prependMatch :: [Int] -> Text -> Int -> Text -> [Int]-    prependMatch matches needle offset haystackSlice =-      if Text.null haystack-        then matches-        -- Text.indices returns all non-overlapping occurrences of the needle,-        -- but we want the overlapping ones as well. So we only consider the-        -- first match, and then search again starting from one past the-        -- beginning of the match.-        else case TextSearch.indices needle haystackSlice of-          []  -> matches-          i:_ -> prependMatch (match : matches) needle offset' remainingHaystack-            where-              -- The match index is the index past the end, not the start index.-              match = offset + i + TextUnsafe.lengthWord16 needle-              offset' = offset + i + 1-              remainingHaystack = TextUnsafe.dropWord16 (i + 1) haystackSlice--    prependMatches matches needle = prependMatch matches needle 0 haystack-  in-    foldl' prependMatches [] needles---- | Generate random needles and haystacks, such that the needles have a--- reasonable probability of occuring in the haystack, which would hardly be the--- case if we just generated random texts for all of them. We do this by first--- generating a set of fragments, and then building the haystack and needles by--- combining these fragments. By doing this, we also get a lot of partial--- matches, where part of a needle does occur in the haystack, but the full--- needle does not, and also needles with a shared prefix or suffix. This should--- fully stress the possible transitions in the automaton.-arbitraryNeedlesHaystack :: Gen ([Text], Text)-arbitraryNeedlesHaystack = do-  let-    -- Prefer ascii just to have printable test cases, but do include the other-    -- generator to cover the entire range of code points.-    genChar = Gen.frequency-      [ (4, QuickCheck.arbitraryASCIIChar)-      , (1, QuickCheck.arbitrary)-      ]-    genNonEmptyText = do-      chars <- Gen.listOf1 genChar-      pure $ Text.pack chars--  fragments <- Gen.listOf1 $ Gen.resize 5 genNonEmptyText-  let-    genFragment = Gen.elements $ filter (not . Text.null) fragments-    genSmall = Gen.scale (`div` 3) $ Gen.listOf1 genFragment-    genBig = Gen.scale (* 4) $ Gen.listOf1 genFragment--  needles <- Gen.listOf1 (fmap Text.concat genSmall)-  haystack <- fmap Text.concat genBig-  pure (needles, haystack)- spec :: Spec-spec = parallel $ do-  modifyMaxSuccess (const 200) $ do-    describe "build" $ do-      prop "does not throw exceptions" $ \ (kv :: [([Word16], Int)]) ->-        rnf $ Aho.build kv--    describe "unpackUtf16" $ do-      it "unpacks code point U+437b8" $-        -- Note that 0x437b8 lies in the currently unassigned "Plane 5"; the-        -- code point does not currently exist, but that should not bother us.-        -- Check in Python: '\U000437b8'.encode('utf-16be')-        Utf16.unpackUtf16 "\x000437b8" `shouldBe` [0xd8cd, 0xdfb8]+spec = do+    -- Ensure that helper functions are actually helping+    -- Examples are from https://en.wikipedia.org/wiki/UTF-8+    describe "IsString ByteArray" $ do -      it "unpacks adjacent nulls individually" $ do-        Utf16.unpackUtf16 "c\NULe" `shouldBe` [99, 0, 101]-        Utf16.unpackUtf16 "bc\NUL\NULe" `shouldBe` [98, 99, 0, 0, 101]+        it "encodes the dollar sign" $ utf8Test "$" [0x24]+        it "encodes the euro sign" $ utf8Test "€" [0xe2, 0x82, 0xac]+        it "encodes the pound sign" $ utf8Test "£" [0xc2, 0xa3]+        it "encodes Hwair" $ utf8Test "𐍈" [0xf0, 0x90, 0x8d, 0x88]+        it "encodes all of the above" $ utf8Test "$€£𐍈" [0x24, 0xe2, 0x82, 0xac, 0xc2, 0xa3, 0xf0, 0x90, 0x8d, 0x88]      describe "runText" $ do -      describe "when given a needle equal to the haystack" $ do+        describe "countMatches" $ do+            it "counts the right number of matches in a basic example" $ do+                countMatches Aho.CaseSensitive ["abc", "rst", "xyz"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 3 -        it "reports a single match for a repeated character" $-          forM_ [1..128] $ \n ->-            needleIsHaystackMatches $ Text.replicate n "a"+            it "counts the right number of matches in an example with 1-, 2-, 3- and 4-code unit code points" $ do+                countMatches Aho.CaseSensitive ["$", "£"] "$€£𐍈" `shouldBe` 2 -        it "reports a single match for non-BMP data" $ do-          -- Include a few code points outside of the Basic Multilingual Plane,-          -- which require multible code units to encode.-          needleIsHaystackMatches "\x000437b8suffix"-          needleIsHaystackMatches "aaa\359339aaa\95759aa\899256aa"+    describe "runLower" $ do -        prop "reports a single match for random needles" $ \needle ->-          not (Text.null needle) ==> needleIsHaystackMatches needle+        describe "countMatches" $ do+            it "counts the right number of matches in a basic example" $ do+                countMatches Aho.IgnoreCase ["abc", "rst", "xyz"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 3 -      describe "when given a sliced text (with nonzero internal offset)" $+            it "does not work with uppercase needles" $ do+                countMatches Aho.IgnoreCase ["ABC", "Rst", "xYZ"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 0 -        it "still reports offset relative to the text start" $-          -- The match position should be relative to the start of the text "a".-          -- Even if this text is represented as a slice of "bbba" internally.-          matchPositions ["a"] (Text.dropWhile (== 'b') "bbba") `shouldMatchList` [1]+            it "works with characters that are not in ASCII" $ do+                countMatches Aho.IgnoreCase ["groß", "öffnung", "tür"] "Großfräsmaschinenöffnungstür" `shouldBe` 3 -      describe "when given non-ascii inputs" $ do+    modifyMaxSize (const 10) $ describe "Replacer" $ do -        -- We have a special lookup table for transitions from the base state-        -- for the first 128 code units, which is always hit for ascii inputs.-        -- Also exercise the fallback code path with a different input.-        it "reports a match if the first haystack character is > U+7f" $ do-          matchPositions ["eclair"] "éclair" `shouldMatchList` []-          matchPositions ["éclair"] "éclair" `shouldMatchList` [6]-          matchPositions ["éclair"] "eclair" `shouldMatchList` []+        describe "run" $ do+            let+                genHaystack = fmap Utf8.pack $ Gen.listOf $ Gen.frequency [(40, Gen.elements "abAB"), (1, pure 'İ'), (1, arbitrary)] -        it "reports the correct UTF-16 index for surrogate pairs" $ do-          -- Note that the index after the match is 2, even though there is-          -- only a single code point. U+1d11e is encoded as two code units-          -- in UTF-16.-          matchPositions ["𝄞"] "𝄞" `shouldMatchList` [2]+                -- needles may not be empty, because empty needles are filtered out in an I.ActionReplaceMultiple+                genNeedle = fmap Utf8.pack $ Gen.resize 3 $ Gen.listOf1 $ Gen.elements "abAB"+                genReplaces = Gen.listOf $ (,) <$> genNeedle <*> arbitrary+                shrinkReplaces = filter (not . any (\(needle, _) -> Utf8.null needle)) . shrink -          -- A levitating woman in business suit with dark skin tone needs a-          -- whopping 5 code points to encode, of which the first two need a-          -- surrogate pair in UTF-16, for a total of 7 code units.-          -- U+1f574: man in business suit levitating-          -- U+1f3ff: emoji modifier Fitzpatrick type-6-          -- U+200d:  zero width joiner-          -- U+2640:  female sign-          -- U+fe0f:  variation selector-16-          -- A peculiar feature of Unicode emoji, is that the male levitating-          -- man in business suit with dark skin tone is a substring of the-          -- levitating woman in business suit. And the levitating man in-          -- business suit without particular skin tone is a substring of that.-          matchPositions-            [ "\x1f574\x1f3ff\x200d\x2640\xfe0f"-            , "\x1f574\x1f3ff"-            , "\x1f574"-            ] "\x1f574\x1f3ff\x200d\x2640\xfe0f" `shouldMatchList` [2, 4, 7]+                replace needles haystack =+                    Replacer.run (Replacer.build Aho.CaseSensitive needles) haystack -      describe "when given overlapping needles" $ do+                replaceIgnoreCase needles haystack =+                    Replacer.run (Replacer.build Aho.IgnoreCase needles) haystack -        it "finds exactly all matches" $ do-          matchPositions ["foobar", "bar"] "foobar" `shouldMatchList` [6, 6]-          matchPositions ["foobarbaz", "bar"] "xfoobarbazy" `shouldMatchList` [10, 7]-          matchPositions ["foobar", "foo"] "xfoobarbazy" `shouldMatchList` [7, 4]+            it "replaces all occurrences" $ do+                replace [("A", "B")] "AXAXB" `shouldBe` "BXBXB"+                replace [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"+                replace [("aaa", ""), ("b", "c")] "aaabaaa" `shouldBe` "c"+                -- Have a few non-matching needles too.+                replace [("A", "B"), ("Q", "r"), ("Z", "")] "AXAXB" `shouldBe` "BXBXB" -        it "keeps the value associated with a needle" $ do-          fmap Aho.matchValue (ahoMatch [("foo", 'A'), ("bar", 'B')] "foobar")-            `shouldMatchList` ['A', 'B']-          fmap Aho.matchValue (ahoMatch [("foo", 'A'), ("bar", 'B')] "foobaz")-            `shouldMatchList` ['A']-          fmap Aho.matchValue (ahoMatch [("foo", 'A'), ("bar", 'B')] "foebar")-            `shouldMatchList` ['B']+            it "replaces only non-overlapping matches" $ do+                replace [("aa", "zz"), ("bb", "w")] "aaabbb" `shouldBe` "zzawb"+                replace [("aaa", "")] "aaaaa" `shouldBe` "aa" -        it "reports both matches in case of a duplicate needle" $-          fmap Aho.matchValue (ahoMatch [("foo", 'A'), ("foo", 'B')] "foobar")-            `shouldMatchList` ['A', 'B']+            it "replaces all occurrences in priority order" $ do+                replace [("A", ""), ("BBBB", "bingo")] "BBABB" `shouldBe` "bingo"+                replace [("BB", ""), ("BBBB", "bingo")] "BBBB" `shouldBe` "" -        it "finds all quadratic matches" $-          forM_ ["a", "ab", "abc"] $ \baseText ->-            forM_ [1..33] $ \n ->-              let-                replicate k = Text.replicate k baseText-                needles = fmap replicate [1..n]-                matches = matchPositions needles (replicate n)-              in-                -- The needle of length 1 matches n times, the needle of length-                -- 2 matches n - 1 times, ..., the needle of length n matches-                -- once.-                length matches `shouldBe` sum [1..n]+            it "replaces needles that contain a surrogate pair" $+                replace [("\x1f574", "levitating man in business suit")]+                    "the \x1f574" `shouldBe` "the levitating man in business suit" -      describe "when given partially overlapping needles" $ do -        it "finds exactly all matches" $ do-          matchPositions ["ab", "bcd"] "abccd" `shouldMatchList` [2]-          matchPositions ["abc","cde"] "abcdde" `shouldMatchList` [3]-          matchPositions ["c","c\NULe"] "c\NUL\NULe" `shouldMatchList` [1]-          -- The case below is a regression test; it did fail before; it would-          -- report a match at position 5 in addition to position 2.-          matchPositions ["bc","c\NULe"] "bc\NUL\NULe" `shouldMatchList` [2]--      describe "when given empyt needles" $ do--        it "does not report a match" $ do-          matchPositions [""] "" `shouldMatchList` []-          matchPositions [""] "foo" `shouldMatchList` []--      describe "when given random needles and haystacks" $ do--        prop "reports only infixes of the haystack" $-          QuickCheck.forAllShrink arbitraryNeedlesHaystack shrink $ \ (needles, haystack) ->-            let-              dup x = (x, x)-              matches = ahoMatch (fmap dup needles) haystack-              sliceMatch endPos len = Utf16.unsafeSliceUtf16 (endPos - len) len haystack-            in-              -- Discard inputs for which there are no matches, to ensure we get-              -- enough coverage for the case where there are matches.-              not (null matches) ==>-                forM_ matches $ \ (Aho.Match pos needle) -> do-                  needle `shouldSatisfy` (`Text.isInfixOf` haystack)-                  sliceMatch pos (Utf16.lengthUtf16 needle) `shouldBe` needle--        prop "reports all infixes of the haystack" $-          QuickCheck.forAllShrink arbitraryNeedlesHaystack shrink $ \ (needles, haystack) ->-            matchPositions needles haystack `shouldMatchList` naiveMatchPositions needles haystack+            it "replaces all occurrences case-insensitively" $ do+                replaceIgnoreCase [("A", "B")] "AXAXB" `shouldBe` "BXBXB"+                replaceIgnoreCase [("A", "B")] "axaxb" `shouldBe` "BxBxb"+                replaceIgnoreCase [("a", "b")] "AXAXB" `shouldBe` "bXbXB" -  let-    isSurrogate cu = cu >= 0xd800 && cu < 0xe000+                replaceIgnoreCase [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"+                replaceIgnoreCase [("A", "B"), ("X", "Y")] "axaxb" `shouldBe` "BYBYb"+                replaceIgnoreCase [("a", "b"), ("x", "y")] "AXAXB" `shouldBe` "bybyB" -  describe "Char.toLower" $ do+            it "matches replacements case-insensitively" $+              replaceIgnoreCase [("foo", "BAR"), ("bar", "BAZ")] "Foo" `shouldBe` "BAZ" -    -- We test that Char.toLower maps the BMP onto itself, because this implies-    -- that changing casing code unit by code unit does not change the number of-    -- code units, which allows us to implement lowercasing in an optimized-    -- manner.-    it "maps the Basic Multilingual Plane onto itself" $-      forM_ [0 .. maxBound :: Utf16.CodeUnit] $ \cu -> unless (isSurrogate cu) $-        let-          lower = Char.ord $ Char.toLower $ Char.chr $ fromIntegral cu-        in-          lower `shouldSatisfy` not . isSurrogate+            it "matches replacements case-insensitively for non-ascii characters" $ do+                replaceIgnoreCase [("éclair", "lightning")] "Éclair" `shouldBe` "lightning"+                -- Note: U+0319 is an uppercase alpha, which looks exactly like A, but it+                -- is a different code point.+                replaceIgnoreCase [("bèta", "α"), ("\x0391", "alpha")] "BÈTA" `shouldBe` "alpha" -  describe "Utf16.lowerCodeUnit" $-    it "is equivalent to Char.toLower on the BMP" $-      forM_ [0 .. maxBound :: Utf16.CodeUnit] $ \cu -> unless (isSurrogate cu) $-        let-          lowerAsChar = fromIntegral . Char.ord . Char.toLower . Char.chr . fromIntegral-        in-          lowerAsChar cu `shouldBe` Utf16.lowerCodeUnit cu+            it "matches surrogate pairs case-insensitively" $ do+                -- We can't lowercase a levivating man in business suit, but that should+                -- not affect whether we match it or not.+                replaceIgnoreCase [("\x1f574", "levitating man in business suit")] "the \x1f574"+                    `shouldBe` "the levitating man in business suit" -  describe "Char.toUpper" $ do+            prop "satisfies (run . compose a b) == (run b (run a))" $+                forAllShrink genHaystack shrink $ \haystack ->+                forAll arbitrary $ \case_ ->+                forAllShrink genReplaces shrinkReplaces $ \replaces1 ->+                forAllShrink genReplaces shrinkReplaces $ \replaces2 ->+                let+                    rm1 = Replacer.build case_ replaces1+                    rm2 = Replacer.build case_ replaces2+                    Just rm12 = Replacer.compose rm1 rm2+                in+                    Replacer.run rm2 (Replacer.run rm1 haystack)+                    `shouldBe` Replacer.run rm12 haystack -    -- We test that Char.toUpper maps the BMP onto itself, because this implies-    -- that changing casing code unit by code unit does not change the number of-    -- code units, which allows us to implement upppercasing in an optimized-    -- manner.-    it "maps the Basic Multilingual Plane onto itself" $-      forM_ [0 .. maxBound :: Utf16.CodeUnit] $ \cu -> unless (isSurrogate cu) $-        let-          upper = Char.ord $ Char.toUpper $ Char.chr $ fromIntegral cu-        in-          upper `shouldSatisfy` not . isSurrogate+            prop "is identity for empty needles" $ \case_ haystack ->+                let replacerId = Replacer.build case_ []+                in Replacer.run replacerId haystack `shouldBe` haystack -  describe "Utf16.upperCodeUnit" $-    it "is equivalent to Char.toUpper on the BMP" $-      forM_ [0 .. maxBound :: Utf16.CodeUnit] $ \cu -> unless (isSurrogate cu) $-        let-          upperAsChar = fromIntegral . Char.ord . Char.toUpper . Char.chr . fromIntegral-        in-          upperAsChar cu `shouldBe` Utf16.upperCodeUnit cu+            prop "is equivalent to sequential Text.replace calls" $+                forAllShrink genHaystack shrink $ \haystack ->+                forAllShrink genReplaces shrinkReplaces $ \replaces ->+                let+                    replacer = Replacer.build Aho.CaseSensitive replaces+                    -- TODO: Remove conversions once we move to text-2.0+                    replaceText agg (needle, replacement) = Utf8.pack $ T.unpack $ T.replace (T.pack $ Utf8.unpack needle) (T.pack $ Utf8.unpack replacement) (T.pack $ Utf8.unpack agg)+                    expected = foldl' replaceText haystack replaces+                in+                    Replacer.run replacer haystack `shouldBe` expected -  modifyMaxSize (const 10) $ describe "Replacer.run" $ do-    let-      genHaystack = fmap Text.pack $ Gen.listOf $ Gen.frequency [(40, Gen.elements "abAB"), (1, pure 'İ'), (1, arbitrary)]-      -- needles may not be empty, because empty needles are filtered out in an I.ActionReplaceMultiple-      genNeedle = fmap Text.pack $ Gen.resize 3 $ Gen.listOf1 $ Gen.elements "abAB"-      genReplaces = Gen.listOf $ (,) <$> genNeedle <*> arbitrary-      shrinkReplaces = filter (not . any (\(needle, _) -> Text.null needle)) . shrink+    describe "Searcher" $ do -      replace needles haystack = Replacer.run (Replacer.build CaseSensitive needles) haystack-      replaceIgnoreCase needles haystack = Replacer.run (Replacer.build IgnoreCase needles) haystack+        describe "containsAny" $ do -    it "replaces all occurrences" $ do-      replace [("A", "B")] "AXAXB" `shouldBe` "BXBXB"-      replace [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"-      replace [("aaa", ""), ("b", "c")] "aaabaaa" `shouldBe` "c"-      -- Have a few non-matching needles too.-      replace [("A", "B"), ("Q", "r"), ("Z", "")] "AXAXB" `shouldBe` "BXBXB"+            it "gives the right values for the examples in the README" $ do+                let needles = ["tshirt", "shirts", "shorts"]+                let searcher = Searcher.build Aho.CaseSensitive needles -    it "replaces only non-overlapping matches" $ do-      replace [("aa", "zz"), ("bb", "w")] "aaabbb" `shouldBe` "zzawb"-      replace [("aaa", "")] "aaaaa" `shouldBe` "aa"+                Searcher.containsAny searcher "short tshirts" `shouldBe` True+                Searcher.containsAny searcher "long shirt" `shouldBe` False+                Searcher.containsAny searcher "Short TSHIRTS" `shouldBe` False -    it "replaces all occurrences in priority order" $ do-      replace [("A", ""), ("BBBB", "bingo")] "BBABB" `shouldBe` "bingo"-      replace [("BB", ""), ("BBBB", "bingo")] "BBBB" `shouldBe` ""+                let searcher' = Searcher.build Aho.IgnoreCase needles -    it "replaces needles that contain a surrogate pair" $-      replace [("\x1f574", "levitating man in business suit")]-        "the \x1f574" `shouldBe` "the levitating man in business suit"+                Searcher.containsAny searcher' "Short TSHIRTS" `shouldBe` True -    it "replaces all occurrences case-insensitively" $ do-      replaceIgnoreCase [("A", "B")] "AXAXB" `shouldBe` "BXBXB"-      replaceIgnoreCase [("A", "B")] "axaxb" `shouldBe` "BxBxb"-      replaceIgnoreCase [("a", "b")] "AXAXB" `shouldBe` "bXbXB"+            it "works with the the first line of the illiad" $ do+                let illiad = "Ἄνδρα μοι ἔννεπε, Μοῦσα, πολύτροπον, ὃς μάλα πολλὰ"+                    needleSets = [(["μοι"], True), (["Ὀδυσεύς"], False)] -      replaceIgnoreCase [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"-      replaceIgnoreCase [("A", "B"), ("X", "Y")] "axaxb" `shouldBe` "BYBYb"-      replaceIgnoreCase [("a", "b"), ("x", "y")] "AXAXB" `shouldBe` "bybyB"+                forM_ needleSets $ \(needles, expectedResult) -> do+                    let searcher = Searcher.build Aho.CaseSensitive needles+                    Searcher.containsAny searcher illiad `shouldBe` expectedResult -    it "matches replacements case-insensitively" $-      replaceIgnoreCase [("foo", "BAR"), ("bar", "BAZ")] "Foo" `shouldBe` "BAZ"+        describe "containsAll" $ do -    it "matches replacements case-insensitively for non-ascii characters" $ do-      replaceIgnoreCase [("éclair", "lightning")] "Éclair" `shouldBe` "lightning"-      -- Note: U+0319 is an uppercase alpha, which looks exactly like A, but it-      -- is a different code point.-      replaceIgnoreCase [("bèta", "α"), ("\x0391", "alpha")] "BÈTA" `shouldBe` "alpha"+            prop "never reports true for empty needles" $ \ (haystack :: Text) ->+                let+                    searcher = Searcher.buildNeedleIdSearcher CaseSensitive [""]+                in+                    Searcher.containsAll searcher haystack `shouldBe` False -    it "matches surrogate pairs case-insensitively" $ do-      -- We can't lowercase a levivating man in business suit, but that should-      -- not affect whether we match it or not.-      replaceIgnoreCase [("\x1f574", "levitating man in business suit")] "the \x1f574"-        `shouldBe` "the levitating man in business suit"+            prop "is equivalent to sequential Text.isInfixOf calls for non-empty needles" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->+                let+                    needles = map unNonEmptyText needles'+                    searcher = Searcher.buildNeedleIdSearcher CaseSensitive needles+                in+                    Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` haystack) needles -    prop "satisfies (run . compose a b) == (run b (run a))" $-      forAllShrink genHaystack shrink $ \haystack ->-      forAll arbitrary $ \case_ ->-      forAllShrink genReplaces shrinkReplaces $ \replaces1 ->-      forAllShrink genReplaces shrinkReplaces $ \replaces2 ->-      let-        rm1 = Replacer.build case_ replaces1-        rm2 = Replacer.build case_ replaces2-        Just rm12 = Replacer.compose rm1 rm2-      in-        Replacer.run rm2 (Replacer.run rm1 haystack)-          `shouldBe` Replacer.run rm12 haystack+            prop "is equivalent to sequential Text.isInfixOf calls for case-insensitive matching for non-empty needles" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->+                let+                    needles = map unNonEmptyText needles' -    prop "is identity for empty needles" $ \case_ haystack ->-      let replacerId = Replacer.build case_ []-      in Replacer.run replacerId haystack `shouldBe` haystack+                    lowerNeedles = map Utf8.lowerUtf8 needles+                    lowerHaystack = Utf8.lowerUtf8 haystack -    prop "is equivalent to sequential Text.replace calls" $-      forAllShrink genHaystack shrink $ \haystack ->-      forAllShrink genReplaces shrinkReplaces $ \replaces ->-      let-        replacer = Replacer.build CaseSensitive replaces-        replaceText agg (needle, replacement) = Text.replace needle replacement agg-        expected = foldl' replaceText haystack replaces-      in-        Replacer.run replacer haystack `shouldBe` expected+                    searcher = Searcher.buildNeedleIdSearcher IgnoreCase lowerNeedles+                in+                    Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` lowerHaystack) lowerNeedles -  describe "Searcher.containsAll" $ do+    describe "Splitter" $ do -    prop "never reports true for empty needles" $ \ (haystack :: Text) ->-      let-        searcher = Searcher.buildNeedleIdSearcher CaseSensitive [""]-      in-        Searcher.containsAll searcher haystack `shouldBe` False+        describe "split" $ do -    prop "is equivalent to sequential Text.isInfixOf calls" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->-      let-        needles = map unNonEmptyText needles'-        searcher = Searcher.buildNeedleIdSearcher CaseSensitive needles-      in-        Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` haystack) needles+            it "passes an example" $ do+                let separator = "bob"+                    splitter = Splitter.build separator -    prop "is equivalent to sequential Text.isInfixOf calls for case-insensitive matching" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->-      let-        needles = map unNonEmptyText needles'+                Splitter.split splitter "C++bobobCOBOLbobScala" `shouldBe` "C++" :| ["obCOBOL", "Scala"] -        lowerNeedles = map Text.toLower needles-        lowerHaystack = Text.toLower haystack+            it "neatly splits the first line of the illiad" $ do+                let splitter = Splitter.build ", " -        searcher = Searcher.buildNeedleIdSearcher IgnoreCase lowerNeedles-      in-        Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` lowerHaystack) lowerNeedles+                Splitter.split splitter "Ἄνδρα μοι ἔννεπε, Μοῦσα, πολύτροπον, ὃς μάλα πολλὰ" `shouldBe`+                    "Ἄνδρα μοι ἔννεπε" :| ["Μοῦσα", "πολύτροπον", "ὃς μάλα πολλὰ"] -  describe "Splitter.split" $+-- helpers -    it "passes an example" $-      let separator = "bob" in-      let splitter = Splitter.build separator in-      Splitter.split splitter "C++bobobCOBOLbobScala"-        `shouldBe` "C++" :| ["obCOBOL", "Scala"]+utf8Test :: Utf8.Text -> [Utf8.CodeUnit] -> Expectation+utf8Test str byteList = str `shouldBe` Utf8.fromByteList byteList --- helpers+-- From ./benchmark+countMatches :: Aho.CaseSensitivity -> [Utf8.Text] -> Utf8.Text -> Int+{-# NOINLINE countMatches #-}+countMatches caseSensitivity needles haystack = case needles of+  [] -> 0+  _  ->+    let+      ac = Aho.build $ zip needles (repeat ())+      onMatch !n _match = Aho.Step (n + 1)+    in+      Aho.runWithCase caseSensitivity 0 onMatch ac haystack  -- | A newtype for generating non-empty 'Text' values. newtype NonEmptyText = NonEmptyText { unNonEmptyText :: Text }

@@ -10,37 +10,37 @@ import Control.DeepSeq (rnf) import Control.Monad (forM_) import Data.Foldable (for_)-import Data.Text (Text) import GHC.Stack (HasCallStack) import Prelude hiding (replicate) import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe) import Test.Hspec.Expectations (shouldMatchList, shouldSatisfy) import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)-import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAll, forAllShrink, (==>))+import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAllShrink, (==>)) import Test.QuickCheck.Gen (Gen) import Test.QuickCheck.Instances () -import qualified Data.Text as Text-import qualified Data.Text.Internal.Search as TextSearch-import qualified Data.Text.Unsafe as TextUnsafe+-- import qualified Data.Text.Internal.Search as TextSearch import qualified Test.QuickCheck as QuickCheck import qualified Test.QuickCheck.Gen as Gen -import Data.Text.BoyerMoore.Automaton (CaseSensitivity (..))+import Data.Text.CaseSensitivity (CaseSensitivity (..)) import Data.Text.Orphans ()+import Data.Text.Utf8 (Text) +import qualified Data.Text.Utf8 as Text+import qualified Data.Text.Utf8 as TextSearch+import qualified Data.Text.Utf8 as Utf8 import qualified Data.Text.AhoCorasick.Replacer as AhoReplacer import qualified Data.Text.BoyerMoore.Automaton as BoyerMoore import qualified Data.Text.BoyerMoore.Replacer as Replacer import qualified Data.Text.BoyerMoore.Searcher as Searcher-import qualified Data.Text.Utf16 as Utf16  -- | Test that for a single needle which equals the haystack, we find a single -- match. Does not apply to the empty needle. needleIsHaystackMatches :: HasCallStack => Text -> Expectation needleIsHaystackMatches needle =   let-    prependMatch ms match = BoyerMoore.Step (Utf16.codeUnitIndex match : ms)+    prependMatch ms match = BoyerMoore.Step (Utf8.codeUnitIndex match : ms)     matches = BoyerMoore.runText [] prependMatch (BoyerMoore.buildAutomaton needle) needle   in     matches `shouldBe` [0]@@ -48,7 +48,7 @@ boyerMatch :: Text -> Text -> [Int] boyerMatch needle haystack =   let-    prependMatch matches match = BoyerMoore.Step (Utf16.codeUnitIndex match : matches)+    prependMatch matches match = BoyerMoore.Step (Utf8.codeUnitIndex match : matches)   in     BoyerMoore.runText [] prependMatch (BoyerMoore.buildAutomaton needle) haystack @@ -58,7 +58,7 @@   let     matches = boyerMatch needle haystack   in-    fmap (Utf16.codeUnitIndex (Utf16.lengthUtf16 needle) +) matches+    fmap (Utf8.codeUnitIndex (Utf8.lengthUtf8 needle) +) matches  -- | `matchEndPositions` implemented naively in terms of Text's functionality, -- which we assume to be correct.@@ -66,7 +66,7 @@ naiveMatchPositions needle haystack =   map toEndPos $ TextSearch.indices needle haystack   where-    toEndPos index = TextUnsafe.lengthWord16 needle + index+    toEndPos index = Utf8.codeUnitIndex (Utf8.lengthUtf8 needle) + index  -- | Generate random needles and haystacks, such that the needles have a -- reasonable probability of occuring in the haystack, which would hardly be the@@ -134,34 +134,59 @@       -- We have a special lookup table for bad character shifts for       -- the first 128 code units, which is always hit for ascii inputs.       -- Also exercise the fallback code path with a different input.+      -- The code point é is encoded as two code units in UTF-8.+      -- 0             7          13+      -- │             │           │+      -- ▼             ▼           ▼+      -- ┌───┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┐+      -- │ é │c│l│a│i│r│e│c│l│a│i│r│ Code Points+      -- ├─┬─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤+      -- │ │ │ │ │ │ │ │ │ │ │ │ │ │ Code Units (Bytes)+      -- └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘       it "reports a match if the haystack contains a character > U+7f" $ do-        matchEndPositions "eclair" "éclaireclair" `shouldMatchList` [12]-        matchEndPositions "éclair" "éclaireclair" `shouldMatchList` [6]-        matchEndPositions "éclair" "eclairéclair" `shouldMatchList` [12]+        matchEndPositions "eclair" "éclaireclair" `shouldMatchList` [13]+        matchEndPositions "éclair" "éclaireclair" `shouldMatchList` [7]+        matchEndPositions "éclair" "eclairéclair" `shouldMatchList` [13] -      it "reports the correct UTF-16 index for surrogate pairs" $ do-        -- Note that the index after the match is 2, even though there is-        -- only a single code point. U+1d11e is encoded as two code units-        -- in UTF-16.-        matchEndPositions "𝄞" "𝄞" `shouldMatchList` [2]+      it "reports the correct code unit index for complex characters" $ do+        -- Note that the index after the match is 4, even though there is+        -- only a single code point. U+1d11e is encoded as four code units:+        -- in UTF-8:+        -- 0       4+        -- │       │+        -- ▼       ▼+        -- ┌───────┐+        -- │   𝄞   │ Code Points+        -- ├─┬─┬─┬─┤+        -- │ │ │ │ │ Code Units (Bytes)+        -- └─┴─┴─┴─┘+        matchEndPositions "𝄞" "𝄞" `shouldMatchList` [4] -        -- A leviating woman in business suit with dark skin tone needs a-        -- whopping 5 code points to encode, of which the first two need a-        -- surrogate pair in UTF-16, for a total of 7 code units.-        -- U+1f574: man in business suit levitating-        -- U+1f3ff: emoji modifier Fitzpatrick type-6-        -- U+200d:  zero width joiner-        -- U+2640:  female sign-        -- U+fe0f:  variation selector-16+        -- A levitating woman in business suit with dark skin tone needs a+        -- whopping 5 code points to encode. The first two need 4 code units each to encode,+        -- the remaining three need 3 code units each for a total of 17 code units:+        -- 0       4       8                17+        -- │       │       │                 │+        -- ▼       ▼       ▼                 ▼+        -- ┌───────┬───────┬─────┬─────┬─────┐+        -- │   1   │   2   │  3  │  4  │  5  │ Code Points+        -- ├─┬─┬─┬─┼─┬─┬─┬─┼─┬─┬─┼─┬─┬─┼─┬─┬─┤+        -- │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ Code Units (Bytes)+        -- └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘+        -- 1. U+1f574: man in business suit levitating (🕴)+        -- 2. U+1f3ff: emoji modifier Fitzpatrick type-6+        -- 3. U+200d:  zero width joiner+        -- 4. U+2640:  female sign (♀)+        -- 5. U+fe0f:  variation selector-16         -- A peculiar feature of Unicode emoji, is that the male levivating         -- man in business suit with dark skin tone is a substring of the         -- levivating woman in business suit. And the levivating man in         -- business suit without particular skin tone is a substring of that.         let           examples =-            [ ("\x1f574\x1f3ff\x200d\x2640\xfe0f", 7)-            , ("\x1f574\x1f3ff", 4)-            , ("\x1f574", 2)+            [ ("\x1f574\x1f3ff\x200d\x2640\xfe0f", 17)+            , ("\x1f574\x1f3ff", 8)+            , ("\x1f574", 4)             ]         for_ examples $ \(needle, endPos) ->           matchEndPositions needle "\x1f574\x1f3ff\x200d\x2640\xfe0f" `shouldMatchList` [endPos]@@ -183,11 +208,11 @@         QuickCheck.forAllShrink arbitraryNeedleHaystack shrink $ \ (needle, haystack) ->           let             matches = boyerMatch needle haystack-            sliceMatch startPos len = Utf16.unsafeSliceUtf16 startPos len haystack+            sliceMatch startPos len = Utf8.unsafeSliceUtf8 startPos len haystack           in             forM_ matches $ \pos -> do               needle `shouldSatisfy` (`Text.isInfixOf` haystack)-              sliceMatch (Utf16.CodeUnitIndex pos) (Utf16.lengthUtf16 needle) `shouldBe` needle+              sliceMatch (Utf8.CodeUnitIndex pos) (Utf8.lengthUtf8 needle) `shouldBe` needle        prop "reports all infixes of the haystack" $         QuickCheck.forAllShrink arbitraryNeedleHaystack shrink $ \ (needle, haystack) ->@@ -198,15 +223,12 @@     prop "is equivalent to Aho-Corasick replacer with a single needle" $       forAllShrink arbitraryNeedleHaystack shrink $ \(needle, haystack) ->       forAllShrink arbitrary shrink $ \replacement ->-      forAll arbitrary $ \case_ ->       let-        expected = AhoReplacer.run (AhoReplacer.build case_ [(needle, replacement)]) haystack+        expected = AhoReplacer.run (AhoReplacer.build CaseSensitive [(needle, replacement)]) haystack -        auto = BoyerMoore.buildAutomaton $ case case_ of-          IgnoreCase -> Utf16.lowerUtf16 needle-          CaseSensitive -> needle+        auto = BoyerMoore.buildAutomaton needle -        actual = Replacer.replaceSingleLimited case_ auto replacement haystack maxBound+        actual = Replacer.replaceSingleLimited auto replacement haystack maxBound       in         actual `shouldBe` Just expected @@ -224,28 +246,17 @@       -- However, at this point we probably shouldn't break this property.       prop "is equivalent to disjunction of Text.isInfixOf calls*" $ \ (needles :: [Text]) (haystack :: Text) ->         let-          searcher = Searcher.build CaseSensitive needles+          searcher = Searcher.build needles           test needle =             not (Text.null needle) && needle `Text.isInfixOf` haystack         in           Searcher.containsAny searcher haystack `shouldBe` any test needles      describe "containsAll" $ do-       prop "is equivalent to conjunction of Text.isInfixOf calls*" $ \ (needles :: [Text]) (haystack :: Text) ->         let-          searcher = Searcher.buildNeedleIdSearcher CaseSensitive needles+          searcher = Searcher.buildNeedleIdSearcher needles           test needle =             not (Text.null needle) && needle `Text.isInfixOf` haystack         in           Searcher.containsAll searcher haystack `shouldBe` all test needles--      prop "performs case-insensitive search as well" $ \ (needles :: [Text]) (haystack :: Text) ->-        let-          lowerNeedles = map Utf16.lowerUtf16 needles-          lowerHaystack = Utf16.lowerUtf16 haystack-          searcher = Searcher.buildNeedleIdSearcher IgnoreCase lowerNeedles-          test needle =-            not (Text.null needle) && needle `Text.isInfixOf` lowerHaystack-        in-          Searcher.containsAll searcher haystack `shouldBe` all test lowerNeedles

@@ -4,16 +4,11 @@  import qualified Test.QuickCheck.Gen as Gen -import Data.Text.Utf8 as Utf8- import Data.Text.CaseSensitivity (CaseSensitivity (..))+import Data.Text.Utf8  instance Arbitrary CaseSensitivity where   arbitrary = Gen.elements [CaseSensitive, IgnoreCase] --- TODO: Slow placeholder implementation until we can use text-2.0-instance Arbitrary Utf8.Text where-  arbitrary = fmap Utf8.pack arbitrary--instance Arbitrary Utf8.CodeUnitIndex where-  arbitrary = fmap Utf8.CodeUnitIndex arbitrary+instance Arbitrary CodeUnitIndex where+  arbitrary = fmap CodeUnitIndex arbitrary

@@ -1,248 +0,0 @@--- Alfred-Margaret: Fast Aho-Corasick string searching--- Copyright 2022 Channable------ Licensed under the 3-clause BSD license, see the LICENSE file in the--- repository root.--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.Text.Utf8.AhoCorasickSpec where--import Control.Monad (forM_)-import Data.Foldable (foldl')-import Data.List.NonEmpty (NonEmpty ((:|)))-import Data.Primitive (byteArrayFromList)-import Test.Hspec (Expectation, Spec, describe, it, shouldBe)-import Test.Hspec.QuickCheck (modifyMaxSize, prop)-import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAll, forAllShrink)--import qualified Data.Text as T-import qualified Test.QuickCheck.Gen as Gen--import Data.Text.CaseSensitivity (CaseSensitivity (..))-import Data.Text.Orphans ()-import Data.Text.Utf8 (Text)--import qualified Data.Text.Utf8 as Text-import qualified Data.Text.Utf8 as Utf8-import qualified Data.Text.Utf8.AhoCorasick.Automaton as Aho-import qualified Data.Text.Utf8.AhoCorasick.Replacer as Replacer-import qualified Data.Text.Utf8.AhoCorasick.Searcher as Searcher-import qualified Data.Text.Utf8.AhoCorasick.Splitter as Splitter--spec :: Spec-spec = do-    -- Ensure that helper functions are actually helping-    -- Examples are from https://en.wikipedia.org/wiki/UTF-8-    describe "IsString ByteArray" $ do--        it "encodes the dollar sign" $ utf8Test "$" [0x24]-        it "encodes the euro sign" $ utf8Test "€" [0xe2, 0x82, 0xac]-        it "encodes the pound sign" $ utf8Test "£" [0xc2, 0xa3]-        it "encodes Hwair" $ utf8Test "𐍈" [0xf0, 0x90, 0x8d, 0x88]-        it "encodes all of the above" $ utf8Test "$€£𐍈" [0x24, 0xe2, 0x82, 0xac, 0xc2, 0xa3, 0xf0, 0x90, 0x8d, 0x88]--    describe "runText" $ do--        describe "countMatches" $ do-            it "counts the right number of matches in a basic example" $ do-                countMatches Aho.CaseSensitive ["abc", "rst", "xyz"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 3--            it "counts the right number of matches in an example with 1-, 2-, 3- and 4-code unit code points" $ do-                countMatches Aho.CaseSensitive ["$", "£"] "$€£𐍈" `shouldBe` 2--    describe "runLower" $ do--        describe "countMatches" $ do-            it "counts the right number of matches in a basic example" $ do-                countMatches Aho.IgnoreCase ["abc", "rst", "xyz"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 3--            it "does not work with uppercase needles" $ do-                countMatches Aho.IgnoreCase ["ABC", "Rst", "xYZ"] "abcdefghijklmnopqrstuvwxyz" `shouldBe` 0--            it "works with characters that are not in ASCII" $ do-                countMatches Aho.IgnoreCase ["groß", "öffnung", "tür"] "Großfräsmaschinenöffnungstür" `shouldBe` 3--    modifyMaxSize (const 10) $ describe "Replacer" $ do--        describe "run" $ do-            let-                genHaystack = fmap Utf8.pack $ Gen.listOf $ Gen.frequency [(40, Gen.elements "abAB"), (1, pure 'İ'), (1, arbitrary)]--                -- needles may not be empty, because empty needles are filtered out in an I.ActionReplaceMultiple-                genNeedle = fmap Utf8.pack $ Gen.resize 3 $ Gen.listOf1 $ Gen.elements "abAB"-                genReplaces = Gen.listOf $ (,) <$> genNeedle <*> arbitrary-                shrinkReplaces = filter (not . any (\(needle, _) -> Utf8.null needle)) . shrink--                replace needles haystack =-                    Replacer.run (Replacer.build Aho.CaseSensitive needles) haystack--                replaceIgnoreCase needles haystack =-                    Replacer.run (Replacer.build Aho.IgnoreCase needles) haystack--            it "replaces all occurrences" $ do-                replace [("A", "B")] "AXAXB" `shouldBe` "BXBXB"-                replace [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"-                replace [("aaa", ""), ("b", "c")] "aaabaaa" `shouldBe` "c"-                -- Have a few non-matching needles too.-                replace [("A", "B"), ("Q", "r"), ("Z", "")] "AXAXB" `shouldBe` "BXBXB"--            it "replaces only non-overlapping matches" $ do-                replace [("aa", "zz"), ("bb", "w")] "aaabbb" `shouldBe` "zzawb"-                replace [("aaa", "")] "aaaaa" `shouldBe` "aa"--            it "replaces all occurrences in priority order" $ do-                replace [("A", ""), ("BBBB", "bingo")] "BBABB" `shouldBe` "bingo"-                replace [("BB", ""), ("BBBB", "bingo")] "BBBB" `shouldBe` ""--            it "replaces needles that contain a surrogate pair" $-                replace [("\x1f574", "levitating man in business suit")]-                    "the \x1f574" `shouldBe` "the levitating man in business suit"---            it "replaces all occurrences case-insensitively" $ do-                replaceIgnoreCase [("A", "B")] "AXAXB" `shouldBe` "BXBXB"-                replaceIgnoreCase [("A", "B")] "axaxb" `shouldBe` "BxBxb"-                replaceIgnoreCase [("a", "b")] "AXAXB" `shouldBe` "bXbXB"--                replaceIgnoreCase [("A", "B"), ("X", "Y")] "AXAXB" `shouldBe` "BYBYB"-                replaceIgnoreCase [("A", "B"), ("X", "Y")] "axaxb" `shouldBe` "BYBYb"-                replaceIgnoreCase [("a", "b"), ("x", "y")] "AXAXB" `shouldBe` "bybyB"--            it "matches replacements case-insensitively" $-              replaceIgnoreCase [("foo", "BAR"), ("bar", "BAZ")] "Foo" `shouldBe` "BAZ"--            it "matches replacements case-insensitively for non-ascii characters" $ do-                replaceIgnoreCase [("éclair", "lightning")] "Éclair" `shouldBe` "lightning"-                -- Note: U+0319 is an uppercase alpha, which looks exactly like A, but it-                -- is a different code point.-                replaceIgnoreCase [("bèta", "α"), ("\x0391", "alpha")] "BÈTA" `shouldBe` "alpha"--            it "matches surrogate pairs case-insensitively" $ do-                -- We can't lowercase a levivating man in business suit, but that should-                -- not affect whether we match it or not.-                replaceIgnoreCase [("\x1f574", "levitating man in business suit")] "the \x1f574"-                    `shouldBe` "the levitating man in business suit"--            prop "satisfies (run . compose a b) == (run b (run a))" $-                forAllShrink genHaystack shrink $ \haystack ->-                forAll arbitrary $ \case_ ->-                forAllShrink genReplaces shrinkReplaces $ \replaces1 ->-                forAllShrink genReplaces shrinkReplaces $ \replaces2 ->-                let-                    rm1 = Replacer.build case_ replaces1-                    rm2 = Replacer.build case_ replaces2-                    Just rm12 = Replacer.compose rm1 rm2-                in-                    Replacer.run rm2 (Replacer.run rm1 haystack)-                    `shouldBe` Replacer.run rm12 haystack--            prop "is identity for empty needles" $ \case_ haystack ->-                let replacerId = Replacer.build case_ []-                in Replacer.run replacerId haystack `shouldBe` haystack--            prop "is equivalent to sequential Text.replace calls" $-                forAllShrink genHaystack shrink $ \haystack ->-                forAllShrink genReplaces shrinkReplaces $ \replaces ->-                let-                    replacer = Replacer.build Aho.CaseSensitive replaces-                    -- TODO: Remove conversions once we move to text-2.0-                    replaceText agg (needle, replacement) = Utf8.pack $ T.unpack $ T.replace (T.pack $ Utf8.unpack needle) (T.pack $ Utf8.unpack replacement) (T.pack $ Utf8.unpack agg)-                    expected = foldl' replaceText haystack replaces-                in-                    Replacer.run replacer haystack `shouldBe` expected--    describe "Searcher" $ do--        describe "containsAny" $ do--            it "gives the right values for the examples in the README" $ do-                let needles = ["tshirt", "shirts", "shorts"]-                let searcher = Searcher.build Aho.CaseSensitive needles--                Searcher.containsAny searcher "short tshirts" `shouldBe` True-                Searcher.containsAny searcher "long shirt" `shouldBe` False-                Searcher.containsAny searcher "Short TSHIRTS" `shouldBe` False--                let searcher' = Searcher.build Aho.IgnoreCase needles--                Searcher.containsAny searcher' "Short TSHIRTS" `shouldBe` True--            it "works with the the first line of the illiad" $ do-                let illiad = "Ἄνδρα μοι ἔννεπε, Μοῦσα, πολύτροπον, ὃς μάλα πολλὰ"-                    needleSets = [(["μοι"], True), (["Ὀδυσεύς"], False)]--                forM_ needleSets $ \(needles, expectedResult) -> do-                    let searcher = Searcher.build Aho.CaseSensitive needles-                    Searcher.containsAny searcher illiad `shouldBe` expectedResult--        describe "containsAll" $ do--            prop "never reports true for empty needles" $ \ (haystack :: Text) ->-                let-                    searcher = Searcher.buildNeedleIdSearcher CaseSensitive [""]-                in-                    Searcher.containsAll searcher haystack `shouldBe` False--            prop "is equivalent to sequential Text.isInfixOf calls for non-empty needles" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->-                let-                    needles = map unNonEmptyText needles'-                    searcher = Searcher.buildNeedleIdSearcher CaseSensitive needles-                in-                    Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` haystack) needles--            prop "is equivalent to sequential Text.isInfixOf calls for case-insensitive matching for non-empty needles" $ \ (needles' :: [NonEmptyText]) (haystack :: Text) ->-                let-                    needles = map unNonEmptyText needles'--                    lowerNeedles = map Utf8.lowerUtf8 needles-                    lowerHaystack = Utf8.lowerUtf8 haystack--                    searcher = Searcher.buildNeedleIdSearcher IgnoreCase lowerNeedles-                in-                    Searcher.containsAll searcher haystack `shouldBe` all (`Text.isInfixOf` lowerHaystack) lowerNeedles--    describe "Splitter" $ do--        describe "split" $ do--            it "passes an example" $ do-                let separator = "bob"-                    splitter = Splitter.build separator--                Splitter.split splitter "C++bobobCOBOLbobScala" `shouldBe` "C++" :| ["obCOBOL", "Scala"]--            it "neatly splits the first line of the illiad" $ do-                let splitter = Splitter.build ", "--                Splitter.split splitter "Ἄνδρα μοι ἔννεπε, Μοῦσα, πολύτροπον, ὃς μάλα πολλὰ" `shouldBe`-                    "Ἄνδρα μοι ἔννεπε" :| ["Μοῦσα", "πολύτροπον", "ὃς μάλα πολλὰ"]---- helpers--utf8Test :: Utf8.Text -> [Utf8.CodeUnit] -> Expectation-utf8Test str byteList = str `shouldBe` Utf8.Text (byteArrayFromList byteList) 0 (length byteList)---- From ./benchmark-countMatches :: Aho.CaseSensitivity -> [Utf8.Text] -> Utf8.Text -> Int-{-# NOINLINE countMatches #-}-countMatches caseSensitivity needles haystack = case needles of-  [] -> 0-  _  ->-    let-      ac = Aho.build $ zip needles (repeat ())-      onMatch !n _match = Aho.Step (n + 1)-    in-      Aho.runWithCase caseSensitivity 0 onMatch ac haystack---- | A newtype for generating non-empty 'Text' values.-newtype NonEmptyText = NonEmptyText { unNonEmptyText :: Text }---- | Simply generates and packs non-empty @[Char]@ values.-instance Arbitrary NonEmptyText where-    arbitrary = NonEmptyText . Text.pack <$> Gen.listOf1 arbitrary--instance Show NonEmptyText where-    show = show . unNonEmptyText

@@ -1,262 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}--{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.Text.Utf8.BoyerMooreSpec-    ( spec-    ) where--import Control.DeepSeq (rnf)-import Control.Monad (forM_)-import Data.Foldable (for_)-import GHC.Stack (HasCallStack)-import Prelude hiding (replicate)-import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe)-import Test.Hspec.Expectations (shouldMatchList, shouldSatisfy)-import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)-import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAllShrink, (==>))-import Test.QuickCheck.Gen (Gen)-import Test.QuickCheck.Instances ()---- import qualified Data.Text.Internal.Search as TextSearch-import qualified Test.QuickCheck as QuickCheck-import qualified Test.QuickCheck.Gen as Gen--import Data.Text.Orphans ()-import Data.Text.Utf8 (Text)-import Data.Text.Utf8.BoyerMoore.Automaton (CaseSensitivity (..))--import qualified Data.Text.Utf8 as Text-import qualified Data.Text.Utf8 as TextSearch-import qualified Data.Text.Utf8 as Utf8-import qualified Data.Text.Utf8.AhoCorasick.Replacer as AhoReplacer-import qualified Data.Text.Utf8.BoyerMoore.Automaton as BoyerMoore-import qualified Data.Text.Utf8.BoyerMoore.Replacer as Replacer-import qualified Data.Text.Utf8.BoyerMoore.Searcher as Searcher---- | Test that for a single needle which equals the haystack, we find a single--- match. Does not apply to the empty needle.-needleIsHaystackMatches :: HasCallStack => Text -> Expectation-needleIsHaystackMatches needle =-  let-    prependMatch ms match = BoyerMoore.Step (Utf8.codeUnitIndex match : ms)-    matches = BoyerMoore.runText [] prependMatch (BoyerMoore.buildAutomaton needle) needle-  in-    matches `shouldBe` [0]--boyerMatch :: Text -> Text -> [Int]-boyerMatch needle haystack =-  let-    prependMatch matches match = BoyerMoore.Step (Utf8.codeUnitIndex match : matches)-  in-    BoyerMoore.runText [] prependMatch (BoyerMoore.buildAutomaton needle) haystack---- | Match without a payload, return only the match positions.-matchEndPositions :: Text -> Text -> [Int]-matchEndPositions needle haystack =-  let-    matches = boyerMatch needle haystack-  in-    fmap (Utf8.codeUnitIndex (Utf8.lengthUtf8 needle) +) matches---- | `matchEndPositions` implemented naively in terms of Text's functionality,--- which we assume to be correct.-naiveMatchPositions :: Text -> Text -> [Int]-naiveMatchPositions needle haystack =-  map toEndPos $ TextSearch.indices needle haystack-  where-    toEndPos index = Utf8.codeUnitIndex (Utf8.lengthUtf8 needle) + index---- | Generate random needles and haystacks, such that the needles have a--- reasonable probability of occuring in the haystack, which would hardly be the--- case if we just generated random texts for all of them. We do this by first--- generating a set of fragments, and then building the haystack and needles by--- combining these fragments. By doing this, we also get a lot of partial--- matches, where part of a needle does occur in the haystack, but the full--- needle does not, and also needles with a shared prefix or suffix. This should--- fully stress the possible transitions in the automaton.-arbitraryNeedleHaystack :: Gen (Text, Text)-arbitraryNeedleHaystack = do-  let-    -- Prefer ascii just to have printable test cases, but do include the other-    -- generator to cover the entire range of code points.-    genChar = Gen.frequency-      [ (4, QuickCheck.arbitraryASCIIChar)-      , (1, QuickCheck.arbitrary)-      ]-    genNonEmptyText = do-      chars <- Gen.listOf1 genChar-      pure $ Text.pack chars--  fragments <- Gen.listOf1 $ Gen.resize 5 genNonEmptyText-  let-    genFragment = Gen.elements $ filter (not . Text.null) fragments-    genSmall = Gen.scale (`div` 3) $ Gen.listOf1 genFragment-    genBig = Gen.scale (* 4) $ Gen.listOf1 genFragment--  needle <- fmap Text.concat genSmall-  haystack <- fmap Text.concat genBig-  pure (needle, haystack)--spec :: Spec-spec = parallel $ modifyMaxSuccess (const 200) $ do-  describe "build" $ do-    prop "does not throw exceptions" $ \ (pat :: Text) ->-      rnf $ BoyerMoore.buildAutomaton pat--  describe "runText" $ do--    describe "when given a needle equal to the haystack" $ do--      it "reports a single match for a repeated character" $-        forM_ [1..128] $ \n ->-          needleIsHaystackMatches $ Text.replicate n "a"--      it "reports a single match for non-BMP data" $ do-        -- Include a few code points outside of the Basic Multilingual Plane,-        -- which require multible code units to encode.-        needleIsHaystackMatches "\x000437b8suffix"-        needleIsHaystackMatches "aaa\359339aaa\95759aa\899256aa"--      prop "reports a single match for random needles" $ \needle ->-        not (Text.null needle) ==> needleIsHaystackMatches needle--    describe "when given a sliced text (with nonzero internal offset)" $ do--      it "still reports offset relative to the text start" $-        -- The match position should be relative to the start of the text "a".-        -- Even if this text is represented as a slice of "bbba" internally.-        matchEndPositions "a" (Text.dropWhile (== 'b') "bbba") `shouldMatchList` [1]--    describe "when given non-ascii inputs" $ do--      -- We have a special lookup table for bad character shifts for-      -- the first 128 code units, which is always hit for ascii inputs.-      -- Also exercise the fallback code path with a different input.-      -- The code point é is encoded as two code units in UTF-8.-      -- 0             7          13-      -- │             │           │-      -- ▼             ▼           ▼-      -- ┌───┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┬─┐-      -- │ é │c│l│a│i│r│e│c│l│a│i│r│ Code Points-      -- ├─┬─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┼─┤-      -- │ │ │ │ │ │ │ │ │ │ │ │ │ │ Code Units (Bytes)-      -- └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘-      it "reports a match if the haystack contains a character > U+7f" $ do-        matchEndPositions "eclair" "éclaireclair" `shouldMatchList` [13]-        matchEndPositions "éclair" "éclaireclair" `shouldMatchList` [7]-        matchEndPositions "éclair" "eclairéclair" `shouldMatchList` [13]--      it "reports the correct code unit index for complex characters" $ do-        -- Note that the index after the match is 4, even though there is-        -- only a single code point. U+1d11e is encoded as four code units:-        -- in UTF-8:-        -- 0       4-        -- │       │-        -- ▼       ▼-        -- ┌───────┐-        -- │   𝄞   │ Code Points-        -- ├─┬─┬─┬─┤-        -- │ │ │ │ │ Code Units (Bytes)-        -- └─┴─┴─┴─┘-        matchEndPositions "𝄞" "𝄞" `shouldMatchList` [4]--        -- A levitating woman in business suit with dark skin tone needs a-        -- whopping 5 code points to encode. The first two need 4 code units each to encode,-        -- the remaining three need 3 code units each for a total of 17 code units:-        -- 0       4       8                17-        -- │       │       │                 │-        -- ▼       ▼       ▼                 ▼-        -- ┌───────┬───────┬─────┬─────┬─────┐-        -- │   1   │   2   │  3  │  4  │  5  │ Code Points-        -- ├─┬─┬─┬─┼─┬─┬─┬─┼─┬─┬─┼─┬─┬─┼─┬─┬─┤-        -- │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ │ Code Units (Bytes)-        -- └─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┴─┘-        -- 1. U+1f574: man in business suit levitating (🕴)-        -- 2. U+1f3ff: emoji modifier Fitzpatrick type-6-        -- 3. U+200d:  zero width joiner-        -- 4. U+2640:  female sign (♀)-        -- 5. U+fe0f:  variation selector-16-        -- A peculiar feature of Unicode emoji, is that the male levivating-        -- man in business suit with dark skin tone is a substring of the-        -- levivating woman in business suit. And the levivating man in-        -- business suit without particular skin tone is a substring of that.-        let-          examples =-            [ ("\x1f574\x1f3ff\x200d\x2640\xfe0f", 17)-            , ("\x1f574\x1f3ff", 8)-            , ("\x1f574", 4)-            ]-        for_ examples $ \(needle, endPos) ->-          matchEndPositions needle "\x1f574\x1f3ff\x200d\x2640\xfe0f" `shouldMatchList` [endPos]--    describe "when given empty needle" $ do--      it "does not report a match" $ do-        matchEndPositions "" "" `shouldMatchList` []-        matchEndPositions "" "foo" `shouldMatchList` []--    describe "kitchen sink" $ do-      it "kitchen sinks" $ do-        matchEndPositions "\"\SO]JL\"" "aaaaa\"\SO]JL\"" `shouldMatchList` [11]-        matchEndPositions "\"X]JL\"" "aaaaa\"X]JL\"" `shouldMatchList` [11]--    describe "when given random needles and haystacks" $ do--      prop "reports only infixes of the haystack" $-        QuickCheck.forAllShrink arbitraryNeedleHaystack shrink $ \ (needle, haystack) ->-          let-            matches = boyerMatch needle haystack-            sliceMatch startPos len = Utf8.unsafeSliceUtf8 startPos len haystack-          in-            forM_ matches $ \pos -> do-              needle `shouldSatisfy` (`Text.isInfixOf` haystack)-              sliceMatch (Utf8.CodeUnitIndex pos) (Utf8.lengthUtf8 needle) `shouldBe` needle--      prop "reports all infixes of the haystack" $-        QuickCheck.forAllShrink arbitraryNeedleHaystack shrink $ \ (needle, haystack) ->-          matchEndPositions needle haystack `shouldMatchList` naiveMatchPositions needle haystack--  describe "replaceSingleLimited" $ do--    prop "is equivalent to Aho-Corasick replacer with a single needle" $-      forAllShrink arbitraryNeedleHaystack shrink $ \(needle, haystack) ->-      forAllShrink arbitrary shrink $ \replacement ->-      let-        expected = AhoReplacer.run (AhoReplacer.build CaseSensitive [(needle, replacement)]) haystack--        auto = BoyerMoore.buildAutomaton needle--        actual = Replacer.replaceSingleLimited auto replacement haystack maxBound-      in-        actual `shouldBe` Just expected--  describe "Searcher" $ do--    describe "containsAny" $ do--      -- For the edge case where a needle is the empty string,-      -- 'Text.isInfixOf' and 'Searcher.containsAny' are different:-      ---      -- @-      -- Text.isInfixOf "" "abc" == True /= False == Searcher.containsAny (Searcher.build [""]) "abc"-      -- @-      ---      -- However, at this point we probably shouldn't break this property.-      prop "is equivalent to disjunction of Text.isInfixOf calls*" $ \ (needles :: [Text]) (haystack :: Text) ->-        let-          searcher = Searcher.build needles-          test needle =-            not (Text.null needle) && needle `Text.isInfixOf` haystack-        in-          Searcher.containsAny searcher haystack `shouldBe` any test needles--    describe "containsAll" $ do-      prop "is equivalent to conjunction of Text.isInfixOf calls*" $ \ (needles :: [Text]) (haystack :: Text) ->-        let-          searcher = Searcher.buildNeedleIdSearcher needles-          test needle =-            not (Text.null needle) && needle `Text.isInfixOf` haystack-        in-          Searcher.containsAll searcher haystack `shouldBe` all test needles

@@ -1,106 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.Text.Utf8.Utf8Spec where--import Control.Monad (forM_)-import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)-import Test.Hspec.QuickCheck (prop)-import Test.QuickCheck (Gen, choose, forAllShrink, shrink)--import qualified Data.Char as Char--import Data.Text.Orphans ()-import Data.Text.Utf8 (stringToByteArray)--import qualified Data.Text.Utf8 as Utf8--spec :: Spec-spec = do-    describe "Properties of the BMP in UTF-8" $ do--        describe "Char.toLower" $ do--            {--            it "does not generate common suffixes" $ do-                forM_ bmpCodepoints $ flip shouldSatisfy $ \cp ->-                    let-                        lowerCp = mapCp Char.toLower cp-                    in-                    cp == lowerCp || null (commonSuffix (Utf8.unicode2utf8 cp) (Utf8.unicode2utf8 lowerCp))-            -- Sadly, it "actually does"-            -}--            it "is idempotent" $ do-                forM_ bmpCodepoints $ flip shouldSatisfy $ \cp ->-                    Char.toLower cp == Char.toLower (Char.toLower cp)--    describe "toLowerAscii" $ do--        it "is equivalent to Char.toLower on ASCII" $ do--            forM_ asciiCodepoints $ flip shouldSatisfy $ \cp ->-                Char.toLower cp == Utf8.toLowerAscii cp--    describe "lowerCodePoint" $ do--        prop "is equivalent to Char.toLower on all of Unicode" $ \c ->-            Utf8.lowerCodePoint c `shouldBe` Char.toLower c--    describe "dropWhile" $ do--        it "handles a simple example well" $ do-            Utf8.dropWhile (== 'b') "bbba" `shouldBe` "a"--    describe "slicing functions" $ do--        let-            -- | Example shown in section "Slicing Functions" in 'Data.Text.Utf8".-            slicingExample :: Utf8.Text-            slicingExample = Utf8.Text (stringToByteArray "ABCDEFGHIJKLMN") 1 11--        it "satisfies the example in Data.Text.Utf8" $ do-            let begin = Utf8.CodeUnitIndex 2-            let length_ = Utf8.CodeUnitIndex 6-            Utf8.unsafeSliceUtf8 begin length_ slicingExample `shouldBe` "DEFGHI"-            Utf8.unsafeCutUtf8 begin length_ slicingExample `shouldBe` ("BC", "JKL")--        prop "unsafeSliceUtf8 and unsafeCutUtf8 are complementary" $-            forAllShrink (arbitrarySlicingIndices slicingExample) shrink $ \ (begin, length_) -> do-                let (prefix, suffix) = Utf8.unsafeCutUtf8 begin length_ slicingExample-                Utf8.concat [prefix, Utf8.unsafeSliceUtf8 begin length_ slicingExample, suffix] `shouldBe` slicingExample--    describe "Basic Text instances" $ do--        prop "Show Text behaves like Show String" $ \ (str :: String) -> do-            show (Utf8.pack str) `shouldBe` show str--        prop "Eq Text behaves like Eq String" $ \ (a :: String) (b :: String) -> do-            Utf8.pack a == Utf8.pack b `shouldBe` a == b--        prop "Ord Text behaves like Ord String" $ \ (a :: String) (b :: String) -> do-            compare (Utf8.pack a) (Utf8.pack b) `shouldBe` compare a b--arbitrarySlicingIndices :: Utf8.Text -> Gen (Utf8.CodeUnitIndex, Utf8.CodeUnitIndex)-arbitrarySlicingIndices example = do-    let exampleLength = Utf8.codeUnitIndex $ Utf8.lengthUtf8 example--    begin <- choose (0, exampleLength)-    length_ <- choose (0, exampleLength - begin)--    pure (Utf8.CodeUnitIndex begin, Utf8.CodeUnitIndex length_)--asciiCodepoints :: [Char]-asciiCodepoints = map Char.chr [0..0x7f]---- | The Basic Multilingual Plane (BMP) contains the Unicode code points--- 0x0000 through 0xFFFF.-bmpCodepoints :: [Char]-bmpCodepoints = map Char.chr [0..0xffff]--commonSuffix :: Eq a => [a] -> [a] -> [a]-commonSuffix list list' = reverse $ go (reverse list) (reverse list')-    where-        go (x:xs) (y:ys)-            | x == y = x : go xs ys-        go _ _ = []

@@ -0,0 +1,106 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Text.Utf8Spec where++import Control.Monad (forM_)+import Test.Hspec (Spec, describe, it, shouldBe, shouldSatisfy)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Gen, choose, forAllShrink, shrink)++import qualified Data.Char as Char++import Data.Text.Orphans ()++import qualified Data.Text.Utf8 as Utf8++spec :: Spec+spec = do+    describe "Properties of the BMP in UTF-8" $ do++        describe "Char.toLower" $ do++            {-+            it "does not generate common suffixes" $ do+                forM_ bmpCodepoints $ flip shouldSatisfy $ \cp ->+                    let+                        lowerCp = mapCp Char.toLower cp+                    in+                    cp == lowerCp || null (commonSuffix (Utf8.unicode2utf8 cp) (Utf8.unicode2utf8 lowerCp))+            -- Sadly, it "actually does"+            -}++            it "is idempotent" $ do+                forM_ bmpCodepoints $ flip shouldSatisfy $ \cp ->+                    Char.toLower cp == Char.toLower (Char.toLower cp)++    describe "toLowerAscii" $ do++        it "is equivalent to Char.toLower on ASCII" $ do++            forM_ asciiCodepoints $ flip shouldSatisfy $ \cp ->+                Char.toLower cp == Utf8.toLowerAscii cp++    describe "lowerCodePoint" $ do++        prop "is equivalent to Char.toLower on all of Unicode" $ \c ->+            Utf8.lowerCodePoint c `shouldBe` Char.toLower c++    describe "dropWhile" $ do++        it "handles a simple example well" $ do+            Utf8.dropWhile (== 'b') "bbba" `shouldBe` "a"++    describe "slicing functions" $ do++        let+            -- | Example shown in section "Slicing Functions" in 'Data.Text.Utf8".+            slicingExample :: Utf8.Text+            slicingExample = Utf8.Text u8data 1 11+                where Utf8.Text u8data _ _ = Utf8.pack "ABCDEFGHIJKLMN"++        it "satisfies the example in Data.Text.Utf8" $ do+            let begin = Utf8.CodeUnitIndex 2+            let length_ = Utf8.CodeUnitIndex 6+            Utf8.unsafeSliceUtf8 begin length_ slicingExample `shouldBe` "DEFGHI"+            Utf8.unsafeCutUtf8 begin length_ slicingExample `shouldBe` ("BC", "JKL")++        prop "unsafeSliceUtf8 and unsafeCutUtf8 are complementary" $+            forAllShrink (arbitrarySlicingIndices slicingExample) shrink $ \ (begin, length_) -> do+                let (prefix, suffix) = Utf8.unsafeCutUtf8 begin length_ slicingExample+                Utf8.concat [prefix, Utf8.unsafeSliceUtf8 begin length_ slicingExample, suffix] `shouldBe` slicingExample++    describe "Basic Text instances" $ do++        prop "Show Text behaves like Show String" $ \ (str :: String) -> do+            show (Utf8.pack str) `shouldBe` show str++        prop "Eq Text behaves like Eq String" $ \ (a :: String) (b :: String) -> do+            Utf8.pack a == Utf8.pack b `shouldBe` a == b++        prop "Ord Text behaves like Ord String" $ \ (a :: String) (b :: String) -> do+            compare (Utf8.pack a) (Utf8.pack b) `shouldBe` compare a b++arbitrarySlicingIndices :: Utf8.Text -> Gen (Utf8.CodeUnitIndex, Utf8.CodeUnitIndex)+arbitrarySlicingIndices example = do+    let exampleLength = Utf8.codeUnitIndex $ Utf8.lengthUtf8 example++    begin <- choose (0, exampleLength)+    length_ <- choose (0, exampleLength - begin)++    pure (Utf8.CodeUnitIndex begin, Utf8.CodeUnitIndex length_)++asciiCodepoints :: [Char]+asciiCodepoints = map Char.chr [0..0x7f]++-- | The Basic Multilingual Plane (BMP) contains the Unicode code points+-- 0x0000 through 0xFFFF.+bmpCodepoints :: [Char]+bmpCodepoints = map Char.chr [0..0xffff]++commonSuffix :: Eq a => [a] -> [a] -> [a]+commonSuffix list list' = reverse $ go (reverse list) (reverse list')+    where+        go (x:xs) (y:ys)+            | x == y = x : go xs ys+        go _ _ = []

@@ -2,16 +2,12 @@  import Test.Hspec (describe, hspec) -import Data.Text.AhoCorasickSpec as A-import Data.Text.BoyerMooreSpec as B-import Data.Text.Utf8.AhoCorasickSpec as U8A-import Data.Text.Utf8.BoyerMooreSpec as U8B-import Data.Text.Utf8.Utf8Spec as U8+import Data.Text.AhoCorasickSpec as U8A+import Data.Text.BoyerMooreSpec as U8B+import Data.Text.Utf8Spec as U8  main :: IO () main = hspec $ do-  describe "Data.Text.AhoCorasick" A.spec-  describe "Data.Text.BoyerMoore" B.spec-  describe "Data.Text.Utf8.AhoCorasick" U8A.spec-  describe "Data.Text.Utf8.BoyerMoore" U8B.spec+  describe "Data.Text.AhoCorasick" U8A.spec+  describe "Data.Text.BoyerMoore" U8B.spec   describe "Data.Text.Utf8" U8.spec