content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE OverloadedStrings #-}
  
  module Data.Text.BoyerMooreCISpec
    ( spec
    ) where
  
  
  import Control.Monad (forM_)
  import Test.Hspec (Spec, describe, it, shouldBe, parallel)
  import Test.Hspec.QuickCheck (modifyMaxSuccess, prop)
  import Data.Text (Text)
  import Test.QuickCheck (Arbitrary (arbitrary, shrink), forAllShrink)
  import Test.QuickCheck.Instances ()
  
  import qualified Data.Char as Char
  import qualified Data.Text as Text
  import qualified Data.Text.Utf8 as Utf8
  import qualified Test.QuickCheck as QuickCheck
  
  import Data.Text.CaseSensitivity (CaseSensitivity (..))
  import Data.Text.TestInstances (arbitraryAlphabet, arbitraryFragment, arbitraryNeedleHaystack,
                                  arbitraryNeedlesHaystack)
  
  import qualified Data.Text.AhoCorasick.Replacer as AhoReplacer
  import qualified Data.Text.BoyerMooreCI.Automaton as BoyerMooreCI
  import qualified Data.Text.BoyerMooreCI.Searcher as Searcher
  import qualified Data.Text.BoyerMooreCI.Replacer as Replacer
  
  
  spec :: Spec
  spec = parallel $ modifyMaxSuccess (const 200) $ do
  
    describe "automaton" $ do
  
      it "works for some basic examples" $ do
        matchPositions "a" "abca" `shouldBe` [(0,0), (3,3)]
        matchPositions "a" "ABCA" `shouldBe` [(0,0), (3,3)]
        matchPositions "abc" "abca" `shouldBe` [(0,2)]
        matchPositions "abc" "ABCA" `shouldBe` [(0,2)]
        matchPositions "bc" "abca" `shouldBe` [(1,2)]
        matchPositions "bc" "ABCA" `shouldBe` [(1,2)]
  
      it "does not yield overlapping matches" $ do
        matchPositions "aba" "abababa" `shouldBe` [(0,2), (4,6)]
        matchPositions "aba" "ABaBaBA" `shouldBe` [(0,2), (4,6)]
  
      it "does not work with uppercase needles" $ do
        matchPositions "A" "aaaa" `shouldBe` []
        matchPositions "A" "AAAA" `shouldBe` []
  
      it "works with cyrillic characters" $ do
        -- Cyrillic characters are all two bytes.
        -- The match positions are byte indices (not char indices).
        matchPositions "п" "ипсум" `shouldBe` [(2,3)]
        matchPositions "п" "ИПСУМ" `shouldBe` [(2,3)]
  
        matchPositions "лорем" "Лорем" `shouldBe` [(0,9)]
        matchTexts "лорем" "Лорем" `shouldBe` ["Лорем"]
  
        matchPositions "лорем" "ЛОРЕМ" `shouldBe` [(0,9)]
        matchTexts "лорем" "ЛОРЕМ" `shouldBe` ["ЛОРЕМ"]
  
        -- This is an interesting case for badCharLookup, because the mismatch
        -- happens at "с" which is the first character in the needle.
        matchTexts "сит" "итсит" `shouldBe` ["сит"]
        matchTexts "сит" "ИТСИТ" `shouldBe` ["СИТ"]
  
      it "works with mixed byte lengths" $ do
        -- Space is 1 byte
        matchTexts "сит" "Лор сит амет" `shouldBe` ["сит"]
        matchTexts "сит" "Лорем ипсум долор сит амет" `shouldBe` ["сит"]
        matchTexts "сит" "ЛОРЕМ ИПСУМ ДОЛОР СИТ АМЕТ" `shouldBe` ["СИТ"]
  
        matchTexts "💩b" "ЛОРЕМab𝄞💩𝄞ДОЛab💩baåÅÅ𝄞𝄞ßẞ" `shouldBe` ["💩b"]
        matchTexts "𝄞" "ЛОРЕМab𝄞💩𝄞ДОЛab💩baåÅÅ𝄞𝄞ßẞ" `shouldBe` ["𝄞","𝄞","𝄞","𝄞"]
        matchTexts "a" "ЛОРЕМab𝄞💩𝄞ДОЛab💩baåÅÅ𝄞𝄞ßẞ" `shouldBe` ["a","a","a"]
  
      it "works with ⱥ and ⱦ" $ do
        -- The letters ⱥ and ⱦ are 3 UTF8 bytes, but have unlowerings Ⱥ and Ⱦ of 2 bytes
        matchPositions "ⱥⱦⱥⱦⱥⱦ" "ⱥⱦⱥⱦⱥⱦ" `shouldBe` [(0, 17)]
        matchTexts "ⱥⱦⱥⱦⱥⱦ" "ⱥⱦⱥⱦⱥⱦ" `shouldBe` ["ⱥⱦⱥⱦⱥⱦ"]
        matchPositions "ⱥⱦⱥⱦⱥⱦ" "ȺȾȺȾȺȾ" `shouldBe` [(0, 11)]
        matchTexts "ⱥⱦⱥⱦⱥⱦ" "ȺȾȺȾȺȾ" `shouldBe` ["ȺȾȺȾȺȾ"]
  
        matchPositions "ⱥⱦⱥⱦⱥⱦ" "ȺⱦⱥȾⱥȾ" `shouldBe` [(0, 14)]
        matchTexts "ⱥⱦⱥⱦⱥⱦ" "ȺⱦⱥȾⱥȾ" `shouldBe` ["ȺⱦⱥȾⱥȾ"]
  
      describe "with a needle equal to the haystack" $ do
  
        it "reports a single match for a repeated character" $
          forM_ [1..128] $ \n ->
            let needle = Text.replicate n "a" in
            matchPositions needle needle `shouldBe` [(0, Utf8.lengthUtf8 needle-1)]
  
        prop "reports a single match for any arbitrary text fragment" $
          QuickCheck.forAll (arbitraryAlphabet >>= arbitraryFragment) $ \text ->
            let needle = Utf8.lowerUtf8 text in
            matchPositions needle text `shouldBe` [(0, Utf8.lengthUtf8 text-1)]
  
      describe "with sliced text (using 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.
          matchPositions "a" (Text.dropWhile (== 'b') "bbba") `shouldBe` [(0, 0)]
  
      it "matches ß and ẞ" $ do
        matchTexts "groß" "Großfräsmaschinenöffnungstür" `shouldBe` ["Groß"]
        matchTexts "groß" "GROẞFRÄSMASCHINENÖFFNUNGSTÜR" `shouldBe` ["GROẞ"]
        matchTexts "öffnung" "Großfräsmaschinenöffnungstür" `shouldBe` ["öffnung"]
        matchTexts "öffnung" "GROẞFRÄSMASCHINENÖFFNUNGSTÜR" `shouldBe` ["ÖFFNUNG"]
  
  
    describe "minimumSkipForCodePoint" $
      it "should match the reference implementation" $ do
        forM_ [minBound..maxBound] $ \c ->
          BoyerMooreCI.minimumSkipForCodePoint c `shouldBe` refMinimumSkipForCodePoint c
  
  
    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*" $ do
          QuickCheck.forAllShrink arbitraryNeedlesHaystack shrink $ \(needles, haystack) -> do
            let
              lneedles = map Utf8.lowerUtf8 needles  -- needles must be lowercase
              searcher = Searcher.build lneedles
              test needle =
                not (Text.null needle) && needle `Text.isInfixOf` (Utf8.lowerUtf8 haystack)
            Searcher.containsAny searcher haystack `shouldBe` any test lneedles
  
      describe "containsAll" $ do
        prop "is equivalent to conjunction of Text.isInfixOf calls*" $ do
          QuickCheck.forAllShrink arbitraryNeedlesHaystack shrink $ \(needles, haystack) -> do
            let
              lneedles = map Utf8.lowerUtf8 needles  -- needles must be lowercase
              searcher = Searcher.buildNeedleIdSearcher lneedles
              test needle =
                not (Text.null needle) && needle `Text.isInfixOf` (Utf8.lowerUtf8 haystack)
            Searcher.containsAll searcher haystack `shouldBe` all test lneedles
  
    describe "Replacer" $ do
      describe "replaceSingleLimited" $ do
  
        prop "is equivalent to Aho-Corasick replacer with a single needle" $
          forAllShrink arbitraryNeedleHaystack shrink $ \(needle, haystack) ->
          forAllShrink arbitrary shrink $ \replacement ->
          let
            lneedle = Utf8.lowerUtf8 needle
            expected =
              AhoReplacer.run (AhoReplacer.build IgnoreCase [(lneedle, replacement)]) haystack
            auto = BoyerMooreCI.buildAutomaton lneedle
            actual = Replacer.replaceSingleLimited auto replacement haystack maxBound
          in
            actual `shouldBe` Just expected
  
  -- Reference implementation for BoyerMooreCI.minimumSkipForCodePoint
  refMinimumSkipForCodePoint :: Utf8.CodePoint -> Utf8.CodeUnitIndex
  refMinimumSkipForCodePoint cp =
    let codePointLength = length . Utf8.unicode2utf8 . Char.ord in
    case Utf8.unlowerCodePoint cp of
      [] ->
        -- Input is upper case, so this is undefined behaviour but we match what the real
        -- implementation does:
        Utf8.CodeUnitIndex $ codePointLength cp
      ucs -> Utf8.CodeUnitIndex $ minimum $ map codePointLength ucs
  
  
  -- | Return indices of the first and last byte of every match
  matchPositions :: Text -> Text -> [(Utf8.CodeUnitIndex, Utf8.CodeUnitIndex)]
  matchPositions needle =
    let
      !automaton = BoyerMooreCI.buildAutomaton needle
      prependMatch matches matchStart matchEnd =
        BoyerMooreCI.Step ((matchStart, matchEnd) : matches)
    in
      \haystack -> reverse $ BoyerMooreCI.runText [] prependMatch automaton haystack
  
  positionText :: Text -> (Utf8.CodeUnitIndex, Utf8.CodeUnitIndex) -> Text
  positionText haystack (firstByte, lastByte) =
    let len = lastByte - firstByte + 1  -- length is 1 if firstByte==lastByte
    in Utf8.unsafeSliceUtf8 firstByte len haystack
  
  matchTexts :: Text -> Text -> [Text]
  matchTexts needle haystack =
    map (positionText haystack) $ matchPositions needle haystack
  