anagrep-0.1.0.0: test/Main.hs

import           Control.Monad (forM_)
import qualified Data.Bits as B
import qualified Data.CaseInsensitive as CI
import           Data.Either (isRight)
import           Numeric.Natural (Natural)
import           Test.Hspec
import qualified Test.QuickCheck as Q

import Text.Regex.Anagram
import qualified Text.Regex.Anagram.Bits as B

tests :: [(Bool, String, [String], [String])]
tests =
  [ (False, "a*", ["","a","aa","aaa","aaaaaaaaaaaaaa"],
      ["b","ab","bad","A"])
  , (False, "a+b", ["ba","ab","baaaa","aaba"],
      ["","bab","abc","b"])
  , (False, "a[ab]+b", ["baa","aab","aba","abb","bba","bab","aaaba","bbba"],
      ["","ab","aa","aaa","b","xabb"])
  , (False, "a[ab]*b?", ["baa","aab","aba","abb","bba","bab","aaaba","bbba","aa","ab","aaa","a"],
      ["","bbb","b","abc"])
  , (False, "ba{2,}", ["aba","aaab","baaaa","aaaaabaaa"],
      ["a","ab","baac"])
  , (False, "[^a]", ["b","c","d"],
      ["","a","bb","ba"])
  , (False, "[^a-d]*", ["ee","xyz",""],
      ["a","xa","fce"])
  , (False, "[^a][^ab][^abc]", ["bcd","cde","xyz","ccd"],
      ["","a","ab","abc","aaa","bbb","ccc"])
  , (False, "[a-c][^a-c]", ["ad","xc"],
      ["","a","cc","aa","xy","ab"])
  , (False, "[abc]?[ab]?a?", ["","a","b","c","aa","ab","ba","ac","ca","aaa","abc","cab"],
      ["bbc","abcabcabcabc","aaaaa","abcdefg","x"])
  , (False, "[efg][def][cde][bcd][abc]", ["abcde","ccffc","gfedc","defbc"],
      ["","ddd","aaaaa","ccccc","cccae"])
  , (False, "[efg][^def][cde][^bcd][abc]", ["abcde","ccffc","gfedc","defbc","cccae"],
      ["","ddd","aaaaa","ccccc"])
  , (False, "[a-m]{10}", ["abcdefghij","cdfmeadljb","eeeeeeeeee","aaaabbbaaa"],
      ["a","mnopqrstuv","abcdefghix","aaaaaaaaan","abcdefghijklm"])
  , (False, "[a-m]{10}a?", ["abcdefghij","cdfmeadljb","aeeeeeeeeee","aaaabbbaaa","abcdefghijk"],
      ["a","mnopqrstuv","abcdefghix","aaaaaaaaan","abcdefghijklm","abcdefghij1"])
  , (False, "[a-m]{1,10}", ["a","b","m","cde","abcdefghij","cdfmeadljb","eeeeeeeeee","aaaabbb"],
      ["","xyz","abcdefghix","aaaaaxaaaa","abcdefghijklm","aabbccddeeffgghhiijj","abcx"])
  , (False, "[a-m]{13,26}", ["abcdefghijklm","cdfmeadljbjmeab","eeeeeeeeeeeeeeeeeeee","aaaabbbaaaccccaaddddaa","abcdefghijklmmlkjihgfedcba"],
      ["a","mnopqrstuvwxyz","abcdefghijklmabcdefgh1","aaaaaaaaaaaaaaaan","abcdefghijklmmmmmmmmmmn"])
  , (False, "[a-m][a-ln][a-kn-o][a-jn-p][a-in-q][a-hn-r][a-gn-s][a-fn-t][a-en-u][a-dn-v][a-cn-w][a-bn-x][an-y][n-z]", ["abcdefghijklmn", "bcdefghijklmno", "mnopqrstuvwxyz"],
      -- pathologically slow
      ["aaaaaaaaaaaaaa","abcdefghijklm","nnnnnnnnnnnnn","abcdefghijklma"])
  , (False, "[0-9]?[0-8a]?[0-7a-b]?[0-6a-c]?[0-5a-d]?[0-4a-e]?[0-3a-f]?[0-2a-g]?[0-1a-h]?[0a-i]?", ["0123456789", "123456789i", "0000000000", "abcdefghi9", "000000000", "abcdefghi", "", "i", "fab9"],
      ["1111111111","1234567899"])
  , (True, "a*", ["","a","A","aAa"],
      ["b"])
  , (True, "[^A]", ["b"],
      ["","a","A"])
  , (True, "[A-C][^a-c]", ["ad","xc","Ad","XC"],
      ["","a","cc","aa","xy","aA","AA"])
  ]

totals :: [(String, [String])]
totals =
  [ ("()", [""])
  , ("abc", ["abc","acb","bac","bca","cab","cba"])
  , ("[a-d]", ["a","b","c","d"])
  , ("[ab][bc]", ["ab","ac","bb","bc","ca","cb"])
  , ("[ab][ac]", ["aa","ac","ba","bc","ca","cb"])
  , ("a[ab]b", ["baa","aab","aba","abb","bba","bab"])
  , ("a[ab]?b?", ["a","ab","aa","baa","aab","aba","abb","bba","bab"])
  , ("[ab]a?", ["a","b","aa","ab","ba"])
  , ("[ab]{2}a?", ["aa","ab","ba","bb","aaa","aab","aba","baa","abb","bab","bba"])
  , ("(a|b)c", ["ac","ca","bc","cb"])
  , ("(ab|cd)", ["ab","ba","cd","dc"])
  , ("(a|b(b?|c))", ["a","b","bb","bc","cb"])
  , ("a{2,4}", ["aa","aaa","aaaa"])
  ]

props :: [(String, String, CI.CI Anagrex -> Q.Property)]
props =
  [ (".*", "match everything", \p -> Q.property $
      test False p)
  , (".+", "match anything", \p -> Q.property $
      \s -> test False p s Q.=/= null s)
  , (".*x", "match anything with an x", \p -> Q.property $
      \s -> test False p s Q.=== ('x' `elem` s))
  , ("a.*x", "match anything with an a and x", \p -> Q.property $
      \s -> test False p s Q.=== ('x' `elem` s && 'a' `elem` s))
  , (".", "match single chars", \p -> Q.property $
      \s -> test False p s Q.=== (length s == 1))
  , (".{2}", "match two chars", \p -> Q.property $
      \s -> test False p s Q.=== (length s == 2))
  ]

parse :: String -> (CI.CI Anagrex -> Spec) -> Spec
parse r t = describe ("pattern " ++ show r) $ do
  let pp = makeAnagrex r
      Right p = pp
  it "should parse" $ pp `shouldSatisfy` isRight
  t $ CI.mk p

test :: Bool -> CI.CI Anagrex -> String -> Bool
test False p s = testAnagrex (CI.original p) s
test True p s = testAnagrexCI p (CI.mk s)

main :: IO ()
main = hspec $ describe "Text.Regex.Anagram" $ do
  describe "findBits" $ do
    it "should find one bit" $ Q.forAll (Q.choose (0, 255)) $ \i -> B.findBits (B.bit i     :: Natural) Q.=== [i]
    it "should find all bit" $ Q.forAll (Q.choose (0, 255)) $ \i -> B.findBits (B.allBits i :: Natural) Q.=== [0..pred i]
  forM_ tests $ \(ci, r, y, n) -> parse r $ \p -> do
    forM_ y $ \s -> it ("should match " ++ show s) $ test ci p s
    forM_ n $ \s -> it ("should not match " ++ show s) $ not $ test ci p s
  forM_ totals $ \(r, y) -> parse r $ \p -> do
    forM_ y $ \s -> it ("should match " ++ show s) $ test False p s
    it "should not match anything else" $ Q.property $ \s -> test False p s Q.=== (s `elem` y)
  forM_ props $ \(r, d, t) -> parse r $ it ("should " ++ d) . t