{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}  -- Arbitrary instances

import Control.Applicative
import Control.Monad
import Data.Char
import qualified Data.List as L
import Data.Maybe
import Data.List.NonEmpty (NonEmpty(..))
import Data.Proxy
import Data.Semigroup
import Data.String
import qualified Numeric as Num
import Numeric.Natural
import Data.Text (Text)
import qualified Data.Text as T

import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Test.QuickCheck.Classes.Base
import Test.QuickCheck.Poly

import qualified Data.CharSet as CS
import qualified Regex.Base as R
import qualified Regex.List as RL
import qualified Regex.Text as RT

main :: IO ()
main = defaultMain $ localOption (QuickCheckTests 5000) $ testGroup "Tests"
  [ testGroup "Regex.Text"
    [ textReTests
    , combinatorTests
    , compileTests
    , textOpTests
    ]
  , testGroup "Regex.List"
    [ listReTests
    , listCombinatorTests
    , stringOpTests
    ]
  , manyTests
  , charSetTests
  ]

----------------
-- Various REs
---------------

textReTests :: TestTree
textReTests = testGroup "Text RE"
  [ testGroup "char"
    [ testPM "a, a, ok" (RT.char 'a') "a" (Just 'a')
    , testPM "a, b, fail" (RT.char 'a') "b" Nothing
    , testPM "a, <e>, fail" (RT.char 'a') "" Nothing
    , testProperty "random" $ \c1 c2 ->
        RT.reParse (RT.char c1) (T.singleton c2) ===
        if c1 == c2 then Just c1 else Nothing
    ]
  , testGroup "charIgnoreCase" $
    let f c1 c2 = testPM ([c1] <> ", " <> [c2] <> ", ok")
                         (RT.charIgnoreCase c1) (T.singleton c2) (Just c2)
    in ["aA", "DZDzdz", "θϴϑΘ"] >>= \cs -> liftA2 f cs cs
  , testGroup "anyChar"
    [ testProperty "random" $ \c ->
        RT.reParse RT.anyChar (T.singleton c) === Just c
    ]
  , testGroup "oneOf"
    [ testProperty "random" $ \cs c ->
        RT.reParse (RT.oneOf cs) (T.singleton c) ===
        if CS.member c cs then Just c else Nothing
    ]
  , testGroup "text"
    [ testPM "foo, foo, ok" (RT.text "foo") "foo" (Just "foo")
    , testPM "foo, bar, fail" (RT.text "foo") "bar" Nothing
    , testPM "foo, <e>, fail" (RT.text "foo") "" Nothing
    , testProperty "random" $ \t ->
        RT.reParse (RT.text t) t === Just t
    ]
  , testGroup "textIgnoreCase"
    [ testPM "foo, foo, ok" (RT.textIgnoreCase "foo") "foo" (Just "foo")
    , testPM "foo, FOO, ok" (RT.textIgnoreCase "foo") "FOO" (Just "FOO")
    , testPM "foo, fOO, ok" (RT.textIgnoreCase "foo") "fOO" (Just "fOO")
    , testPM "foo, bar, fail" (RT.textIgnoreCase "foo") "bar" Nothing
    , testPM "foo, <e>, fail" (RT.textIgnoreCase "foo") "" Nothing
    , testPM "dznuts, DzNuts, ok" (RT.textIgnoreCase "dznuts") "DzNuts" (Just "DzNuts")
    , testPM ":)" (RT.textIgnoreCase ":)") ":)" (Just ":)")
    , testProperty "random theta" $
      let gt = T.pack <$> listOf (elements "θϴϑΘ") in
      forAll ((,) <$> gt <*> gt) $ \(t1,t2) ->
        RT.reParse (RT.textIgnoreCase t1 <* RT.manyText) t2 ===
        if T.length t1 <= T.length t2 then Just (T.take (T.length t1) t2) else Nothing
    ]
  , testGroup "manyText"
    [ testProperty "random" $ \t ->
        RT.reParse RT.manyText t === Just t
    ]
  , testGroup "someText"
    [ testProperty "random" $ \t ->
        RT.reParse RT.someText t === if T.null t then Nothing else Just t
    ]
  , testGroup "manyTextMin"
    [ testProperty "random" $ \t ->
        RT.reParse RT.manyTextMin t === Just t
    ]
  , testGroup "someTextMin"
    [ testProperty "random" $ \t ->
        RT.reParse RT.someTextMin t === if T.null t then Nothing else Just t
    ]
  , testGroup "many some Text bias" $
    let f (name,re1,re2,g) = testProperty name $ \t ->
          RT.reParse (liftA2 (,) re1 re2) t === g t
    in map f
      [ ("manyText manyText", RT.manyText, RT.manyText, \t -> Just (t,""))
      , ("manyText someText", RT.manyText, RT.someText, \t ->
          fmap (fmap T.singleton) (T.unsnoc t))
      , ("manyText manyTextMin", RT.manyText, RT.manyTextMin, \t -> Just (t,""))
      , ("manyText someTextMin", RT.manyText, RT.someTextMin,  \t ->
          fmap (fmap T.singleton) (T.unsnoc t))
      , ("someText manyText", RT.someText, RT.manyText, \t ->
          if T.null t then Nothing else Just (t,""))
      , ("someText someText", RT.someText, RT.someText, \t -> do
          (t',c) <- T.unsnoc t
          _ <- T.uncons t'
          pure (t', T.singleton c))
      , ("someText manyTextMin", RT.someText, RT.manyTextMin, \t ->
          if T.null t then Nothing else Just (t,""))
      , ("someText someTextMin", RT.someText, RT.someTextMin, \t -> do
          (t',c) <- T.unsnoc t
          _ <- T.uncons t'
          pure (t', T.singleton c))
      , ("manyTextMin manyText", RT.manyTextMin, RT.manyText, \t -> Just ("",t))
      , ("manyTextMin someText", RT.manyTextMin, RT.someText, \t ->
          if T.null t then Nothing else Just ("",t))
      , ("manyTextMin manyTextMin", RT.manyTextMin, RT.manyTextMin, \t -> Just ("",t))
      , ("manyTextMin someTextMin", RT.manyTextMin, RT.someTextMin,  \t ->
          if T.null t then Nothing else Just ("",t))
      , ("someTextMin manyText", RT.someTextMin, RT.manyText, \t ->
          fmap (\(c,t') -> (T.singleton c,t')) (T.uncons t))
      , ("someTextMin someText", RT.someTextMin, RT.someText, \t -> do
          (c,t') <- T.uncons t
          _ <- T.uncons t'
          pure (T.singleton c,t'))
      , ("someTextMin manyTextMin", RT.someTextMin, RT.manyTextMin, \t ->
          fmap (\(c,t') -> (T.singleton c,t')) (T.uncons t))
      , ("someTextMin someTextMin", RT.someTextMin, RT.someTextMin, \t -> do
          (c,t') <- T.uncons t
          _ <- T.uncons t'
          pure (T.singleton c,t'))
      ]
  , testGroup "manyTextOf"
    [ testProperty "random" $
      forAll zeroOneText $ \t ->
        RT.reParse (RT.manyTextOf "0") t ===
        if T.all (=='0') t then Just t else Nothing
    , testPM "bias" (RT.manyTextOf "0" <* RT.manyText) "0000" (Just "0000")
    ]
  , testGroup "someTextOf"
    [ testProperty "random" $
      forAll zeroOneText $ \t ->
        RT.reParse (RT.someTextOf "0") t ===
        if not (T.null t) && T.all (=='0') t then Just t else Nothing
    , testPM "bias" (RT.someTextOf "0" <* RT.manyText) "0000" (Just "0000")
    ]
  , testGroup "manyTextOfMin"
    [ testProperty "random" $
      forAll zeroOneText $ \t ->
        RT.reParse (RT.manyTextOfMin "0") t ===
        if T.all (=='0') t then Just t else Nothing
    , testPM "bias" (RT.manyTextOfMin "0" <* RT.manyText) "0000" (Just "")
    ]
  , testGroup "someTextOfMin"
    [ testProperty "random" $
      forAll zeroOneText $ \t ->
        RT.reParse (RT.someTextOfMin "0") t ===
        if not (T.null t) && T.all (=='0') t then Just t else Nothing
    , testPM "bias" (RT.someTextOfMin "0" <* RT.manyText) "0000" (Just "0")
    ]
  , textNumericTests
  ]

listReTests :: TestTree
listReTests = testGroup "List RE"
  [ testGroup "single"
    [ testLPM "a, a, ok" (RL.single 'a') "a" (Just 'a')
    , testLPM "a, b, fail" (RL.single 'a') "b" Nothing
    , testLPM "a, <e>, fail" (RL.single 'a') "" Nothing
    , testProperty "random" $ \c1 c2 ->
        RL.reParse @Char (RL.single c1) [c2] ===
        if c1 == c2 then Just c1 else Nothing
    ]
  , testGroup "charIgnoreCase" $
    let f c1 c2 = testLPM ([c1] <> ", " <> [c2] <> ", ok")
                          (RL.charIgnoreCase c1) [c2] (Just c2)
    in ["aA", "DZDzdz", "θϴϑΘ"] >>= \cs -> liftA2 f cs cs
  , testGroup "anyChar"
    [ testProperty "random" $ \c ->
        RL.reParse @Char RL.anySingle [c] === Just c
    ]
  , testGroup "oneOf"
    [ testProperty "random" $ \cs c ->
        RL.reParse (RL.oneOfChar cs) [c] ===
        if CS.member c cs then Just c else Nothing
    ]
  , testGroup "list"
    [ testLPM "foo, foo, ok" (RL.list "foo") "foo" (Just "foo")
    , testLPM "foo, bar, fail" (RL.list "foo") "bar" Nothing
    , testLPM "foo, <e>, fail" (RL.list "foo") "" Nothing
    , testProperty "random" $ \t ->
        RL.reParse @Char (RL.list t) t === Just t
    ]
  , testGroup "stringIgnoreCase"
    [ testLPM "foo, foo, ok" (RL.stringIgnoreCase "foo") "foo" (Just "foo")
    , testLPM "foo, FOO, ok" (RL.stringIgnoreCase "foo") "FOO" (Just "FOO")
    , testLPM "foo, fOO, ok" (RL.stringIgnoreCase "foo") "fOO" (Just "fOO")
    , testLPM "foo, bar, fail" (RL.stringIgnoreCase "foo") "bar" Nothing
    , testLPM "foo, <e>, fail" (RL.stringIgnoreCase "foo") "" Nothing
    , testLPM "dznuts, DzNuts, ok" (RL.stringIgnoreCase "dznuts") "DzNuts" (Just "DzNuts")
    , testLPM ":)" (RL.stringIgnoreCase ":)") ":)" (Just ":)")
    , testProperty "random theta" $
      let gt = listOf (elements "θϴϑΘ") in
      forAll ((,) <$> gt <*> gt) $ \(t1,t2) ->
        RL.reParse (RL.stringIgnoreCase t1 <* RL.manyList) t2 ===
        if length t1 <= length t2 then Just (take (length t1) t2) else Nothing
    ]
  , testGroup "manyList"
    [ testProperty "random" $ \t ->
        RL.reParse @Char RL.manyList t === Just t
    ]
  , testGroup "someList"
    [ testProperty "random" $ \t ->
        RL.reParse @Char RL.someList t === if null t then Nothing else Just t
    ]
  , testGroup "manyListMin"
    [ testProperty "random" $ \t ->
        RL.reParse @Char RL.manyListMin t === Just t
    ]
  , testGroup "someListMin"
    [ testProperty "random" $ \t ->
        RL.reParse @Char RL.someListMin t === if null t then Nothing else Just t
    ]
  , testGroup "many some Text bias" $
    let f (name,re1,re2,g) = testProperty name $ \t ->
          RL.reParse (liftA2 (,) re1 re2) t === g t
    in map f
      [ ("manyList manyList", RL.manyList, RL.manyList, \t -> Just (t,""))
      , ("manyList someList", RL.manyList, RL.someList, \t ->
          fmap (fmap (:[])) (unsnoc t))
      , ("manyList manyListMin", RL.manyList, RL.manyListMin, \t -> Just (t,""))
      , ("manyList someListMin", RL.manyList, RL.someListMin,  \t ->
          fmap (fmap (:[])) (unsnoc t))
      , ("someList manyList", RL.someList, RL.manyList, \t ->
          if null t then Nothing else Just (t,""))
      , ("someList someList", RL.someList, RL.someList, \t -> do
          (t',c) <- unsnoc t
          _ <- L.uncons t'
          pure (t', [c]))
      , ("someList manyListMin", RL.someList, RL.manyListMin, \t ->
          if null t then Nothing else Just (t,""))
      , ("someList someListMin", RL.someList, RL.someListMin, \t -> do
          (t',c) <- unsnoc t
          _ <- L.uncons t'
          pure (t', [c]))
      , ("manyListMin manyList", RL.manyListMin, RL.manyList, \t -> Just ("",t))
      , ("manyListMin someList", RL.manyListMin, RL.someList, \t ->
          if null t then Nothing else Just ("",t))
      , ("manyListMin manyListMin", RL.manyListMin, RL.manyListMin, \t -> Just ("",t))
      , ("manyListMin someListMin", RL.manyListMin, RL.someListMin,  \t ->
          if null t then Nothing else Just ("",t))
      , ("someListMin manyList", RL.someListMin, RL.manyList, \t ->
          fmap (\(c,t') -> ([c],t')) (L.uncons t))
      , ("someListMin someList", RL.someListMin, RL.someList, \t -> do
          (c,t') <- L.uncons t
          _ <- L.uncons t'
          pure ([c],t'))
      , ("someListMin manyListMin", RL.someListMin, RL.manyListMin, \t ->
          fmap (\(c,t') -> ([c],t')) (L.uncons t))
      , ("someListMin someListMin", RL.someListMin, RL.someListMin, \t -> do
          (c,t') <- L.uncons t
          _ <- L.uncons t'
          pure ([c],t'))
      ]
  , testGroup "manyListOf"
    [ testProperty "random" $
      forAll zeroOneString $ \t ->
        RL.reParse (RL.manyStringOf "0") t ===
        if all (=='0') t then Just t else Nothing
    , testLPM "bias" (RL.manyStringOf "0" <* RL.manyList) "0000" (Just "0000")
    ]
  , testGroup "someListOf"
    [ testProperty "random" $
      forAll zeroOneString $ \t ->
        RL.reParse (RL.someStringOf "0") t ===
        if not (null t) && all (=='0') t then Just t else Nothing
    , testLPM "bias" (RL.someStringOf "0" <* RL.manyList) "0000" (Just "0000")
    ]
  , testGroup "manyListOfMin"
    [ testProperty "random" $
      forAll zeroOneString $ \t ->
        RL.reParse (RL.manyStringOfMin "0") t ===
        if all (=='0') t then Just t else Nothing
    , testLPM "bias" (RL.manyStringOfMin "0" <* RL.manyList) "0000" (Just "")
    ]
  , testGroup "someListOfMin"
    [ testProperty "random" $
      forAll zeroOneString $ \t ->
        RL.reParse (RL.someStringOfMin "0") t ===
        if not (null t) && all (=='0') t then Just t else Nothing
    , testLPM "bias" (RL.someStringOfMin "0" <* RL.manyList) "0000" (Just "0")
    ]
  , stringNumericTests
  ]

------------------
-- Numeric tests
------------------

textNumericTests :: TestTree
textNumericTests = testGroup "Text numeric"
  [ testGroup "naturalDec"
    [ testPM "<empty>, fail" RT.naturalDec "" Nothing
    , testPM "1a, fail" RT.naturalDec "1a" Nothing
    , testPM "1a2, fail" RT.naturalDec "1a2" Nothing
    , testPM "0, ok" RT.naturalDec "0" (Just 0)
    , testPM "1, ok" RT.naturalDec "1" (Just 1)
    , testPM "-1, fail" RT.naturalDec "-1" Nothing
    , testPM "+1, fail" RT.naturalDec "+1" Nothing
    , testPM "01, fail" RT.naturalDec "01" Nothing
    , testPM "123456789123456789123456789, ok" RT.naturalDec "123456789123456789123456789" (Just 123456789123456789123456789)
    , testPM "18446744073709551615, ok" RT.naturalDec "18446744073709551615" (Just 18446744073709551615)
    , testPM "18446744073709551616, ok" RT.naturalDec "18446744073709551616" (Just 18446744073709551616)
    , testProperty "random dec" $
      forAll decText $ \t ->
        RT.reParse RT.naturalDec t === Just (read (T.unpack t))
    , testProperty "random" $
      forAll abDecText $ \t ->
        let ex = parseDecNoLz (T.unpack t)
        in classify (isJust ex) "ok" $
          RT.reParse RT.naturalDec t === ex
    ]
  , testGroup "integerDec"
    [ testPM "pure (), 1, ok" (RT.integerDec (pure ())) "1" (Just 1)
    , testPM "pure (), +1, ok" (RT.integerDec (pure ())) "+1" (Just 1)
    , testPM "pure (), -1, ok" (RT.integerDec (pure ())) "-1" (Just (-1))
    , testPM "pure (), 001, fail" (RT.integerDec (pure ())) "001" Nothing
    , testPM "pure (), +001, fail" (RT.integerDec (pure ())) "+001" Nothing
    , testPM "pure (), -001, fail" (RT.integerDec (pure ())) "-001" Nothing
    , testPM "lz, 1, ok" (RT.integerDec (many (RT.char '0'))) "1" (Just 1)
    , testPM "lz, +1, ok" (RT.integerDec (many (RT.char '0'))) "+1" (Just 1)
    , testPM "lz, -1, ok" (RT.integerDec (many (RT.char '0'))) "-1" (Just (-1))
    , testPM "lz, 001, ok" (RT.integerDec (many (RT.char '0'))) "001" (Just 1)
    , testPM "lz, +001, ok" (RT.integerDec (many (RT.char '0'))) "+001" (Just 1)
    , testPM "lz, -001, ok" (RT.integerDec (many (RT.char '0'))) "-001" (Just (-1))
    , testProperty "random" $
      forAll (liftA2 (<>) (elements ["-","+",""]) abDecText) $ \t ->
        let ex = parseInteger parseDecNoLz (T.unpack t)
        in classify (isJust ex) "ok" $
          RT.reParse (RT.integerDec (pure ())) t === ex
    ]
  , testGroup "naturalHex"
    [ testPM "<empty>, fail" RT.naturalHex "" Nothing
    , testPM "1g, fail" RT.naturalHex "1g" Nothing
    , testPM "1g2, fail" RT.naturalHex "1g2" Nothing
    , testPM "0, ok" RT.naturalHex "0" (Just 0)
    , testPM "1, ok" RT.naturalHex "1" (Just 1)
    , testPM "f, ok" RT.naturalHex "f" (Just 15)
    , testPM "F, ok" RT.naturalHex "F" (Just 15)
    , testPM "-1, fail" RT.naturalHex "-1" Nothing
    , testPM "+1, fail" RT.naturalHex "+1" Nothing
    , testPM "01, fail" RT.naturalHex "01" Nothing
    , testPM "123456789abcdef123456789abcdef, ok" RT.naturalHex "123456789abcdef123456789abcdef" (Just 0x123456789abcdef123456789abcdef)
    , testPM "ffffffffffffffff, ok" RT.naturalHex "ffffffffffffffff" (Just 0xffffffffffffffff)
    , testPM "10000000000000000, ok" RT.naturalHex "10000000000000000" (Just 0x10000000000000000)
    , testProperty "random hex" $
      forAll hexText $ \t ->
        RT.reParse RT.naturalHex t === Just (read ("0x" ++ T.unpack t))
    , testProperty "random" $
      forAll pqHexText $ \t ->
        let ex = parseHexNoLz (T.unpack t)
        in classify (isJust ex) "ok" $
          RT.reParse RT.naturalHex t === ex
    ]
  , testGroup "integerHex"
    [ testPM "pure (), 1, ok" (RT.integerHex (pure ())) "1" (Just 1)
    , testPM "pure (), +1, ok" (RT.integerHex (pure ())) "+1" (Just 1)
    , testPM "pure (), -1, ok" (RT.integerHex (pure ())) "-1" (Just (-1))
    , testPM "pure (), 001, fail" (RT.integerHex (pure ())) "001" Nothing
    , testPM "pure (), +001, fail" (RT.integerHex (pure ())) "+001" Nothing
    , testPM "pure (), -001, fail" (RT.integerHex (pure ())) "-001" Nothing
    , testPM "lz, 1, ok" (RT.integerHex (many (RT.char '0'))) "1" (Just 1)
    , testPM "lz, +1, ok" (RT.integerHex (many (RT.char '0'))) "+1" (Just 1)
    , testPM "lz, -1, ok" (RT.integerHex (many (RT.char '0'))) "-1" (Just (-1))
    , testPM "lz, 001, ok" (RT.integerHex (many (RT.char '0'))) "001" (Just 1)
    , testPM "lz, +001, ok" (RT.integerHex (many (RT.char '0'))) "+001" (Just 1)
    , testPM "lz, -001, ok" (RT.integerHex (many (RT.char '0'))) "-001" (Just (-1))
    , testProperty "random" $
      forAll (liftA2 (<>) (elements ["-","+",""]) pqHexText) $ \t ->
        let ex = parseInteger parseHexNoLz (T.unpack t)
        in classify (isJust ex) "ok" $
          RT.reParse (RT.integerHex (pure ())) t === ex
    ]
  , testGroup "wordRangeDec"
    [ testPM "(0,0) 0 ok" (RT.wordRangeDec (0,0)) "0" (Just 0)
    , testPM "(0,0) 1 fail" (RT.wordRangeDec (0,0)) "1" Nothing
    , testPM "(0,0) -1 fail" (RT.wordRangeDec (0,0)) "-1" Nothing
    , testPM "(1,0) 0 fail" (RT.wordRangeDec (1,0)) "1" Nothing
    , testPM "(1,0) 1 fail" (RT.wordRangeDec (1,0)) "0" Nothing
    , testPM "(0,19) 00 fail" (RT.wordRangeDec (0,19)) "00" Nothing
    , testPM "(100,999) 0 fail" (RT.wordRangeDec (100,999)) "0" Nothing
    , testPM "(100,999) 1 fail" (RT.wordRangeDec (100,999)) "1" Nothing
    , testPM "(100,999) 123 ok" (RT.wordRangeDec (100,999)) "123" (Just 123)
    , testPM "(100,999) 1234 fail" (RT.wordRangeDec (100,999)) "1234" Nothing
    , testPM "(0,1) 01 fail" (RT.wordRangeDec (0,1)) "01" Nothing
    , testPM "(0,maxBound) maxBound ok"
             (RT.wordRangeDec (0,maxBound))
             (T.pack (show (maxBound :: Word)))
             (Just maxBound)
    , testPM "(0,maxBound) (maxBound+1) fail"
             (RT.wordRangeDec (0,maxBound))
             (T.pack (show (fromIntegral (maxBound :: Word) + 1 :: Integer)))
             Nothing
    , testPM "(maxBound,maxBound) (maxBound-1) fail"
             (RT.wordRangeDec (maxBound,maxBound))
             (T.pack (show (maxBound - 1 :: Word)))
             Nothing
    , testGroup "bias"
      [ let re = RT.wordRangeDec (1,999) in
        testPM "(1,999) 2222 (222,2)" (liftA2 (,) re re) "2222" (Just (222,2))
      , let re = RT.wordRangeDec (1,1000) in
        testPM "(1,1000) 1111, (111,1)" (liftA2 (,) re re) "1111" (Just (111,1))
      ]
    , testProperty "any word" $ \(Large n) ->
        RT.reParse (RT.wordRangeDec (minBound,maxBound)) (T.pack (show n)) ===
        Just n
    , testGroup "random dec" $
      let f low high n =
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RT.reParse (RT.wordRangeDec (low,high)) (T.pack (show n)) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll abDecText $ \t ->
          let ex = do
                x <- parseDecNoLz (T.unpack t)
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.wordRangeDec (low,high)) t === ex
    ]
  , testGroup "intRangeDec"
    [ testPM "pure (), (-1,1), 1, ok" (RT.intRangeDec (pure ()) (-1,1)) "1" (Just 1)
    , testPM "pure (), (-1,1), +1, ok" (RT.intRangeDec (pure ()) (-1,1)) "+1" (Just 1)
    , testPM "pure (), (-1,1), -1, ok" (RT.intRangeDec (pure ()) (-1,1)) "-1" (Just (-1))
    , testPM "pure (), (-1,1), 001, fail" (RT.intRangeDec (pure ()) (-1,1)) "001" Nothing
    , testPM "pure (), (-1,1), +001, fail" (RT.intRangeDec (pure ()) (-1,1)) "+001" Nothing
    , testPM "pure (), (-1,1), -001, fail" (RT.intRangeDec (pure ()) (-1,1)) "-001" Nothing
    , testPM "lz, (-1,1), 1, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "1" (Just 1)
    , testPM "lz, (-1,1), +1, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "+1" (Just 1)
    , testPM "lz, (-1,1), -1, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "-1" (Just (-1))
    , testPM "lz, (-1,1), 001, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "001" (Just 1)
    , testPM "lz, (-1,1), +001, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "+001" (Just 1)
    , testPM "lz, (-1,1), -001, ok" (RT.intRangeDec (many (RT.char '0')) (-1,1)) "-001" (Just (-1))
    , testPM "(minBound,maxBound) maxBound ok"
             (RT.intRangeDec (pure ()) (minBound,maxBound))
             (T.pack (show (maxBound :: Int)))
             (Just maxBound)
    , testPM "(minBound,maxBound) minBound ok"
             (RT.intRangeDec (pure ()) (minBound,maxBound))
             (T.pack (show (minBound :: Int)))
             (Just minBound)
    , testPM "(minBound,maxBound) (maxBound+1) fail"
             (RT.intRangeDec (pure ()) (minBound,maxBound))
             (T.pack (show (fromIntegral (maxBound :: Int) + 1 :: Integer)))
             Nothing
    , testPM "(minBound,maxBound) (minBound+1) fail"
             (RT.intRangeDec (pure ()) (minBound,maxBound))
             (T.pack (show (fromIntegral (minBound :: Int) - 1 :: Integer)))
             Nothing
    , testPM "(maxBound,maxBound) (maxBound-1) fail"
             (RT.intRangeDec (pure ()) (maxBound,maxBound))
             (T.pack (show (maxBound - 1 :: Int)))
             Nothing
    , testPM "(minBound,minBound) (minBound+1) fail"
             (RT.intRangeDec (pure ()) (minBound,minBound))
             (T.pack (show (minBound + 1 :: Int)))
             Nothing
    , testProperty "any int" $ \(Large n) ->
        RT.reParse (RT.intRangeDec (pure ()) (minBound,maxBound)) (T.pack (show n)) === Just n
    , testGroup "random dec" $
      let f low high n = forAll (showIntDecExtraSign n) $ \nstr ->
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RT.reParse (RT.intRangeDec (pure ()) (low,high)) (T.pack nstr) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll (liftA2 (<>) (elements ["-","+",""]) abDecText) $ \t ->
          let ex = do
                x <- parseInteger parseDecNoLz (T.unpack t)
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.intRangeDec (pure ()) (low,high)) t === ex
    ]
  , testGroup "wordRangeHex"
    [ testPM "(0,0) 0 ok" (RT.wordRangeHex (0,0)) "0" (Just 0)
    , testPM "(0,0) 1 fail" (RT.wordRangeHex (0,0)) "1" Nothing
    , testPM "(0,0) -1 fail" (RT.wordRangeHex (0,0)) "-1" Nothing
    , testPM "(1,0) 0 fail" (RT.wordRangeHex (1,0)) "1" Nothing
    , testPM "(1,0) 1 fail" (RT.wordRangeHex (1,0)) "0" Nothing
    , testPM "(0,1f) 00 fail" (RT.wordRangeHex (0,0x1f)) "00" Nothing
    , testPM "(100,fff) 0 fail" (RT.wordRangeHex (0x100,0xfff)) "0" Nothing
    , testPM "(100,fff) 1 fail" (RT.wordRangeHex (0x100,0xfff)) "1" Nothing
    , testPM "(100,fff) 123 ok" (RT.wordRangeHex (0x100,0xfff)) "123" (Just 0x123)
    , testPM "(100,fff) 1234 fail" (RT.wordRangeHex (0x100,0xfff)) "1234" Nothing
    , testPM "(0,1) 01 fail" (RT.wordRangeHex (0,1)) "01" Nothing
    , testPM "(0,maxBound) maxBound ok"
             (RT.wordRangeHex (0,maxBound))
             (T.pack (showHex (maxBound :: Word)))
             (Just maxBound)
    , testPM "(0,maxBound) (maxBound+1) fail"
             (RT.wordRangeHex (0,maxBound))
             (T.pack (showHex (fromIntegral (maxBound :: Word) + 1 :: Integer)))
             Nothing
    , testPM "(maxBound,maxBound) (maxBound-1) fail"
             (RT.wordRangeHex (maxBound,maxBound))
             (T.pack (showHex (maxBound - 1 :: Word)))
             Nothing
    , testGroup "bias"
      [ let re = RT.wordRangeHex (0x1,0x999) in
        testPM "(1,999) 2222 (222,2)" (liftA2 (,) re re) "2222" (Just (0x222,0x2))
      , let re = RT.wordRangeHex (0x1,0x1000) in
        testPM "(1,1000) 1111, (111,1)" (liftA2 (,) re re) "1111" (Just (0x111,0x1))
      ]
    , testProperty "any word" $ \(Large n) ->
        RT.reParse (RT.wordRangeHex (minBound,maxBound)) (T.pack (showHex n)) ===
        Just n
    , testGroup "random hex" $
      let f low high n =
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RT.reParse (RT.wordRangeHex (low,high)) (T.pack (showHex n)) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll pqHexText $ \t ->
          let ex = do
                x <- parseHexNoLz (T.unpack t)
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.wordRangeHex (low,high)) t === ex
    ]
  , testGroup "intRangeHex"
    [ testPM "pure (), (-1,1), 1, ok" (RT.intRangeHex (pure ()) (-1,1)) "1" (Just 1)
    , testPM "pure (), (-1,1), +1, ok" (RT.intRangeHex (pure ()) (-1,1)) "+1" (Just 1)
    , testPM "pure (), (-1,1), -1, ok" (RT.intRangeHex (pure ()) (-1,1)) "-1" (Just (-1))
    , testPM "pure (), (-1,1), 001, fail" (RT.intRangeHex (pure ()) (-1,1)) "001" Nothing
    , testPM "pure (), (-1,1), +001, fail" (RT.intRangeHex (pure ()) (-1,1)) "+001" Nothing
    , testPM "pure (), (-1,1), -001, fail" (RT.intRangeHex (pure ()) (-1,1)) "-001" Nothing
    , testPM "lz, (-1,1), 1, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "1" (Just 1)
    , testPM "lz, (-1,1), +1, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "+1" (Just 1)
    , testPM "lz, (-1,1), -1, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "-1" (Just (-1))
    , testPM "lz, (-1,1), 001, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "001" (Just 1)
    , testPM "lz, (-1,1), +001, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "+001" (Just 1)
    , testPM "lz, (-1,1), -001, ok" (RT.intRangeHex (many (RT.char '0')) (-1,1)) "-001" (Just (-1))
    , testPM "(minBound,maxBound) maxBound ok"
             (RT.intRangeHex (pure ()) (minBound,maxBound))
             (T.pack (showHex (maxBound :: Int)))
             (Just maxBound)
    , testPM "(minBound,maxBound) minBound ok"
             (RT.intRangeHex (pure ()) (minBound,maxBound))
             (T.pack (showHex (minBound :: Int)))
             (Just minBound)
    , testPM "(minBound,maxBound) (maxBound+1) fail"
             (RT.intRangeHex (pure ()) (minBound,maxBound))
             (T.pack (showHex (fromIntegral (maxBound :: Int) + 1 :: Integer)))
             Nothing
    , testPM "(minBound,maxBound) (minBound+1) fail"
             (RT.intRangeHex (pure ()) (minBound,maxBound))
             (T.pack (showHex (fromIntegral (minBound :: Int) - 1 :: Integer)))
             Nothing
    , testPM "(maxBound,maxBound) (maxBound-1) fail"
             (RT.intRangeHex (pure ()) (maxBound,maxBound))
             (T.pack (showHex (maxBound - 1 :: Int)))
             Nothing
    , testPM "(minBound,minBound) (minBound+1) fail"
             (RT.intRangeHex (pure ()) (minBound,minBound))
             (T.pack (showHex (minBound + 1 :: Int)))
             Nothing
    , testProperty "any int" $ \(Large n) ->
        RT.reParse (RT.intRangeHex (pure ()) (minBound,maxBound)) (T.pack (showHex n)) === Just n
    , testGroup "random hex" $
      let f low high n = forAll (showIntHexExtraSign n) $ \nstr ->
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RT.reParse (RT.intRangeHex (pure ()) (low,high)) (T.pack nstr) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll (liftA2 (<>) (elements ["-","+",""]) pqHexText) $ \t ->
          let ex = do
                x <- parseInteger parseHexNoLz (T.unpack t)
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.intRangeHex (pure ()) (low,high)) t === ex
    ]
  , testGroup "wordDecN"
    [ let n = maxBound :: Word
          t = T.pack (show n)
      in
      testPM "maxBound ok" (RT.wordDecN (T.length t)) t (Just n)
    , let n = fromIntegral (maxBound :: Word) + 1 :: Integer
          t = T.pack (show n)
      in
      testPM "(maxBound+1) fail" (RT.wordDecN (T.length t)) t Nothing
    , testPM "<29 0, 1 1> ok" (RT.wordDecN 30) (T.replicate 29 "0" <> "1") (Just 1)
    , testProperty "random dec" $ \n ->
        forAll (let d = elements decDigits
                in frequency [(3, vectorOf n d), (1, listOf d)]) $ \s ->
          let ok = n > 0
                && length s == n
                && (read s :: Integer) < fromIntegral (maxBound :: Word)
          in classify ok "ok" $
            RT.reParse (RT.wordDecN n) (T.pack s) ===
            if ok then Just (read s) else Nothing
    , testProperty "random" $ \n ->
        forAll abDecText $ \t ->
          let ex = do
                guard $ n > 0 && T.length t == n
                x <- if T.all (=='0') t
                     then Just 0
                     else parseDecNoLz $ dropWhile (=='0') $ T.unpack t
                guard $ x <= fromIntegral (maxBound :: Word)
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.wordDecN n) t === ex
    ]
  , testGroup "wordHexN"
    [ let n = maxBound :: Word
          t = T.pack (showHex n)
      in
      testPM "maxBound ok" (RT.wordHexN (T.length t)) t (Just n)
    , let n = fromIntegral (maxBound :: Word) + 1 :: Integer
          t = T.pack (showHex n)
      in
      testPM "(maxBound+1) fail" (RT.wordHexN (T.length t)) t Nothing
    , testPM "<29 0, 1 1> ok" (RT.wordHexN 30) (T.replicate 29 "0" <> "1") (Just 1)
    , testProperty "random hex" $ \n ->
        forAll (let d = elements hexDigits
                in frequency [(3, vectorOf n d), (1, listOf d)]) $ \s ->
          let ok = n > 0
                && length s == n
                && (read ("0x" ++ s) :: Integer) < fromIntegral (maxBound :: Word)
          in
          classify ok "ok" $
            RT.reParse (RT.wordHexN n) (T.pack s) ===
            if ok then Just (read ("0x" ++ s)) else Nothing
    , testProperty "random" $ \n ->
        forAll pqHexText $ \t ->
          let ex = do
                guard $ n > 0 && T.length t == n
                x <- if T.all (=='0') t
                     then Just 0
                     else parseHexNoLz $ dropWhile (=='0') $ T.unpack t
                guard $ x <= fromIntegral (maxBound :: Word)
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RT.reParse (RT.wordHexN n) t === ex
    ]
  ]

stringNumericTests :: TestTree
stringNumericTests = testGroup "Text numeric"
  [ testGroup "naturalDec"
    [ testLPM "<empty>, fail" RL.naturalDec "" Nothing
    , testLPM "1a, fail" RL.naturalDec "1a" Nothing
    , testLPM "1a2, fail" RL.naturalDec "1a2" Nothing
    , testLPM "0, ok" RL.naturalDec "0" (Just 0)
    , testLPM "1, ok" RL.naturalDec "1" (Just 1)
    , testLPM "-1, fail" RL.naturalDec "-1" Nothing
    , testLPM "+1, fail" RL.naturalDec "+1" Nothing
    , testLPM "01, fail" RL.naturalDec "01" Nothing
    , testLPM "123456789123456789123456789, ok" RL.naturalDec "123456789123456789123456789" (Just 123456789123456789123456789)
    , testLPM "18446744073709551615, ok" RL.naturalDec "18446744073709551615" (Just 18446744073709551615)
    , testLPM "18446744073709551616, ok" RL.naturalDec "18446744073709551616" (Just 18446744073709551616)
    , testProperty "random dec" $
      forAll decString $ \t ->
        RL.reParse RL.naturalDec t === Just (read t)
    , testProperty "random" $
      forAll abDecString $ \t ->
        let ex = parseDecNoLz t
        in classify (isJust ex) "ok" $
          RL.reParse RL.naturalDec t === ex
    ]
  , testGroup "integerDec"
    [ testLPM "pure (), 1, ok" (RL.integerDec (pure ())) "1" (Just 1)
    , testLPM "pure (), +1, ok" (RL.integerDec (pure ())) "+1" (Just 1)
    , testLPM "pure (), -1, ok" (RL.integerDec (pure ())) "-1" (Just (-1))
    , testLPM "pure (), 001, fail" (RL.integerDec (pure ())) "001" Nothing
    , testLPM "pure (), +001, fail" (RL.integerDec (pure ())) "+001" Nothing
    , testLPM "pure (), -001, fail" (RL.integerDec (pure ())) "-001" Nothing
    , testLPM "lz, 1, ok" (RL.integerDec (many (RL.single '0'))) "1" (Just 1)
    , testLPM "lz, +1, ok" (RL.integerDec (many (RL.single '0'))) "+1" (Just 1)
    , testLPM "lz, -1, ok" (RL.integerDec (many (RL.single '0'))) "-1" (Just (-1))
    , testLPM "lz, 001, ok" (RL.integerDec (many (RL.single '0'))) "001" (Just 1)
    , testLPM "lz, +001, ok" (RL.integerDec (many (RL.single '0'))) "+001" (Just 1)
    , testLPM "lz, -001, ok" (RL.integerDec (many (RL.single '0'))) "-001" (Just (-1))
    , testProperty "random" $
      forAll (liftA2 (<>) (elements ["-","+",""]) abDecString) $ \t ->
        let ex = parseInteger parseDecNoLz t
        in classify (isJust ex) "ok" $
          RL.reParse (RL.integerDec (pure ())) t === ex
    ]
  , testGroup "naturalHex"
    [ testLPM "<empty>, fail" RL.naturalHex "" Nothing
    , testLPM "1g, fail" RL.naturalHex "1g" Nothing
    , testLPM "1g2, fail" RL.naturalHex "1g2" Nothing
    , testLPM "0, ok" RL.naturalHex "0" (Just 0)
    , testLPM "1, ok" RL.naturalHex "1" (Just 1)
    , testLPM "f, ok" RL.naturalHex "f" (Just 15)
    , testLPM "F, ok" RL.naturalHex "F" (Just 15)
    , testLPM "-1, fail" RL.naturalHex "-1" Nothing
    , testLPM "+1, fail" RL.naturalHex "+1" Nothing
    , testLPM "01, fail" RL.naturalHex "01" Nothing
    , testLPM "123456789abcdef123456789abcdef, ok" RL.naturalHex "123456789abcdef123456789abcdef" (Just 0x123456789abcdef123456789abcdef)
    , testLPM "ffffffffffffffff, ok" RL.naturalHex "ffffffffffffffff" (Just 0xffffffffffffffff)
    , testLPM "10000000000000000, ok" RL.naturalHex "10000000000000000" (Just 0x10000000000000000)
    , testProperty "random hex" $
      forAll hexString $ \t ->
        RL.reParse RL.naturalHex t === Just (read ("0x" ++ t))
    , testProperty "random" $
      forAll pqHexString $ \t ->
        let ex = parseHexNoLz t
        in classify (isJust ex) "ok" $
          RL.reParse RL.naturalHex t === ex
    ]
  , testGroup "integerHex"
    [ testLPM "pure (), 1, ok" (RL.integerHex (pure ())) "1" (Just 1)
    , testLPM "pure (), +1, ok" (RL.integerHex (pure ())) "+1" (Just 1)
    , testLPM "pure (), -1, ok" (RL.integerHex (pure ())) "-1" (Just (-1))
    , testLPM "pure (), 001, fail" (RL.integerHex (pure ())) "001" Nothing
    , testLPM "pure (), +001, fail" (RL.integerHex (pure ())) "+001" Nothing
    , testLPM "pure (), -001, fail" (RL.integerHex (pure ())) "-001" Nothing
    , testLPM "lz, 1, ok" (RL.integerHex (many (RL.single '0'))) "1" (Just 1)
    , testLPM "lz, +1, ok" (RL.integerHex (many (RL.single '0'))) "+1" (Just 1)
    , testLPM "lz, -1, ok" (RL.integerHex (many (RL.single '0'))) "-1" (Just (-1))
    , testLPM "lz, 001, ok" (RL.integerHex (many (RL.single '0'))) "001" (Just 1)
    , testLPM "lz, +001, ok" (RL.integerHex (many (RL.single '0'))) "+001" (Just 1)
    , testLPM "lz, -001, ok" (RL.integerHex (many (RL.single '0'))) "-001" (Just (-1))
    , testProperty "random" $
      forAll (liftA2 (<>) (elements ["-","+",""]) pqHexString) $ \t ->
        let ex = parseInteger parseHexNoLz t
        in classify (isJust ex) "ok" $
          RL.reParse (RL.integerHex (pure ())) t === ex
    ]
  , testGroup "wordRangeDec"
    [ testLPM "(0,0) 0 ok" (RL.wordRangeDec (0,0)) "0" (Just 0)
    , testLPM "(0,0) 1 fail" (RL.wordRangeDec (0,0)) "1" Nothing
    , testLPM "(0,0) -1 fail" (RL.wordRangeDec (0,0)) "-1" Nothing
    , testLPM "(1,0) 0 fail" (RL.wordRangeDec (1,0)) "1" Nothing
    , testLPM "(1,0) 1 fail" (RL.wordRangeDec (1,0)) "0" Nothing
    , testLPM "(0,19) 00 fail" (RL.wordRangeDec (0,19)) "00" Nothing
    , testLPM "(100,999) 0 fail" (RL.wordRangeDec (100,999)) "0" Nothing
    , testLPM "(100,999) 1 fail" (RL.wordRangeDec (100,999)) "1" Nothing
    , testLPM "(100,999) 123 ok" (RL.wordRangeDec (100,999)) "123" (Just 123)
    , testLPM "(100,999) 1234 fail" (RL.wordRangeDec (100,999)) "1234" Nothing
    , testLPM "(0,1) 01 fail" (RL.wordRangeDec (0,1)) "01" Nothing
    , testLPM "(0,maxBound) maxBound ok"
             (RL.wordRangeDec (0,maxBound))
             (show (maxBound :: Word))
             (Just maxBound)
    , testLPM "(0,maxBound) (maxBound+1) fail"
             (RL.wordRangeDec (0,maxBound))
             (show (fromIntegral (maxBound :: Word) + 1 :: Integer))
             Nothing
    , testLPM "(maxBound,maxBound) (maxBound-1) fail"
             (RL.wordRangeDec (maxBound,maxBound))
             (show (maxBound - 1 :: Word))
             Nothing
    , testGroup "bias"
      [ let re = RL.wordRangeDec (1,999) in
        testLPM "(1,999) 2222 (222,2)" (liftA2 (,) re re) "2222" (Just (222,2))
      , let re = RL.wordRangeDec (1,1000) in
        testLPM "(1,1000) 1111, (111,1)" (liftA2 (,) re re) "1111" (Just (111,1))
      ]
    , testProperty "any word" $ \(Large n) ->
        RL.reParse (RL.wordRangeDec (minBound,maxBound)) (show n) ===
        Just n
    , testGroup "random dec" $
      let f low high n =
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RL.reParse (RL.wordRangeDec (low,high)) (show n) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll abDecString $ \t ->
          let ex = do
                x <- parseDecNoLz t
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.wordRangeDec (low,high)) t === ex
    ]
  , testGroup "intRangeDec"
    [ testLPM "pure (), (-1,1), 1, ok" (RL.intRangeDec (pure ()) (-1,1)) "1" (Just 1)
    , testLPM "pure (), (-1,1), +1, ok" (RL.intRangeDec (pure ()) (-1,1)) "+1" (Just 1)
    , testLPM "pure (), (-1,1), -1, ok" (RL.intRangeDec (pure ()) (-1,1)) "-1" (Just (-1))
    , testLPM "pure (), (-1,1), 001, fail" (RL.intRangeDec (pure ()) (-1,1)) "001" Nothing
    , testLPM "pure (), (-1,1), +001, fail" (RL.intRangeDec (pure ()) (-1,1)) "+001" Nothing
    , testLPM "pure (), (-1,1), -001, fail" (RL.intRangeDec (pure ()) (-1,1)) "-001" Nothing
    , testLPM "lz, (-1,1), 1, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "1" (Just 1)
    , testLPM "lz, (-1,1), +1, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "+1" (Just 1)
    , testLPM "lz, (-1,1), -1, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "-1" (Just (-1))
    , testLPM "lz, (-1,1), 001, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "001" (Just 1)
    , testLPM "lz, (-1,1), +001, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "+001" (Just 1)
    , testLPM "lz, (-1,1), -001, ok" (RL.intRangeDec (many (RL.single '0')) (-1,1)) "-001" (Just (-1))
    , testLPM "(minBound,maxBound) maxBound ok"
             (RL.intRangeDec (pure ()) (minBound,maxBound))
             (show (maxBound :: Int))
             (Just maxBound)
    , testLPM "(minBound,maxBound) minBound ok"
             (RL.intRangeDec (pure ()) (minBound,maxBound))
             (show (minBound :: Int))
             (Just minBound)
    , testLPM "(minBound,maxBound) (maxBound+1) fail"
             (RL.intRangeDec (pure ()) (minBound,maxBound))
             (show (fromIntegral (maxBound :: Int) + 1 :: Integer))
             Nothing
    , testLPM "(minBound,maxBound) (minBound+1) fail"
             (RL.intRangeDec (pure ()) (minBound,maxBound))
             (show (fromIntegral (minBound :: Int) - 1 :: Integer))
             Nothing
    , testLPM "(maxBound,maxBound) (maxBound-1) fail"
             (RL.intRangeDec (pure ()) (maxBound,maxBound))
             (show (maxBound - 1 :: Int))
             Nothing
    , testLPM "(minBound,minBound) (minBound+1) fail"
             (RL.intRangeDec (pure ()) (minBound,minBound))
             (show (minBound + 1 :: Int))
             Nothing
    , testProperty "any int" $ \(Large n) ->
        RL.reParse (RL.intRangeDec (pure ()) (minBound,maxBound)) (show n) === Just n
    , testGroup "random dec" $
      let f low high n = forAll (showIntDecExtraSign n) $ \nstr ->
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RL.reParse (RL.intRangeDec (pure ()) (low,high)) nstr ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll (liftA2 (<>) (elements ["-","+",""]) abDecString) $ \t ->
          let ex = do
                x <- parseInteger parseDecNoLz t
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.intRangeDec (pure ()) (low,high)) t === ex
    ]
  , testGroup "wordRangeHex"
    [ testLPM "(0,0) 0 ok" (RL.wordRangeHex (0,0)) "0" (Just 0)
    , testLPM "(0,0) 1 fail" (RL.wordRangeHex (0,0)) "1" Nothing
    , testLPM "(0,0) -1 fail" (RL.wordRangeHex (0,0)) "-1" Nothing
    , testLPM "(1,0) 0 fail" (RL.wordRangeHex (1,0)) "1" Nothing
    , testLPM "(1,0) 1 fail" (RL.wordRangeHex (1,0)) "0" Nothing
    , testLPM "(0,1f) 00 fail" (RL.wordRangeHex (0,0x1f)) "00" Nothing
    , testLPM "(100,fff) 0 fail" (RL.wordRangeHex (0x100,0xfff)) "0" Nothing
    , testLPM "(100,fff) 1 fail" (RL.wordRangeHex (0x100,0xfff)) "1" Nothing
    , testLPM "(100,fff) 123 ok" (RL.wordRangeHex (0x100,0xfff)) "123" (Just 0x123)
    , testLPM "(100,fff) 1234 fail" (RL.wordRangeHex (0x100,0xfff)) "1234" Nothing
    , testLPM "(0,1) 01 fail" (RL.wordRangeHex (0,1)) "01" Nothing
    , testLPM "(0,maxBound) maxBound ok"
             (RL.wordRangeHex (0,maxBound))
             (showHex (maxBound :: Word))
             (Just maxBound)
    , testLPM "(0,maxBound) (maxBound+1) fail"
             (RL.wordRangeHex (0,maxBound))
             (showHex (fromIntegral (maxBound :: Word) + 1 :: Integer))
             Nothing
    , testLPM "(maxBound,maxBound) (maxBound-1) fail"
             (RL.wordRangeHex (maxBound,maxBound))
             (showHex (maxBound - 1 :: Word))
             Nothing
    , testGroup "bias"
      [ let re = RL.wordRangeHex (0x1,0x999) in
        testLPM "(1,999) 2222 (222,2)" (liftA2 (,) re re) "2222" (Just (0x222,0x2))
      , let re = RL.wordRangeHex (0x1,0x1000) in
        testLPM "(1,1000) 1111, (111,1)" (liftA2 (,) re re) "1111" (Just (0x111,0x1))
      ]
    , testProperty "any word" $ \(Large n) ->
        RL.reParse (RL.wordRangeHex (minBound,maxBound)) (showHex n) ===
        Just n
    , testGroup "random hex" $
      let f low high n =
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RL.reParse (RL.wordRangeHex (low,high)) (showHex n) ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll pqHexString $ \t ->
          let ex = do
                x <- parseHexNoLz t
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.wordRangeHex (low,high)) t === ex
    ]
  , testGroup "intRangeHex"
    [ testLPM "pure (), (-1,1), 1, ok" (RL.intRangeHex (pure ()) (-1,1)) "1" (Just 1)
    , testLPM "pure (), (-1,1), +1, ok" (RL.intRangeHex (pure ()) (-1,1)) "+1" (Just 1)
    , testLPM "pure (), (-1,1), -1, ok" (RL.intRangeHex (pure ()) (-1,1)) "-1" (Just (-1))
    , testLPM "pure (), (-1,1), 001, fail" (RL.intRangeHex (pure ()) (-1,1)) "001" Nothing
    , testLPM "pure (), (-1,1), +001, fail" (RL.intRangeHex (pure ()) (-1,1)) "+001" Nothing
    , testLPM "pure (), (-1,1), -001, fail" (RL.intRangeHex (pure ()) (-1,1)) "-001" Nothing
    , testLPM "lz, (-1,1), 1, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "1" (Just 1)
    , testLPM "lz, (-1,1), +1, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "+1" (Just 1)
    , testLPM "lz, (-1,1), -1, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "-1" (Just (-1))
    , testLPM "lz, (-1,1), 001, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "001" (Just 1)
    , testLPM "lz, (-1,1), +001, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "+001" (Just 1)
    , testLPM "lz, (-1,1), -001, ok" (RL.intRangeHex (many (RL.single '0')) (-1,1)) "-001" (Just (-1))
    , testLPM "(minBound,maxBound) maxBound ok"
             (RL.intRangeHex (pure ()) (minBound,maxBound))
             (showHex (maxBound :: Int))
             (Just maxBound)
    , testLPM "(minBound,maxBound) minBound ok"
             (RL.intRangeHex (pure ()) (minBound,maxBound))
             (showHex (minBound :: Int))
             (Just minBound)
    , testLPM "(minBound,maxBound) (maxBound+1) fail"
             (RL.intRangeHex (pure ()) (minBound,maxBound))
             (showHex (fromIntegral (maxBound :: Int) + 1 :: Integer))
             Nothing
    , testLPM "(minBound,maxBound) (minBound+1) fail"
             (RL.intRangeHex (pure ()) (minBound,maxBound))
             (showHex (fromIntegral (minBound :: Int) - 1 :: Integer))
             Nothing
    , testLPM "(maxBound,maxBound) (maxBound-1) fail"
             (RL.intRangeHex (pure ()) (maxBound,maxBound))
             (showHex (maxBound - 1 :: Int))
             Nothing
    , testLPM "(minBound,minBound) (minBound+1) fail"
             (RL.intRangeHex (pure ()) (minBound,minBound))
             (showHex (minBound + 1 :: Int))
             Nothing
    , testProperty "any int" $ \(Large n) ->
        RL.reParse (RL.intRangeHex (pure ()) (minBound,maxBound)) (showHex n) === Just n
    , testGroup "random hex" $
      let f low high n = forAll (showIntHexExtraSign n) $ \nstr ->
            let ex = inRange n (low,high) in
            classify ex "inRange" $
              RL.reParse (RL.intRangeHex (pure ()) (low,high)) nstr ===
              if ex then Just n else Nothing
      in
      [ testProperty "small" f
      , testProperty "large" $ \(Large low) (Large high) (Large n) -> f low high n
      ]
    , testProperty "random" $ \low high ->
        forAll (liftA2 (<>) (elements ["-","+",""]) pqHexString) $ \t ->
          let ex = do
                x <- parseInteger parseHexNoLz t
                guard $ fromIntegral low <= x && x <= fromIntegral high
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.intRangeHex (pure ()) (low,high)) t === ex
    ]
  , testGroup "wordDecN"
    [ let n = maxBound :: Word
          t = show n
      in
      testLPM "maxBound ok" (RL.wordDecN (length t)) t (Just n)
    , let n = fromIntegral (maxBound :: Word) + 1 :: Integer
          t = show n
      in
      testLPM "(maxBound+1) fail" (RL.wordDecN (length t)) t Nothing
    , testLPM "<29 0, 1 1> ok" (RL.wordDecN 30) (replicate 29 '0' <> "1") (Just 1)
    , testProperty "random dec" $ \n ->
        forAll (let d = elements decDigits
                in frequency [(3, vectorOf n d), (1, listOf d)]) $ \s ->
          let ok = n > 0
                && length s == n
                && (read s :: Integer) < fromIntegral (maxBound :: Word)
          in classify ok "ok" $
            RL.reParse (RL.wordDecN n) s ===
            if ok then Just (read s) else Nothing
    , testProperty "random" $ \n ->
        forAll abDecString $ \t ->
          let ex = do
                guard $ n > 0 && length t == n
                x <- if all (=='0') t
                     then Just 0
                     else parseDecNoLz $ dropWhile (=='0') t
                guard $ x <= fromIntegral (maxBound :: Word)
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.wordDecN n) t === ex
    ]
  , testGroup "wordHexN"
    [ let n = maxBound :: Word
          t = showHex n
      in
      testLPM "maxBound ok" (RL.wordHexN (length t)) t (Just n)
    , let n = fromIntegral (maxBound :: Word) + 1 :: Integer
          t = showHex n
      in
      testLPM "(maxBound+1) fail" (RL.wordHexN (length t)) t Nothing
    , testLPM "<29 0, 1 1> ok" (RL.wordHexN 30) (replicate 29 '0' <> "1") (Just 1)
    , testProperty "random hex" $ \n ->
        forAll (let d = elements hexDigits
                in frequency [(3, vectorOf n d), (1, listOf d)]) $ \s ->
          let ok = n > 0
                && length s == n
                && (read ("0x" ++ s) :: Integer) < fromIntegral (maxBound :: Word)
          in
          classify ok "ok" $
            RL.reParse (RL.wordHexN n) s ===
            if ok then Just (read ("0x" ++ s)) else Nothing
    , testProperty "random" $ \n ->
        forAll pqHexString $ \t ->
          let ex = do
                guard $ n > 0 && length t == n
                x <- if all (=='0') t
                     then Just 0
                     else parseHexNoLz $ dropWhile (=='0') t
                guard $ x <= fromIntegral (maxBound :: Word)
                pure $ fromIntegral x
          in classify (isJust ex) "ok" $
            RL.reParse (RL.wordHexN n) t === ex
    ]
  ]

decString :: Gen String
decString = do
  s <- listOf (elements decDigits)
  let s' = dropWhile (=='0') s
  pure $ if null s' then "0" else s'

decText :: Gen Text
decText = T.pack <$> decString

hexString :: Gen String
hexString = do
  s <- listOf (elements hexDigits)
  let s' = dropWhile (=='0') s
  pure $ if null s' then "0" else s'

hexText :: Gen Text
hexText = T.pack <$> hexString

decDigits :: String
decDigits = "0123456789"

hexDigits :: String
hexDigits = "0123456789ABCDEFabcdef"

abDecString :: Gen String
abDecString = listOf (elements ("ab" ++ decDigits))

abDecText :: Gen Text
abDecText = T.pack <$> abDecString

pqHexString :: Gen String
pqHexString = listOf (elements ("pq" ++ hexDigits))

pqHexText :: Gen Text
pqHexText = T.pack <$> pqHexString

showHex :: Integral a => a -> String
showHex n = (if n < 0 then ('-':) else id)
            (Num.showHex (abs (fromIntegral n :: Integer)) "")

showIntDecExtraSign :: Int -> Gen String
showIntDecExtraSign n = (<> show n) <$> sgn n
  where
    sgn x = case compare 0 x of
      LT -> elements ["+", ""]
      EQ -> elements ["-", "+", ""]
      GT -> pure ""

showIntHexExtraSign :: Int -> Gen String
showIntHexExtraSign n = (<> showHex n) <$> sgn n
  where
    sgn x = case compare 0 x of
      LT -> elements ["+", ""]
      EQ -> elements ["-", "+", ""]
      GT -> pure ""

parseInteger :: (String -> Maybe Natural) -> String -> Maybe Integer
parseInteger p s = case s of
  '-':s' -> negate . fromIntegral <$> p s'
  '+':s' -> fromIntegral <$> p s'
  _      -> fromIntegral <$> p s

parseDecNoLz :: String -> Maybe Natural
parseDecNoLz s = case s of
  "" -> Nothing
  "0" -> Just 0
  ('0':_) -> Nothing
  _ | (s1,[]) <- span isDigit s -> Just (read s1)
    | otherwise -> Nothing

parseHexNoLz :: String -> Maybe Natural
parseHexNoLz s = case s of
  "" -> Nothing
  "0" -> Just 0
  ('0':_) -> Nothing
  _ | (s1,[]) <- span isHexDigit s -> Just (read ("0x" ++ s1))
    | otherwise -> Nothing

----------------
-- Combinators
----------------

combinatorTests :: TestTree
combinatorTests = testGroup "Combinators"
  [ testGroup "pure"
    [ testPM "pure (), <e>, ok" (pure ()) "" (Just ())
    , testPM "pure (), a, fail" (pure ()) "a" Nothing
    ]
  , testGroup "liftA2" $
    let re = liftA2 (,) (RT.char 'a') (RT.char 'b') in
    [ testPM "a b, <e>, fail" re "" Nothing
    , testPM "a b, a, fail" re "a" Nothing
    , testPM "a b, b, fail" re "b" Nothing
    , testPM "a b, ab, ok" re "ab" (Just ('a','b'))
    ]
  , testGroup "<|>" $
    let ab = RT.char 'a' <|> RT.char 'b' in
    [ testPM "a <|> b, <e>, fail" ab "" Nothing
    , testPM "a <|> b, a, ok" ab "a" (Just 'a')
    , testPM "a <|> b, b, ok" ab "b" (Just 'b')
    , testGroup "bias"
      [ let re = (1 :: Int) <$ RT.char 'a' <|> 2 <$ RT.char 'a' in
        testPM "1 <$ a <|> 2 <$ a, a, ok" re "a" (Just 1)
      ]
    ]
  , testGroup "Semigroup,Monoid" $
    let go abc =
          [ testPM "<e>, fail" abc "" Nothing
          , testPM "a, fail" abc "a" Nothing
          , testPM "bc, fail" abc "bc" Nothing
          , testPM "abc, ok" abc "abc" (Just "abc")
          ]
    in
    [ testGroup "<>" $ go (RT.text "a" <> RT.text "bc")
    , testGroup "<> mempty" $ go (RT.text "abc" <> mempty)
    , testGroup "mempty <>" $ go (mempty <> RT.text "abc")
    , testGroup "sconcat" $ go (sconcat (RT.text "a" :| [RT.text "b", RT.text "c"]))
    , testGroup "mconcat" $ go (mconcat [RT.text "a", RT.text "b", RT.text "c"])
    ]
  , testGroup "many" $
    let a = many (RT.char 'a')
        pr = many (pure ())
    in
    [ testPM "many a, aa, ok" a "aa" (Just "aa")
    , testPM "many a, a, ok" a "a" (Just "a")
    , testPM "many a, <e>, ok" a "" (Just "")
    , testPM "many (pure ()), <e>, ok" pr "" (Just [])
    , testPM "many (pure ()), aaa, fail" pr "aaa" Nothing
    ]
  , testGroup "some" $
    let a = some (RT.char 'a') in
    [ testPM "some a, aa, ok" a "aa" (Just "aa")
    , testPM "some a, a, ok" a "a" (Just "a")
    , testPM "some a, <e>, fail" a "" Nothing
    ]
  , testGroup "manyMin" $
    let a = RT.manyMin (RT.char 'a')
        pr = RT.manyMin (pure ())
    in
    [ testPM "manyMin a, aa, ok" a "aa" (Just "aa")
    , testPM "manyMin a, a, ok" a "a" (Just "a")
    , testPM "manyMin a, <e>, ok" a "" (Just "")
    , testPM "manyMin (pure ()), <e>, ok" pr "" (Just [])
    , testPM "manyMin (pure ()), aaa, fail" pr "aaa" Nothing
    ]
  , testGroup "someMin" $
    let a = RT.someMin (RT.char 'a') in
    [ testPM "someMin a, aa, ok" a "aa" (Just "aa")
    , testPM "someMin a, a, ok" a "a" (Just "a")
    , testPM "someMin a, <e>, fail" a "" Nothing
    ]
  , testGroup "manyr" $
    let a = RT.manyr (RT.char 'a')
        pr = RT.manyr (pure ())
    in
    [ testPM "manyr a, <e>, ok" a "" (Just (RT.Finite ""))
    , testPM "manyr a, aaa, ok" a "aaa" (Just (RT.Finite "aaa"))
    , testPM "manyr (pure ()), <e>, ok" pr "" (Just (RT.Repeat ()))
    , testPM "manyr (pure ()), aaa, fail" pr "aaa" Nothing
    ]
  , testGroup "atLeast"
    [ testProperty "random" $ \m (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.atLeast m (RT.char 'a')) t ===
        if m <= l then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.atLeast 2 RT.anyChar <* RT.manyText) "aaaa" (Just "aaaa")
    ]
  , testGroup "atMost"
    [ testProperty "random" $ \n (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.atMost n (RT.char 'a')) t ===
        if n >= l then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.atMost 2 RT.anyChar <* RT.manyText) "aaaa" (Just "aa")
    ]
  , testGroup "betweenCount"
    [ testProperty "random" $ \mn (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.betweenCount mn (RT.char 'a')) t ===
        if inRange l mn then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.betweenCount (2,3) RT.anyChar <* RT.manyText) "aaaa" (Just "aaa")
    ]
  , testGroup "atLeastMin"
    [ testProperty "random" $ \m (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.atLeastMin m (RT.char 'a')) t ===
        if m <= l then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.atLeastMin 2 RT.anyChar <* RT.manyText) "aaaa" (Just "aa")
    ]
  , testGroup "atMostMin"
    [ testProperty "random" $ \n (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.atMostMin n (RT.char 'a')) t ===
        if n >= l then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.atMostMin 2 RT.anyChar <* RT.manyText) "aaaa" (Just "")
    ]
  , testGroup "betweenCountMin"
    [ testProperty "random" $ \mn (NonNegative l) ->
        let t = T.replicate l "a" in
        RT.reParse (RT.betweenCountMin mn (RT.char 'a')) t ===
        if inRange l mn then Just (T.unpack t) else Nothing
    , testPM "bias" (RT.betweenCountMin (2,3) RT.anyChar <* RT.manyText) "aaaa" (Just "aa")
    ]
  , testGroup "sepBy" $
    let re = RT.char 'A' `RT.sepBy` RT.char 'x' in
    [ testGroup "A `sepBy` x"
      [ testPM "AxAx, fail" re "AxAx" Nothing
      , testPM "AxA, ok" re "AxA" (Just "AA")
      , testPM "Ax, fail" re "Ax" Nothing
      , testPM "A, ok" re "A" (Just "A")
      , testPM "<e>, ok" re "" (Just "")
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "sepBy1" $
    let re = RT.char 'A' `RT.sepBy1` RT.char 'x' in
    [ testGroup "A `sepBy1` x"
      [ testPM "AxAx, fail" re "AxAx" Nothing
      , testPM "AxA, ok" re "AxA" (Just "AA")
      , testPM "Ax, fail" re "Ax" Nothing
      , testPM "A, ok" re "A" (Just "A")
      , testPM "<e>, fail" re "" Nothing
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "endBy" $
    let re = RT.char 'A' `RT.endBy` RT.char 'x' in
    [ testGroup "A `endBy` x"
      [ testPM "AxAx, ok" re "AxAx" (Just "AA")
      , testPM "AxA, fail" re "AxA" Nothing
      , testPM "Ax, ok" re "Ax" (Just "A")
      , testPM "A, fail" re "A" Nothing
      , testPM "<e>, ok" re "" (Just "")
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "endBy1" $
    let re = RT.char 'A' `RT.endBy1` RT.char 'x' in
    [ testGroup "A `endBy1` x"
      [ testPM "AxAx, ok" re "AxAx" (Just "AA")
      , testPM "AxA, fail" re "AxA" Nothing
      , testPM "Ax, ok" re "Ax" (Just "A")
      , testPM "A, fail" re "A" Nothing
      , testPM "<e>, fail" re "" Nothing
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "sepEndBy" $
    let re = RT.char 'A' `RT.sepEndBy` RT.char 'x' in
    [ testGroup "A `sepEndBy` x"
      [ testPM "AxAx, ok" re "AxAx" (Just "AA")
      , testPM "AxA, ok" re "AxA" (Just "AA")
      , testPM "Ax, ok" re "Ax" (Just "A")
      , testPM "A, ok" re "A" (Just "A")
      , testPM "<e>, ok" re "" (Just "")
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "sepEndBy1" $
    let re = RT.char 'A' `RT.sepEndBy1` RT.char 'x' in
    [ testGroup "A `sepEndBy1` x"
      [ testPM "AxAx, ok" re "AxAx" (Just "AA")
      , testPM "AxA, ok" re "AxA" (Just "AA")
      , testPM "Ax, ok" re "Ax" (Just "A")
      , testPM "A, ok" re "A" (Just "A")
      , testPM "<e>, fail" re "" Nothing
      , testPM "x, fail" re "x" Nothing
      ]
    ]
  , testGroup "chainl1" $
    let re = RT.chainl1 (One <$> RT.anyChar)
                        (TwoA <$ RT.char 'F' <|> TwoB <$ RT.char 'T')
    in
    [ testPM "<e>, fail" re "" Nothing
    , testPM "aa, fail" re "aFFa" Nothing
    , testPM "aFFa, fail" re "aFFa" Nothing
    , testProperty "random ok" $ \(x,opxs) ->
        let t = T.pack $ x : (opxs >>= \(op,y) -> [if op then 'T' else 'F', y])
            e = foldl (\acc (op,y) -> (if op then TwoB else TwoA) acc (One y)) (One x) opxs
        in
        RT.reParse re t === Just e
    ]
  , testGroup "chainr1" $
    let re = RT.chainr1 (One <$> RT.anyChar)
                        (TwoA <$ RT.char 'F' <|> TwoB <$ RT.char 'T')
    in
    [ testPM "<e>, fail" re "" Nothing
    , testPM "aa, fail" re "aFFa" Nothing
    , testPM "aFFa, fail" re "aFFa" Nothing
    , testProperty "random ok" $ \(xops,x) ->
        let t = T.pack $ (xops >>= \(y,op) -> [y, if op then 'T' else 'F']) ++ [x]
            e = foldr (\(y,op) acc -> (if op then TwoB else TwoA) (One y) acc) (One x) xops
        in
        RT.reParse re t === Just e
    ]
  , testGroup "many many"
    [ testPM "many (many a)" (many (many (RT.char 'a'))) "" (Just [])
    , testPM "many (many a), aaa" (many (many (RT.char 'a'))) "aaa" (Just ["aaa"])
    , testPM "many (manyr a)" (many (RT.manyr (RT.char 'a'))) "" (Just [])
    , testPM "many (manyr a), aaa" (many (RT.manyr (RT.char 'a'))) "aaa" (Just [RT.Finite "aaa"])
    , testPM "many (manyMin a)" (many (RT.manyMin (RT.char 'a'))) "" (Just [])
    , testPM "many (manyMin a), aaa" (many (RT.manyMin (RT.char 'a'))) "aaa" (Just ["a","a","a"])
    , testPM "manyr (many a)" (RT.manyr (many (RT.char 'a'))) "" (Just (RT.Repeat []))
    , testPM "manyr (many a), aaa" (RT.manyr (many (RT.char 'a'))) "aaa" (Just (RT.Finite ["aaa"]))
    , testPM "manyr (manyr a)" (RT.manyr (RT.manyr (RT.char 'a'))) "" (Just (RT.Repeat (RT.Finite "")))
    , testPM "manyr (manyr a), aaa" (RT.manyr (RT.manyr (RT.char 'a'))) "aaa" (Just (RT.Finite [RT.Finite "aaa"]))
    , testPM "manyr (manyMin a)" (RT.manyr (RT.manyMin (RT.char 'a'))) "" (Just (RT.Repeat []))
    , testPM "manyr (manyMin a), aaa" (RT.manyr (RT.manyMin (RT.char 'a'))) "aaa" (Just (RT.Finite ["a","a","a"]))
    , testPM "manyMin (many a)" (RT.manyMin (many (RT.char 'a'))) "" (Just [])
    , testPM "manyMin (many a), aaa" (RT.manyMin (many (RT.char 'a'))) "aaa" (Just ["aaa"])
    , testPM "manyMin (manyr a)" (RT.manyMin (RT.manyr (RT.char 'a'))) "" (Just [])
    , testPM "manyMin (manyr a), aaa" (RT.manyMin (RT.manyr (RT.char 'a'))) "aaa" (Just [RT.Finite "aaa"])
    , testPM "manyMin (manyMin a)" (RT.manyMin (RT.manyMin (RT.char 'a'))) "" (Just [])
    , testPM "manyMin (manyMin a), aaa" (RT.manyMin (RT.manyMin (RT.char 'a'))) "aaa" (Just ["a","a","a"])
    ]
  , testGroup "toMatch"
    [ testPM "many (a *> (b <|> c)) abacac"
             (RT.toMatch $ many (RT.char 'a' *> (RT.char 'b' <|> RT.char 'c')))
             "abacac"
             (Just "abacac")
    ]
  , testGroup "withMatch"
    [ testPM "many (a *> (b <|> c)) abacac"
             (RT.withMatch $ many (RT.char 'a' *> (RT.char 'b' <|> RT.char 'c')))
             "abacac"
             (Just ("abacac", "bcc"))
    ]
  ]
-- TODO: Would be good to have more tests for toMatch and withMatch

listCombinatorTests :: TestTree
listCombinatorTests = testGroup "List combinators"
  [ testGroup "toMatch"
    [ testLPM "many (a *> (b <|> c)) abacac"
              (RL.toMatch $ many (RL.single 'a' *> (RL.single 'b' <|> RL.single 'c')))
              "abacac"
              (Just "abacac")
    ]
  , testGroup "withMatch"
    [ testLPM "many (a *> (b <|> c)) abacac"
              (RL.withMatch $ many (RL.single 'a' *> (RL.single 'b' <|> RL.single 'c')))
              "abacac"
              (Just ("abacac", "bcc"))
    ]
  ]

-- | Test parse and match
testPM :: (Eq a, Show a) => String -> RT.REText a -> T.Text -> Maybe a -> TestTree
testPM name re t res = testGroup name
  [ testCase "parse" $ RT.parse (RT.compile re) t @?= res
  , testCase "test" $ RT.parse (RT.compile (void re)) t @?= void res
  ]

-- | Test parse and match
testLPM :: (Eq a, Show a) => String -> RL.RE c a -> [c] -> Maybe a -> TestTree
testLPM name re t res = testGroup name
  [ testCase "parse" $ RL.parse (RL.compile re) t @?= res
  , testCase "test" $ RL.parse (RL.compile (void re)) t @?= void res
  ]

zeroOneString :: Gen String
zeroOneString = listOf (elements "01")

zeroOneText :: Gen Text
zeroOneText = T.pack <$> zeroOneString

------------
-- Compile
------------

compileTests :: TestTree
compileTests = testGroup "Compile tests"
  [ testGroup "compileBounded"
    [ testCase "mixRE 15" $
      assertBool "isJust" $ isJust (R.compileBounded 15 mixRE)
    , testCase "mixRE 14" $
      assertBool "isNothing" $ isNothing (R.compileBounded 14 mixRE)
    ]
  ]
-- the exact size may change in the future, just test that there is _some_
-- threshold

mixRE :: R.RE c ()
mixRE =
  (() <$) .
  R.manyr .
  many .
  (\r -> liftA2 (\_ _ -> ()) r r) .
  (\r -> r <|> r) .
  fmap (const ()) $
  R.token (const (Just ()))

--------------------
-- Operations
--------------------

textOpTests :: TestTree
textOpTests = testGroup "Text operations"
  [ testGroup "find"
    [ testCase "abc abc ok" $ RT.find (RT.text "abc") "abc" @?= Just "abc"
    , testCase "abc abcd ok" $ RT.find (RT.text "abc") "abcd" @?= Just "abc"
    , testCase "bcd abcd ok" $ RT.find (RT.text "bcd") "abcd" @?= Just "bcd"
    , testCase "bcd abcde ok" $ RT.find (RT.text "bcd") "abcde" @?= Just "bcd"
    , testCase "abc abcabc ok" $ RT.find (RT.text "abc") "abcabc" @?= Just "abc"
    , testCase "aba ababababa ok" $ RT.find (RT.text "aba") "ababababa" @?= Just "aba"
    , testCase "abc ab fail" $ RT.find (RT.text "abc") "ab" @?= Nothing
    ]
  , testGroup "findAll"
    [ testCase "abc abc 1" $ RT.findAll (RT.text "abc") "abc" @?= ["abc"]
    , testCase "abc abcd 1" $ RT.findAll (RT.text "abc") "abcd" @?= ["abc"]
    , testCase "bcd abcd 1" $ RT.findAll (RT.text "bcd") "abcd" @?= ["bcd"]
    , testCase "bcd abcde 1" $ RT.findAll (RT.text "bcd") "abcde" @?= ["bcd"]
    , testCase "abc abcabc 2" $ RT.findAll (RT.text "abc") "abcabc" @?= ["abc","abc"]
    , testCase "aba ababababa 2" $ RT.findAll (RT.text "aba") "ababababa" @?= ["aba","aba"]
    , testCase "abc ab 0" $ RT.findAll (RT.text "abc") "ab" @?= []
    ]
  , testGroup "splitOn"
    [ testCase "abc abc" $ RT.splitOn (RT.text "abc") "abc" @?= ["",""]
    , testCase "abc abcd" $ RT.splitOn (RT.text "abc") "abcd" @?= ["","d"]
    , testCase "bcd abcd" $ RT.splitOn (RT.text "bcd") "abcd" @?= ["a",""]
    , testCase "bcd abcde" $ RT.splitOn (RT.text "bcd") "abcde" @?= ["a","e"]
    , testCase "abc abcabc" $ RT.splitOn (RT.text "abc") "abcabc" @?= ["","",""]
    , testCase "aba ababababa" $ RT.splitOn (RT.text "aba") "ababababa" @?= ["","b","ba"]
    , testCase "abc ab" $ RT.splitOn (RT.text "abc") "ab" @?= ["ab"]
    ]
  , testGroup "replace"
    [ testCase "abc xyz abc" $ RT.replace ("xyz" <$ RT.text "abc") "abc" @?= Just "xyz"
    , testCase "abc xyz abcd" $ RT.replace ("xyz" <$ RT.text "abc") "abcd" @?= Just "xyzd"
    , testCase "bcd xyz abcd" $ RT.replace ("xyz" <$ RT.text "bcd") "abcd" @?= Just "axyz"
    , testCase "bcd xyz abcde" $ RT.replace ("xyz" <$ RT.text "bcd") "abcde" @?= Just "axyze"
    , testCase "abc xyz abcabc" $ RT.replace ("xyz" <$ RT.text "abc") "abcabc" @?= Just "xyzabc"
    , testCase "aba xyz ababababa" $ RT.replace ("xyz" <$ RT.text "aba") "ababababa" @?= Just "xyzbababa"
    , testCase "abc xyz ab" $ RT.replace ("xyz" <$ RT.text "abc") "ab" @?= Nothing
    ]
  , testGroup "replaceAll"
    [ testCase "abc xyz abc" $ RT.replaceAll ("xyz" <$ RT.text "abc") "abc" @?= "xyz"
    , testCase "abc xyz abcd" $ RT.replaceAll ("xyz" <$ RT.text "abc") "abcd" @?= "xyzd"
    , testCase "bcd xyz abcd" $ RT.replaceAll ("xyz" <$ RT.text "bcd") "abcd" @?= "axyz"
    , testCase "bcd xyz abcde" $ RT.replaceAll ("xyz" <$ RT.text "bcd") "abcde" @?= "axyze"
    , testCase "abc xyz abcabc" $ RT.replaceAll ("xyz" <$ RT.text "abc") "abcabc" @?= "xyzxyz"
    , testCase "aba xyz ababababa" $ RT.replaceAll ("xyz" <$ RT.text "aba") "ababababa" @?= "xyzbxyzba"
    , testCase "abc xyz ab" $ RT.replaceAll ("xyz" <$ RT.text "abc") "ab" @?= "ab"
    ]
  ]

stringOpTests :: TestTree
stringOpTests = testGroup "String operations"
  [ testGroup "find"
    [ testCase "abc abc ok" $ RL.find (RL.list "abc") "abc" @?= Just "abc"
    , testCase "abc abcd ok" $ RL.find (RL.list "abc") "abcd" @?= Just "abc"
    , testCase "bcd abcd ok" $ RL.find (RL.list "bcd") "abcd" @?= Just "bcd"
    , testCase "bcd abcde ok" $ RL.find (RL.list "bcd") "abcde" @?= Just "bcd"
    , testCase "abc abcabc ok" $ RL.find (RL.list "abc") "abcabc" @?= Just "abc"
    , testCase "aba ababababa ok" $ RL.find (RL.list "aba") "ababababa" @?= Just "aba"
    , testCase "abc ab fail" $ RL.find (RL.list "abc") "ab" @?= Nothing
    ]
  , testGroup "findAll"
    [ testCase "abc abc 1" $ RL.findAll (RL.list "abc") "abc" @?= ["abc"]
    , testCase "abc abcd 1" $ RL.findAll (RL.list "abc") "abcd" @?= ["abc"]
    , testCase "bcd abcd 1" $ RL.findAll (RL.list "bcd") "abcd" @?= ["bcd"]
    , testCase "bcd abcde 1" $ RL.findAll (RL.list "bcd") "abcde" @?= ["bcd"]
    , testCase "abc abcabc 2" $ RL.findAll (RL.list "abc") "abcabc" @?= ["abc","abc"]
    , testCase "aba ababababa 2" $ RL.findAll (RL.list "aba") "ababababa" @?= ["aba","aba"]
    , testCase "abc ab 0" $ RL.findAll (RL.list "abc") "ab" @?= []
    ]
  , testGroup "splitOn"
    [ testCase "abc abc" $ RL.splitOn (RL.list "abc") "abc" @?= ["",""]
    , testCase "abc abcd" $ RL.splitOn (RL.list "abc") "abcd" @?= ["","d"]
    , testCase "bcd abcd" $ RL.splitOn (RL.list "bcd") "abcd" @?= ["a",""]
    , testCase "bcd abcde" $ RL.splitOn (RL.list "bcd") "abcde" @?= ["a","e"]
    , testCase "abc abcabc" $ RL.splitOn (RL.list "abc") "abcabc" @?= ["","",""]
    , testCase "aba ababababa" $ RL.splitOn (RL.list "aba") "ababababa" @?= ["","b","ba"]
    , testCase "abc ab" $ RL.splitOn (RL.list "abc") "ab" @?= ["ab"]
    ]
  , testGroup "replace"
    [ testCase "abc xyz abc" $ RL.replace ("xyz" <$ RL.list "abc") "abc" @?= Just "xyz"
    , testCase "abc xyz abcd" $ RL.replace ("xyz" <$ RL.list "abc") "abcd" @?= Just "xyzd"
    , testCase "bcd xyz abcd" $ RL.replace ("xyz" <$ RL.list "bcd") "abcd" @?= Just "axyz"
    , testCase "bcd xyz abcde" $ RL.replace ("xyz" <$ RL.list "bcd") "abcde" @?= Just "axyze"
    , testCase "abc xyz abcabc" $ RL.replace ("xyz" <$ RL.list "abc") "abcabc" @?= Just "xyzabc"
    , testCase "aba xyz ababababa" $ RL.replace ("xyz" <$ RL.list "aba") "ababababa" @?= Just "xyzbababa"
    , testCase "abc xyz ab" $ RL.replace ("xyz" <$ RL.list "abc") "ab" @?= Nothing
    ]
  , testGroup "replaceAll"
    [ testCase "abc xyz abc" $ RL.replaceAll ("xyz" <$ RL.list "abc") "abc" @?= "xyz"
    , testCase "abc xyz abcd" $ RL.replaceAll ("xyz" <$ RL.list "abc") "abcd" @?= "xyzd"
    , testCase "bcd xyz abcd" $ RL.replaceAll ("xyz" <$ RL.list "bcd") "abcd" @?= "axyz"
    , testCase "bcd xyz abcde" $ RL.replaceAll ("xyz" <$ RL.list "bcd") "abcde" @?= "axyze"
    , testCase "abc xyz abcabc" $ RL.replaceAll ("xyz" <$ RL.list "abc") "abcabc" @?= "xyzxyz"
    , testCase "aba xyz ababababa" $ RL.replaceAll ("xyz" <$ RL.list "aba") "ababababa" @?= "xyzbxyzba"
    , testCase "abc xyz ab" $ RL.replaceAll ("xyz" <$ RL.list "abc") "ab" @?= "ab"
    ]
  ]

---------
-- Many
---------

manyTests :: TestTree
manyTests = testGroup "Many" $ map testLaws
  [ eqLaws (Proxy :: Proxy (RT.Many A))
  , ordLaws (Proxy :: Proxy (RT.Many OrdA))
  , functorLaws (Proxy :: Proxy RT.Many)
  ]
-- Cannot use foldableLaws because it cannot handle infinite structures.

------------
-- CharSet
------------

charSetTests :: TestTree
charSetTests = localOption (QuickCheckTests 1000) $ testGroup "CharSet"
  [ testGroup "Laws" $ map testLaws $
    let p = Proxy :: Proxy CS.CharSet in
    [ eqLaws p
    , semigroupLaws p
    , commutativeSemigroupLaws p
    , idempotentSemigroupLaws p
    , monoidLaws p
    ]
  , testGroup "fromList"
    [ testProperty "valid" $ \s -> validCS (CS.fromList s)
    , testProperty "member" $ \s c -> elem c s === CS.member c (CS.fromList s)
    ]
  , testGroup "insert"
    [ testProperty "valid" $ \c cs -> validCS (CS.insert c cs)
    , testProperty "member" $ \c cs -> CS.member c (CS.insert c cs)
    ]
  , testGroup "insertRange"
    [ testProperty "valid" $ \g cs -> validCS (CS.insertRange g cs)
    , testProperty "member" $
      \g cs c ->
        (CS.member c cs || inRange c g) == CS.member c (CS.insertRange g cs)
    ]
  , testGroup "delete"
    [ testProperty "valid" $ \c cs -> validCS (CS.delete c cs)
    , testProperty "member" $ \c cs -> not (CS.member c (CS.delete c cs))
    ]
  , testGroup "deleteRange"
    [ testProperty "valid" $ \g cs -> validCS (CS.deleteRange g cs)
    , testProperty "member" $
      \g cs c ->
        (CS.member c cs && not (inRange c g))
        == CS.member c (CS.deleteRange g cs)
    ]
  , testGroup "map"
    [ testProperty "valid" $ \cs (Fn f) -> validCS (CS.map f cs)
    , testProperty "member c . map f = elem c . map f . elems" $
      \cs c (Fn f) -> CS.member c (CS.map f cs) === elem c (map f (CS.elems cs))
    ]
  , testGroup "not"
    [ testProperty "valid" $ \cs -> validCS (CS.not cs)
    , testProperty "member" $
      \cs c -> CS.member c cs === CS.notMember c (CS.not cs)
    , testProperty "not . not = id" $ \cs -> CS.not (CS.not cs) === cs
    ]
  , testGroup "union"
    [ testProperty "valid" $ \lcs rcs -> validCS (CS.union lcs rcs)
    , testProperty "member" $
      \lcs rcs c ->
        (CS.member c lcs || CS.member c rcs) === CS.member c (CS.union lcs rcs)
    ]
  , testGroup "difference"
    [ testProperty "valid" $ \lcs rcs -> validCS (CS.difference lcs rcs)
    , testProperty "member" $
      \lcs rcs c ->
        (CS.member c lcs && CS.notMember c rcs)
        === CS.member c (CS.difference lcs rcs)
    ]
  , testGroup "intersection"
    [ testProperty "valid" $ \lcs rcs -> validCS (CS.intersection lcs rcs)
    , testProperty "member" $
      \lcs rcs c ->
        (CS.member c lcs && CS.member c rcs)
        === CS.member c (CS.intersection lcs rcs)
    ]
  , testProperty "fromString" $ \s -> fromString s === CS.fromList s
  , testProperty "<>" $ \lcs rcs -> lcs <> rcs === CS.union lcs rcs
  , testProperty "singleton" $ \c -> CS.singleton c === CS.fromList [c]
  , testProperty "fromRange" $ \cl cr c ->
      CS.member c (CS.fromRange (cl,cr)) === inRange c (cl,cr)
  , testProperty "ranges" $ \cs c ->
      CS.member c cs === any (inRange c) (CS.ranges cs)
  ]

validCS :: CS.CharSet -> Property
validCS cs = counterexample (show cs) $ CS.valid cs

-----------------
-- Common utils
-----------------

data T = TA | TB | TC deriving Show

instance Arbitrary T where
  arbitrary = elements [TA,TB,TC]

data Chain a
  = One a
  | TwoA (Chain a) (Chain a)
  | TwoB (Chain a) (Chain a)
  deriving (Eq, Show)

inRange :: Ord a => a -> (a, a) -> Bool
inRange x (l,h) = l <= x && x <= h

testLaws :: Laws -> TestTree
testLaws (Laws class_ tests) =
  testGroup class_ (map (uncurry testProperty) tests)

instance Arbitrary a => Arbitrary (RT.Many a) where
  arbitrary = frequency [ (1, RT.Repeat <$> arbitrary)
                        , (3, RT.Finite <$> arbitrary)
                        ]

instance Arbitrary CS.CharSet where
  arbitrary = CS.fromList <$> arbitrary
  shrink = map CS.fromList . shrink . CS.elems

instance Arbitrary Text where
  arbitrary = T.pack <$> arbitrary
  -- Arbitrary Char generates valid Unicode (perhaps it shouldn't) so this
  -- is fine.

  shrink = map T.pack . shrink . T.unpack

-- Available in Data.List in base >= 4.19
unsnoc :: [a] -> Maybe ([a], a)
unsnoc = foldr (\x -> Just . maybe ([], x) (\(~(a, b)) -> (x : a, b))) Nothing