module Main (main) where

import Control.Exception (displayException)
import Data.Foldable (for_)
import Data.Word (Word8, Word32, Word64)
import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
import Test.Hspec (Spec, hspec, describe)
import Test.Hspec.QuickCheck
import Test.QuickCheck
       (arbitrary, forAll, elements, Property, property, listOf,
        vectorOf, Gen)
import Test.QuickCheck.Monadic (monadicIO, assert, run)

import Prelude hiding (sequence)

import qualified Control.Monad.Fail as Fail
import qualified Data.List as List
import qualified Prelude
import qualified Streamly.Internal.Data.Array as A
import qualified Streamly.Internal.Data.Fold as FL
import qualified Streamly.Internal.Data.Parser as P
import qualified Streamly.Internal.Data.Stream as S
import qualified Test.Hspec as H

#if MIN_VERSION_QuickCheck(2,14,0)

import Test.QuickCheck (chooseAny)
import Control.Monad.Identity (Identity(runIdentity, Identity))
import Streamly.Internal.Data.Parser.ParserD (ParseError(..))

#else

import System.Random (Random(random))
import Test.QuickCheck.Gen (Gen(MkGen))

-- | Generates a random element over the natural range of `a`.
chooseAny :: Random a => Gen a
chooseAny = MkGen (\r _ -> let (x,_) = random r in x)

#endif

maxTestCount :: Int
maxTestCount = 100

min_value :: Int
min_value = 0

mid_value :: Int
mid_value = 5000

max_value :: Int
max_value = 10000

max_length :: Int
max_length = 1000

-- Accumulator Tests

fromFold :: Property
fromFold =
    forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->
        monadicIO $ do
        s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls)
        o2 <- S.fold FL.sum (S.fromList ls)
        return $
            case s1 of
                Right o1 -> o1 == o2
                Left _ -> False

fromPure :: Property
fromPure =
    forAll (chooseInt (min_value, max_value)) $ \x ->
        case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of
            Right r -> r == x
            Left _ -> False

fromEffect :: Property
fromEffect =
    forAll (chooseInt (min_value, max_value)) $ \x ->
        case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of
            Right r -> r == x
            Left _ -> False

die :: Property
die =
    property $
    case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of
        Right _ -> False
        Left _ -> True

dieM :: Property
dieM =
    property $
    case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of
        Right _ -> False
        Left _ -> True

parserFail :: Property
parserFail =
    property $
        case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of
            Right _ -> False
            Left (ParseError e) -> err == e
    where
    err = "Testing MonadFail.fail."

-- Element Parser Tests

peekPass :: Property
peekPass =
    forAll (chooseInt (1, max_length)) $ \list_length ->
        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
            case runIdentity $ S.parse P.peek (S.fromList ls) of
                Right head_value -> case ls of
                    head_ls : _ -> head_value == head_ls
                    _ -> False
                Left _ -> False

peekFail :: Property
peekFail =
    property (case runIdentity $ S.parse P.peek (S.fromList []) of
        Right _ -> False
        Left _ -> True)

eofPass :: Property
eofPass =
    property (case runIdentity $ S.parse P.eof (S.fromList []) of
        Right _ -> True
        Left _ -> False)

eofFail :: Property
eofFail =
    forAll (chooseInt (1, max_length)) $ \list_length ->
        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
            case runIdentity $ S.parse P.eof (S.fromList ls) of
                Right _ -> False
                Left _ -> True

satisfyPass :: Property
satisfyPass =
    forAll (chooseInt (mid_value, max_value)) $ \first_element ->
        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->
            let
                ls = first_element : ls_tail
                predicate = (>= mid_value)
            in
                case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
                    Right r -> r == first_element
                    Left _ -> False

satisfy :: Property
satisfy =
    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
        case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of
            Right r -> case ls of
                [] -> False
                (x : _) -> predicate x && (r == x)
            Left _ -> case ls of
                [] -> True
                (x : _) -> not $ predicate x
        where
            predicate = (>= mid_value)

onePass :: Property
onePass =
    forAll (chooseInt (1, max_value)) $ \int ->
        property (case runIdentity $ S.parse P.one (S.fromList [int]) of
            Right i -> i  == int
            Left _ -> False)

one :: Property
one =
    property $
        case runIdentity $ S.parse P.one (S.fromList []) of
            Left _ -> True
            Right _ -> False

-- Sequence Parsers Tests
takeBetweenPass :: Property
takeBetweenPass =
    forAll (chooseInt (min_value, max_value)) $ \m ->
        forAll (chooseInt (m, max_value)) $ \n ->
            forAll (chooseInt (m, max_value)) $ \list_length ->
                forAll (vectorOf list_length (chooseInt (min_value, max_value)))
                    $ \ls ->
                        case runIdentity $ S.parse (P.takeBetween m n FL.toList)
                                (S.fromList ls) of
                            Right parsed_list ->
                                let lpl = Prelude.length parsed_list
                                in checkListEqual parsed_list
                                    $ Prelude.take lpl ls
                            Left _ -> property False

takeBetween :: Property
takeBetween =
    forAll (chooseInt (min_value, max_value)) $ \m ->
        forAll (chooseInt (min_value, max_value)) $ \n ->
            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
                go m n ls

    where

    go m n ls =
        let inputLen = Prelude.length ls
         in do
            let p = P.takeBetween m n FL.toList
            case runIdentity $ S.parse p (S.fromList ls) of
                Right xs ->
                    let parsedLen = Prelude.length xs
                    in if inputLen >= m && parsedLen >= m && parsedLen <= n
                        then checkListEqual xs $ Prelude.take parsedLen ls
                        else property False
                Left _ ->
                    property ((m >= 0 && n >= 0 && m > n) || inputLen < m)


takeEQPass :: Property
takeEQPass =
    forAll (chooseInt (min_value, max_value)) $ \n ->
        forAll (chooseInt (n, max_value)) $ \list_length ->
            forAll (vectorOf list_length
                        (chooseInt (min_value, max_value))) $ \ls ->
                case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
                    Right parsed_list ->
                        checkListEqual parsed_list (Prelude.take n ls)
                    Left _ -> property False

takeEQ :: Property
takeEQ =
    forAll (chooseInt (min_value, max_value)) $ \n ->
        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
            let
                list_length = Prelude.length ls
            in
                case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
                    Right parsed_list ->
                        if n <= list_length
                        then checkListEqual parsed_list (Prelude.take n ls)
                        else property False
                    Left _ -> property (n > list_length)

takeGEPass :: Property
takeGEPass =
    forAll (chooseInt (min_value, max_value)) $ \n ->
        forAll (chooseInt (n, max_value)) $ \list_length ->
            forAll (vectorOf list_length (chooseInt (min_value, max_value)))
                $ \ls ->
                    case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
                        Right parsed_list -> checkListEqual parsed_list ls
                        Left _ -> property False

takeGE :: Property
takeGE =
    forAll (chooseInt (min_value, max_value)) $ \n ->
        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
            let
                list_length = Prelude.length ls
            in
                case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of
                    Right parsed_list ->
                        if n <= list_length
                        then checkListEqual parsed_list ls
                        else property False
                    Left _ -> property (n > list_length)


nLessThanEqual0 ::
       (  Int
       -> FL.Fold Identity Int [Int]
       -> P.Parser Int Identity [Int]
       )
    -> (Int -> [Int] -> [Int])
    -> Property
nLessThanEqual0 tk ltk =
    forAll (elements [0, (-1)]) $ \n ->
        forAll (listOf arbitrary) $ \ls ->
            case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of
                Right parsed_list -> checkListEqual parsed_list (ltk n ls)
                Left _ -> property False

takeProperties :: Spec
takeProperties =
    describe "take combinators when n <= 0/" $ do
        prop "takeEQ n FL.toList = []" $
            nLessThanEqual0 P.takeEQ (\_ -> const [])
        prop "takeGE n FL.toList xs = xs" $
            nLessThanEqual0 P.takeGE (\_ -> id)

-- lookAheadPass :: Property
-- lookAheadPass =
--     forAll (chooseInt (min_value + 1, max_value)) $ \n ->
--         let
--             takeWithoutConsume = P.lookAhead $ P.take n FL.toList
--             parseTwice = do
--                 parsed_list_1 <- takeWithoutConsume
--                 parsed_list_2 <- takeWithoutConsume
--                 return (parsed_list_1, parsed_list_2)
--         in
--             forAll (chooseInt (n, max_value)) $ \list_length ->
--                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
--                     case S.parse parseTwice (S.fromList ls) of
--                         Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
--                         Left _ -> property $ False

-- lookAheadFail :: Property
-- lookAheadFail =
--     forAll (chooseInt (min_value + 1, max_value)) $ \n ->
--         let
--             takeWithoutConsume = P.lookAhead $ P.take n FL.toList
--             parseTwice = do
--                 parsed_list_1 <- takeWithoutConsume
--                 parsed_list_2 <- takeWithoutConsume
--                 return (parsed_list_1, parsed_list_2)
--         in
--             forAll (chooseInt (min_value, n - 1)) $ \list_length ->
--                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
--                     case S.parse parseTwice (S.fromList ls) of
--                         Right _ -> False
--                         Left _ -> True

-- lookAhead :: Property
-- lookAhead =
--     forAll (chooseInt (min_value, max_value)) $ \n ->
--         let
--             takeWithoutConsume = P.lookAhead $ P.take n FL.toList
--             parseTwice = do
--                 parsed_list_1 <- takeWithoutConsume
--                 parsed_list_2 <- takeWithoutConsume
--                 return (parsed_list_1, parsed_list_2)
--         in
--             forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
--                 case S.parse parseTwice (S.fromList ls) of
--                     Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
--                     Left _ -> property ((list_length < n) || (list_length == n && n == 0))
--                         where
--                             list_length = Prelude.length ls

takeEndBy_ :: Property
takeEndBy_ =
    forAll (listOf (chooseInt (min_value, max_value )))  $ \ls ->
        case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of
            Right parsed_list ->
                checkListEqual parsed_list (tkwhl ls)
            Left _ -> property False
        where
            predicate = (>= 100)
            prsr = P.many (P.satisfy (const True)) FL.toList
            tkwhl ls = Prelude.takeWhile (not . predicate) ls

takeStartBy :: Property
takeStartBy =
    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
        let ls1 = 1:ls
        in
            case runIdentity $ S.parse parser (S.fromList ls1) of
                Right parsed_list ->
                  if not $ Prelude.null ls1
                  then
                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)
                    in checkListEqual parsed_list $
                      if predicate (head ls1)
                      then head ls1 : tls
                      else Prelude.takeWhile (not . predicate) ls1
                  else property $ Prelude.null parsed_list
                Left _ -> property False
            where
                predicate = odd
                parser = P.takeStartBy predicate FL.toList

takeWhile :: Property
takeWhile =
    forAll (listOf (chooseInt (0, 1))) $ \ ls ->
        case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
            Right parsed_list ->
                checkListEqual parsed_list (Prelude.takeWhile predicate ls)
            Left _ -> property False
        where
            predicate = (== 0)

takeP :: Property
takeP =
    forAll
        ((,) <$> chooseInt (min_value, max_value)
             <*> listOf (chooseInt (0, 1)))
        $ \(takeNum, ls) ->
              case runIdentity $ S.parse
                       (P.takeP takeNum (P.fromFold FL.toList))
                       (S.fromList ls) of
                  Right parsed_list ->
                      checkListEqual parsed_list (Prelude.take takeNum ls)
                  Left _ -> property False

takeWhile1 :: Property
takeWhile1 =
    forAll (listOf (chooseInt (0, 1))) $ \ ls ->
        case runIdentity $ S.parse (P.takeWhile1 predicate  FL.toList) (S.fromList ls) of
            Right parsed_list -> case ls of
                [] -> property False
                (x : _) ->
                    if predicate x
                    then
                        checkListEqual parsed_list
                           $ Prelude.takeWhile predicate ls
                    else
                        property False
            Left _ -> case ls of
                [] -> property True
                (x : _) -> property (not $ predicate x)
        where
            predicate = (== 0)

takeWhileP :: Property
takeWhileP =
    forAll (listOf (chooseInt (0, 1))) $ \ls ->
        forAll (chooseInt (min_value, max_value)) $ \n ->
            let
                predicate = (== 1)

                prsr =
                    P.takeWhileP predicate
                        $ P.fromFold (FL.take n FL.toList)

                takeWhileTillLen maxLen prd list =
                    Prelude.take maxLen $ Prelude.takeWhile prd list
            in
                case runIdentity $ S.parse prsr (S.fromList ls) of
                    Right parsed_list ->
                        checkListEqual
                        parsed_list
                        (takeWhileTillLen n predicate ls)
                    Left _ -> property False

{-
choice :: Property
choice =
    forAll
        ((,,) <$> chooseInt (min_value, max_value)
             <*> chooseInt (min_value, max_value)
             <*> listOf (chooseInt (0, 1)))
        $ \(i, j, ls) ->
              case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of
                  Right parsed_list ->
                      checkListEqual parsed_list $ take (min i j) ls
                  Left _ -> property False

    where

    parser i = P.fromFold (FL.take i FL.toList)
-}

groupBy :: Property
groupBy =
    forAll (listOf (chooseInt (0, 1)))
        $ \ls ->
              case runIdentity $ S.parse parser (S.fromList ls) of
                  Right parsed -> checkListEqual parsed (groupByLF ls)
                  Left _ -> property False

    where

    cmp = (==)
    parser = P.groupBy cmp FL.toList
    groupByLF lst
        | null lst = []
        | otherwise = head $ List.groupBy cmp lst

wordBy :: Property
wordBy =
    forAll (listOf (elements [' ', 's']))
        $ \ls ->
              case runIdentity $ S.parse parser (S.fromList ls) of
                  Right parsed -> checkListEqual parsed (words' ls)
                  Left _ -> property False

    where

    predicate = (== ' ')
    parser = P.many (P.wordBy predicate FL.toList) FL.toList
    words' lst =
        let wrds = words lst
         in if wrds == [] && length lst > 0 then [""] else wrds

parseManyWordQuotedBy :: H.SpecWith ()
parseManyWordQuotedBy =
    describe "parseMany wordQuotedBy"
        $ for_ testCases
        $ \c@(kQ, isQ, input, expected) -> do
              let inpStrm = S.fromList input

                  esc = '\\'

                  spc ' ' = True
                  spc _ = False

                  tr _ _ = Nothing

                  parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList
              result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm
              H.it (showCase c) $ result `H.shouldBe` expected

    where

    showCase (kQ, _, input, expected) =
        show kQ ++ ", " ++ input ++ " -> " ++ show expected

    testCases =
        [ ( True
          , \x -> if x == '\'' then Just '\'' else Nothing
          , "The quick brown fox"
          , ["The", "quick", "brown", "fox"])
        , ( True
          , \x -> if x == '\'' then Just '\'' else Nothing
          , "The' quick brown' fox"
          , ["The' quick brown'", "fox"])
        , ( False
          , \x -> if x == '\'' then Just '\'' else Nothing
          , "The' quick brown' fox"
          , ["The quick brown", "fox"])
        , ( True
          , \x -> if x == '[' then Just ']' else Nothing
          , "The[ quick brown] fox"
          , ["The[ quick brown]", "fox"])
        , ( True
          , \x -> if x == '[' then Just ']' else Nothing
          , "The[ qui[ck] brown] \\ f[  ox]"
          , ["The[ qui[ck] brown]", " f[  ox]"])
        , ( False
          , \x -> if x == '[' then Just ']' else Nothing
          , "The[ qui[ck] brown] fox"
          , ["The qui[ck] brown", "fox"])
        ]


-- splitWithPass :: Property
-- splitWithPass =
--     forAll (listOf (chooseInt (0, 1))) $ \ls ->
--         case S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of
--             Right (result_first, result_second) -> case ls of
--                 0 : 1 : _ -> (result_first == 0) && (result_second == 1)
--                 _ -> False
--             Left _ -> case ls of
--                 0 : 1 : _ -> False
--                 _ -> True

-- splitWithFailLeft :: Property
-- splitWithFailLeft =
--     property (case S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-- splitWithFailRight :: Property
-- splitWithFailRight =
--     property (case S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-- splitWithFailBoth :: Property
-- splitWithFailBoth =
--     property (case S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-- teeWithPass :: Property
-- teeWithPass =
--     forAll (chooseInt (0, 10000)) $ \n ->
--         forAll (listOf (chooseInt (0, 1))) $ \ls ->
--             let
--                 prsr = P.take n FL.toList
--             in
--                 case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
--                     Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
--                     Left _ -> property False

-- teeWithFailLeft :: Property
-- teeWithFailLeft =
--     property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-- teeWithFailRight :: Property
-- teeWithFailRight =
--     property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-- teeWithFailBoth :: Property
-- teeWithFailBoth =
--     property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

{-
deintercalate :: Property
deintercalate =
    forAll (listOf (chooseAny :: Gen Int)) $ \ls ->
        case runIdentity $ S.parse p (S.fromList ls) of
            Right evenOdd -> evenOdd == List.partition even ls
            Left _ -> False

        where
            p1 = P.takeWhile even FL.toList
            p2 = P.takeWhile odd FL.toList
            partition =
                FL.tee (fmap concat $ FL.catLefts FL.toList)
                       (fmap concat $ FL.catRights FL.toList)
            p = P.deintercalate p1 p2 partition
-}

-- shortestPass :: Property
-- shortestPass =
--     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->
--         let
--             prsr_1 = P.takeWhile (<= (mid_value `Prelude.div` 2)) FL.toList
--             prsr_2 = P.takeWhile (<= mid_value) FL.toList
--             prsr_shortest = P.shortest prsr_1 prsr_2
--         in
--             case S.parse prsr_shortest (S.fromList ls) of
--                 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
--                 Left _ -> property False

-- shortestFailLeft :: Property
-- shortestFailLeft =
--     property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of
--         Right r -> r == 1
--         Left _ -> False)

-- shortestFailRight :: Property
-- shortestFailRight =
--     property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of
--         Right r -> r == 1
--         Left _ -> False)

-- shortestFailBoth :: Property
-- shortestFailBoth =
--     property (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

many :: Property
many =
    forAll (listOf (chooseInt (0, 1))) $ \ls ->
        let fldstp conL currL = return $ FL.Partial $ conL ++ currL
            concatFold = FL.Fold fldstp (return (FL.Partial [])) return
            prsr =
                flip P.many concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
        in
            case runIdentity $ S.parse prsr (S.fromList ls) of
                Right res_list -> checkListEqual res_list
                                    $ Prelude.filter (== 0) ls
                Left _ -> property False

-- many_empty :: Property
-- many_empty =
--     property (case S.parse (P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
--         Right res_list -> checkListEqual res_list ([] :: [Int])
--         Left _ -> property False)

some :: Property
some =
    forAll (listOf (chooseInt (0, 1))) $ \genLs ->
        let
            ls = 0 : genLs
            fldstp conL currL = return $ FL.Partial $ conL ++ currL
            concatFold = FL.Fold fldstp (return (FL.Partial [])) return
            prsr =
                flip P.some concatFold $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList
        in
            case runIdentity $ S.parse prsr (S.fromList ls) of
                Right res_list -> res_list == Prelude.filter (== 0) ls
                Left _ -> False

-- someFail :: Property
-- someFail =
--     property (case S.parse (P.some FL.toList (P.die "die")) (S.fromList [1 :: Int]) of
--         Right _ -> False
--         Left _ -> True)

-------------------------------------------------------------------------------
-- Instances
-------------------------------------------------------------------------------

applicative :: Property
applicative =
    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
            let parser =
                    (,)
                        <$> P.fromFold (FL.take (length list1) FL.toList)
                        <*> P.fromFold (FL.take (length list2) FL.toList)
             in monadicIO $ do
                    s <- S.parse parser (S.fromList $ list1 ++ list2)
                    return $
                        case s of
                            Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
                            Left _ -> False

sequence :: Property
sequence =
    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->
        let p xs = P.fromFold (FL.take (length xs) FL.toList)
         in monadicIO $ do
                outs <- run $
                        S.parse
                            (Prelude.sequence $ fmap p ins)
                            (S.fromList $ concat ins)
                return $
                    case outs of
                        Right ls -> ls == ins
                        Left _ -> False

monad :: Property
monad =
    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->
        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->
            let parser = do
                    olist1 <- P.fromFold (FL.take (length list1) FL.toList)
                    olist2 <- P.fromFold (FL.take (length list2) FL.toList)
                    return (olist1, olist2)
             in monadicIO $ do
                    s <- S.parse parser (S.fromList $ list1 ++ list2)
                    return $
                        case s of
                            Right (olist1, olist2) -> olist1 == list1 && olist2 == list2
                            Left _ -> False

-------------------------------------------------------------------------------
-- Stream parsing
-------------------------------------------------------------------------------

parseMany :: Property
parseMany =
    forAll (chooseInt (1,100)) $ \len ->
        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->
            monadicIO $ do
                outs <- do
                    let p = P.fromFold $ FL.take len FL.toList
                    run
                        $ S.fold FL.toList
                        $ S.catRights
                        $ S.parseMany p (S.fromList $ concat ins)
                listEquals (==) outs ins

-------------------------------------------------------------------------------
-- Test for a particular case hit during fs events testing
-------------------------------------------------------------------------------

evId :: [Word8]
evId = [96,238,17,9,0,0,0,0]

evFlags :: [Word8]
evFlags = [0,4,1,0,0,0,0,0]

evPathLen :: [Word8]
evPathLen = [71,0,0,0,0,0,0,0]

evPath :: [Word8]
evPath =
    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109
    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112
    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116
    ,114,101,97,109,108,121,47,116,109,112,47,122,122
    ]

event :: [Word8]
event = evId ++ evFlags ++ evPathLen ++ evPath

data Event = Event
   { eventId :: Word64
   , eventFlags :: Word32
   , eventAbsPath :: A.Array Word8
   } deriving (Show, Ord, Eq)

readOneEvent :: P.Parser Word8 IO Event
readOneEvent = do
    arr <- P.takeEQ 24 (A.writeN 24)
    let arr1 = A.castUnsafe arr :: A.Array Word64
        eid = A.unsafeIndex 0 arr1
        eflags = A.unsafeIndex 1 arr1
        pathLen = fromIntegral $ A.unsafeIndex 2 arr1
    -- XXX handle if pathLen is 0
    path <- P.takeEQ pathLen (A.writeN pathLen)
    return $ Event
        { eventId = eid
        , eventFlags = fromIntegral eflags
        , eventAbsPath = path
        }

parseMany2Events :: Property
parseMany2Events =
    monadicIO $ do
        xs <-
            ( run
            $ S.fold FL.toList
            $ S.catRights
            $ S.parseMany readOneEvent
            $ S.fromList (concat (replicate 2 event))
            )
        assert (length xs == 2)
        -- XXX assuming little endian machine
        let ev = Event
                { eventId = 152170080
                , eventFlags = 66560
                , eventAbsPath = A.fromList evPath
                }
         in listEquals (==) xs (replicate 2 ev)

manyEqParseMany :: Property
manyEqParseMany =
    forAll (listOf (chooseInt (0, 100))) $ \lst ->
    forAll (chooseInt (1, 100)) $ \i ->
        monadicIO $ do
            let strm = S.fromList lst
            r1 <- run $ S.parse (P.many (split i) FL.toList) strm
            r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm
            return $
                case r1 of
                    Right o1 -> o1 == r2
                    Left _ -> False

    where

    split i = P.fromFold (FL.take i FL.toList)


takeEndBy1 :: Property
takeEndBy1 =
    forAll (listOf (chooseInt (0, 1))) $ \ls ->
        case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of
            Right parsed_list ->
                checkListEqual
                parsed_list
                (takeWhileAndFirstFail (not . predicate) ls)
            Left _ -> property False
        where
            prsr = P.many (P.satisfy (const True)) FL.toList

            predicate = (== 1)

            takeWhileAndFirstFail prd (x : xs) =
                if prd x
                then x : takeWhileAndFirstFail prd xs
                else [x]
            takeWhileAndFirstFail _ [] = []

splitWithSuffix
    :: Monad m
    => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b
splitWithSuffix predicate f =  S.foldMany (FL.takeEndBy predicate f)

takeEndBy2 :: Property
takeEndBy2 =
    forAll (listOf (chooseInt (0, 1))) $ \ls ->
        let
            strm = S.fromList ls

            predicate = (==0)

            eitherParsedList =
                S.fold FL.toList
                    $ S.catRights
                    $ S.parseMany (P.takeEndBy predicate prsr) strm

                    where

                    prsr = P.many (P.satisfy (const True)) FL.toList

            eitherSplitList =
                case ls of
                    [] -> return []
                    _ ->
                        if last ls == 0
                        then S.fold FL.toList $ S.append strm1 (S.fromList [])
                        else S.fold FL.toList strm1

                        where

                        strm1 = splitWithSuffix predicate FL.toList strm
        in
            case eitherParsedList of
                Left _ -> property False
                Right parsedList ->
                    case eitherSplitList of
                        Left _ -> property False
                        Right splitList -> checkListEqual parsedList splitList

takeEndByEsc :: Property
takeEndByEsc =
    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
        let
            msg = "takeEndByEsc: trailing escape"

            isSep = even

            isEsc x = x `mod` 6 == 0

            prsr = P.takeEndByEsc isEsc isSep prsr0

                where

                prsr0 = P.many (P.satisfy (const True)) FL.toList

            escapeSep maybePrevEsc [] =
                case maybePrevEsc of
                    Nothing -> []
                    Just prevEsc -> [prevEsc]
            escapeSep maybePrevEsc (x : xs) =
                 case maybePrevEsc of
                    Nothing ->
                        if isEsc x
                        then escapeSep (Just x) xs
                        else
                            if isSep x
                            then [x]
                            else x : escapeSep Nothing xs
                    Just _ ->
                            x : escapeSep Nothing xs
        in
            case runIdentity $ S.parse prsr (S.fromList ls) of
                Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls
                Left err -> property (displayException err == msg)

takeFramedByEsc_ :: Property
takeFramedByEsc_ =
    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
        let
            isBegin = (== 0)

            isEnd = (== 1)

            isEsc = (== 2)

            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd  FL.toList

            checkPass (x : xs) maybePrevEsc openMinusClose =
                case maybePrevEsc of
                    Nothing ->
                        if isEsc x
                        then checkPass xs (Just x) openMinusClose
                        else
                            if isBegin x
                            then checkPass xs Nothing (openMinusClose + 1)
                            else
                                if isEnd x
                                then
                                    case openMinusClose of
                                        0 -> False
                                        1 -> True
                                        _ ->
                                            checkPass
                                            xs
                                            Nothing
                                            (openMinusClose - 1)
                                else
                                    checkPass xs Nothing openMinusClose
                    Just _ -> checkPass xs Nothing openMinusClose
            checkPass [] _ _ = False

            checkPassBeg [] = False
            checkPassBeg xxs@(x:_)
                | isBegin x = checkPass xxs Nothing (0 :: Int)
                | otherwise = False

            escapeFrame begin end escape l =
                let
                    helper (x : xs) maybePrevEsc openMinusClose =
                        case maybePrevEsc of
                            Nothing ->
                                if escape x
                                then helper xs (Just x) openMinusClose
                                else
                                    if begin x
                                    then helper xs Nothing (openMinusClose + 1)
                                    else
                                        if end x
                                        then
                                            if openMinusClose - 1 == 0
                                            then []
                                            else
                                                helper
                                                xs
                                                Nothing
                                                (openMinusClose - 1)
                                        else
                                            x : helper xs Nothing openMinusClose
                            Just prevEsc ->
                                if escape x || begin x || end x
                                then x : helper xs Nothing openMinusClose
                                else
                                    prevEsc : x : helper xs Nothing openMinusClose
                    helper [] _ _ = error "Cannot Reach Here"
                in
                    helper l Nothing (0 :: Int)
        in
            case runIdentity $ S.parse prsr (S.fromList ls) of
                Right parsed_list ->
                    if checkPassBeg ls
                    then checkListEqual parsed_list $
                        escapeFrame isBegin isEnd isEsc ls
                    else property False
                Left _ ->
                    if checkPassBeg ls
                    then property False
                    else property True

takeFramedByEsc_Pass :: Property
takeFramedByEsc_Pass =
    forAll (listOf (chooseInt (min_value, max_value))) $ \list ->
        let
            ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)

            isBegin = (== 0)

            isEnd = (== 1)

            isEsc = (== 2)

            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList

            escapeFrame begin end escape l =
                let
                    helper (x : xs) maybePrevEsc openMinusClose =
                        case maybePrevEsc of
                            Nothing ->
                                if escape x
                                then helper xs (Just x) openMinusClose
                                else
                                    if begin x
                                    then
                                        if openMinusClose == 0
                                        then helper xs Nothing (openMinusClose + 1)
                                        else x : helper xs Nothing (openMinusClose + 1)
                                    else
                                        if end x
                                        then
                                            if openMinusClose - 1 == 0
                                            then []
                                            else
                                                x :
                                                helper
                                                xs
                                                Nothing
                                                (openMinusClose - 1)
                                        else
                                            x : helper xs Nothing openMinusClose
                            Just _ ->
                                x : helper xs Nothing openMinusClose
                    helper [] _ _ = error "Cannot Reach Here"
                in
                    helper l Nothing (0 :: Int)
        in
            case runIdentity $ S.parse prsr (S.fromList ls) of
                Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls
                _ -> property False

takeFramedByEsc_Fail1 :: Property
takeFramedByEsc_Fail1 =
    let
        msg = "takeFramedByEsc_: missing frame end"

        isBegin = (== 0)

        isEnd = (== 0)

        isEsc = (== 2)

        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList

        ls = [0 :: Int]
    in
        case runIdentity $ S.parse prsr (S.fromList ls) of
            Right _ -> property False
            Left err -> property (displayException err == msg)

takeFramedByEsc_Fail2 :: Property
takeFramedByEsc_Fail2 =
    let
        msg = "takeFramedByEsc_: missing frame start"

        isBegin = (== 0)

        isEnd = (== 1)

        isEsc = (== 1)

        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList

        ls = [1 :: Int]
    in
        case runIdentity $ S.parse prsr (S.fromList ls) of
            Right _ -> property False
            Left err -> property (displayException err == msg)

takeFramedByEsc_Fail3 :: Property
takeFramedByEsc_Fail3 =
    let
        msg = "takeFramedByEsc_: missing frame end"

        isBegin = (== 2)

        isEnd = (== 1)

        isEsc = (== 2)

        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList

        ls = [2 :: Int]
    in
        case runIdentity $ S.parse prsr (S.fromList ls) of
            Right _ -> property False
            Left err -> property $ (displayException err == msg)

takeStartBy_ :: Property
takeStartBy_ =
     forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
        let ls1 = 1:ls
            msg = "takeFramedByGeneric: empty token"
        in
            case runIdentity $ S.parse parser (S.fromList ls1) of
                Right parsed_list ->
                  if not $ Prelude.null ls1
                  then
                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)
                    in checkListEqual parsed_list $
                      if predicate (head ls1)
                      then tls
                      else Prelude.takeWhile (not . predicate) ls1
                  else property $ Prelude.null parsed_list
                Left err -> property (displayException err == msg)
            where
                predicate = odd
                parser = P.takeStartBy_ predicate FL.toList
-------------------------------------------------------------------------------
-- Main
-------------------------------------------------------------------------------

moduleName :: String
moduleName = "Data.Parser"

main :: IO ()
main =
  hspec $
  H.parallel $
  modifyMaxSuccess (const maxTestCount) $ do
  describe moduleName $ do

    describe "Instances" $ do
        prop "applicative" applicative
        prop "monad" monad
        prop "sequence" sequence
    describe "Stream parsing" $ do
        prop "parseMany" parseMany
        prop "parseMany2Events" parseMany2Events

    describe "test for accumulator" $ do
        prop "P.fromFold FL.sum = FL.sum" fromFold
        prop "fromPure value provided" fromPure
        prop "fromPure monadic value provided" fromEffect
        prop "fail err = Left (SomeException (ParseError err))" parserFail
        prop "always fail" die
        prop "always fail but monadic" dieM

    describe "test for element parser" $ do
        prop "peek = head with list length > 0" peekPass
        prop "peek fail on []" peekFail
        prop "eof pass on []" eofPass
        prop "eof fail on non-empty list" eofFail
        prop "first element exists and >= mid_value" satisfyPass
        prop "one pass on [Int]" onePass
        prop "one fail on []" one
        prop "check first element exists and satisfies predicate" satisfy

    describe "test for sequence parser" $ do
        prop "P.takeBetween = Prelude.take when len >= m and len <= n"
            takeBetweenPass
        prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"
              ++ "otherwise fail") Main.takeBetween

        prop "P.takeEQ = Prelude.take when len >= n" takeEQPass
        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"
            Main.takeEQ
        prop "P.takeGE n ls = ls when len >= n" takeGEPass
        prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE
        -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass
        -- prop "Fail when stream length exceeded" lookAheadFail
        -- prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead
        prop "P.takeEndBy_ test" Main.takeEndBy_
        prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"
                ++ " tail") takeStartBy
        prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile
        prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"
                ++ " else check why failed") takeWhile1
        prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP
        prop ("P.takeP = Prelude.take") takeP
        prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy
        prop "many (P.wordBy ' ') = words'" wordBy
        parseManyWordQuotedBy
        -- prop "choice" choice
        -- prop "" splitWithPass
        -- prop "" splitWithFailLeft
        -- prop "" splitWithFailRight
        -- prop "" splitWithFailBoth
        -- prop "" teeWithPass
        -- prop "" teeWithFailLeft
        -- prop "" teeWithFailRight
        -- prop "" teeWithFailBoth
        -- prop "deintercalate" deintercalate
        -- prop "" shortestPass
        -- prop "" shortestFailLeft
        -- prop "" shortestFailRight
        -- prop "" shortestFailBoth
        prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="
                ++ "Prelude.filter (== 0)") many
        -- prop "[] due to parser being die" many_empty
        prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="
                ++ "Prelude.filter (== 0)") some
        -- prop "fail due to parser being die" someFail
        prop "P.many == S.parseMany" manyEqParseMany

        prop "takeEndBy_" takeEndBy_
        prop "takeEndBy1" takeEndBy1
        prop "takeEndBy2" takeEndBy2
        prop "takeEndByEsc" takeEndByEsc
        prop "takeFramedByEsc_" takeFramedByEsc_
        prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass
        prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1
        prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2
        prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3
        prop "takeStartBy_" takeStartBy_

    takeProperties