content: {-# Language NoMonoLocalBinds #-}
  -- XXX We are using head/tail at one place
  #if __GLASGOW_HASKELL__ >= 908
  {-# OPTIONS_GHC -Wno-x-partial #-}
  #endif
  module Main (main) where
  
  import Control.Applicative ((<|>))
  import Control.Exception (displayException)
  import Control.Monad.IO.Class (MonadIO(..))
  import Data.Char (isSpace)
  import Data.Foldable (for_)
  import Data.Word (Word8, Word32, Word64)
  import Streamly.Internal.Data.Fold (Fold(..))
  import Streamly.Internal.Data.Parser (Parser(..), Step(..), Initial(..), Final(..))
  import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)
  import Streamly.Internal.Data.Parser (ParseError(..))
  import Test.QuickCheck (forAll, Property, property, listOf, vectorOf, Gen)
  import Test.QuickCheck.Monadic (monadicIO, assert, run)
  
  import Prelude hiding (sequence)
  
  import qualified Streamly.Test.Data.Parser.Common as Common
  import qualified Streamly.Data.Stream as S
  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.ParserK as PK
  import qualified Streamly.Internal.Data.Producer as Producer
  import qualified Streamly.Internal.Data.Unfold as Unfold
  import qualified Streamly.Internal.Data.Stream as SI
  import qualified Streamly.Internal.Data.StreamK as K
  import qualified Test.Hspec as H
  
  import Test.Hspec
  import Test.Hspec.QuickCheck
  import Streamly.Test.Parser.Common
  
  #if MIN_VERSION_QuickCheck(2,14,0)
  
  import Test.QuickCheck (chooseAny)
  
  #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
  
  -------------------------------------------------------------------------------
  -- Stream parsing
  -------------------------------------------------------------------------------
  
  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"])
          ]
  
  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
  
  
  -- basic sanity test for parsing from arrays
  parseUnfold :: Property
  parseUnfold = do
      let len = 200
      -- ls = input list (stream)
      -- clen = chunk size
      -- tlen = parser take size
      forAll
          ((,,)
              <$> vectorOf len (chooseAny :: Gen Int)
              <*> chooseInt (1, len)
              <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->
          monadicIO $ do
              arrays <- S.toList $ A.chunksOf clen (S.fromList ls)
              let src = Producer.source (Just (Producer.OuterLoop arrays))
              let parser = P.fromFold (FL.take tlen FL.toList)
              let readSrc =
                      Producer.producer
                          $ Producer.concat Producer.fromList A.producer
              let streamParser =
                      Producer.simplify (Producer.parseManyD parser readSrc)
              xs <- run
                  $ S.toList
                  $ S.unfoldEach Unfold.fromList
                  $ S.catRights
                  $ S.unfold streamParser src
  
              listEquals (==) xs ls
  
  parserSequence :: Property
  parserSequence =
    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->
      monadicIO $ do
      let parsers = S.fromList
              $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins
      let sequencedParser = P.sequence parsers FL.sum
      outs <-
          S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins)
      return $
          case outs of
              Right x -> x == sum (map sum ins)
              Left _ -> False
  
  -------------------------------------------------------------------------------
  -- 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.createOf 24)
      let arr1 = A.unsafeCast arr :: A.Array Word64
          eid = A.unsafeGetIndex 0 arr1
          eflags = A.unsafeGetIndex 1 arr1
          pathLen = fromIntegral $ A.unsafeGetIndex 2 arr1
      -- XXX handle if pathLen is 0
      path <- P.takeEQ pathLen (A.createOf 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)
  
  --------------------------------------------------------------------------------
  -- Parser sequence tests
  --------------------------------------------------------------------------------
  
  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)
  
  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
  
  
  --------------------------------------------------------------------------------
  -- Parser quoted word tests
  --------------------------------------------------------------------------------
  
  quotedWordTest :: String -> [String] -> IO ()
  quotedWordTest inp expected = do
      res <-
          S.fold FL.toList
              $ catRightsErr
              $ S.parseMany quotedWord $ S.fromList inp
      res `shouldBe` expected
      where
      catRightsErr = fmap (either (error . displayException) id)
      quotedWord =
          let toRQuote x =
                  case x of
                      '"' -> Just x
                      '\'' -> Just x
                      _ -> Nothing
              -- Inside ",
              -- * \\ is translated to \
              -- * \" is translated to "
              trEsc '"' x =
                  case x of
                      '\\' -> Just '\\'
                      '"' -> Just '"'
                      _ -> Nothing
              trEsc _ _ = Nothing
           in P.wordWithQuotes False trEsc '\\' toRQuote isSpace FL.toList
  
  --------------------------------------------------------------------------------
  -- Parser sanity tests
  --------------------------------------------------------------------------------
  
  {-
  TODO:
  Add sanity tests for
  - Producer.parse
  - Producer.parseMany
  -}
  
  sanityParseBreak :: [Move] -> SpecWith ()
  sanityParseBreak jumps = it (show jumps) $ do
      (val, rest) <- SI.parseBreakPos (jumpParser jumps) $ S.fromList tape
      lst <- S.toList rest
      (val, lst) `shouldBe` (expectedResult jumps tape)
  
  sanityParseDBreak :: [Move] -> SpecWith ()
  sanityParseDBreak jumps = it (show jumps) $ do
      (val, rest) <- K.parseBreakPos (PK.toParserK (jumpParser jumps)) $ K.fromList tape
      lst <- K.toList rest
      (val, lst) `shouldBe` (expectedResult jumps tape)
  
  {-
  sanityParseBreakChunksK :: [Move] -> SpecWith ()
  sanityParseBreakChunksK jumps = it (show jumps) $ do
      (val, rest) <-
          A.parseBreakChunksK (jumpParser jumps)
              $ K.fromList $ Prelude.map A.fromList chunkedTape
      lst <- Prelude.map A.toList <$> K.toList rest
      (val, concat lst) `shouldBe` (expectedResult jumps tape)
  -}
  
  sanityParseMany :: [Move] -> SpecWith ()
  sanityParseMany jumps = it (show jumps) $ do
      res <- S.toList $ SI.parseManyPos (jumpParser jumps) $ S.fromList tape
      res `shouldBe` (expectedResultMany jumps tape)
  
  sanityParseIterate :: [Move] -> SpecWith ()
  sanityParseIterate jumps = it (show jumps) $ do
      res <-
          S.toList
               $ SI.parseIteratePos (const (jumpParser jumps)) [] $ S.fromList tape
      res `shouldBe` (expectedResultMany jumps tape)
  
  -------------------------------------------------------------------------------
  -- Instances
  -------------------------------------------------------------------------------
  
  {-# INLINE takeWhileFailD #-}
  takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b
  takeWhileFailD predicate (Fold fstep finitial _ ffinal) =
      Parser step initial extract
  
      where
  
      initial = do
          res <- finitial
          return $ case res of
              FL.Partial s -> IPartial s
              FL.Done b -> IDone b
  
      step s a =
          if predicate a
          then do
              fres <- fstep s a
              return
                  $ case fres of
                        FL.Partial s1 -> SContinue 1 s1
                        FL.Done b -> SDone 1 b
          else return $ SError "fail"
  
      extract s = fmap (FDone 0) (ffinal s)
  
  {-# INLINE takeWhileFail #-}
  takeWhileFail :: MonadIO m =>
      (a -> Bool) -> Fold m a b -> PK.ParserK a m b
  takeWhileFail p f = PK.toParserK (takeWhileFailD p f)
  
  {-# INLINE takeWhileK #-}
  takeWhileK :: MonadIO m => (a -> Bool) -> PK.ParserK a m [a]
  takeWhileK p = PK.toParserK $ P.takeWhile p FL.toList
  
  {-# INLINE alt2 #-}
  alt2 :: MonadIO m => K.StreamK m Int -> m (Either ParseError [Int])
  alt2 =
      K.parse
          (   takeWhileFail (<= 5) FL.toList
          <|> takeWhileK (<= 7)
          )
  
  {-# INLINE altD #-}
  altD :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int])
  altD =
      S.parse
          (   takeWhileFailD (<= 5) FL.toList
          <|> P.takeWhile (<= 7) FL.toList
          )
  
  altTests :: Spec
  altTests =
      describe "alt" $ do
          it "alt2 [1..20]" $ alt2 (K.fromList [1..20]) `shouldReturn` Right [1..7]
          it "altD [1..20]" $ altD (S.fromList [1..20]) `shouldReturn` Right [1..7]
  
  -------------------------------------------------------------------------------
  -- Main
  -------------------------------------------------------------------------------
  
  moduleName :: String
  moduleName = "Data.Parser"
  
  main :: IO ()
  main = do
    hspec $
        H.parallel $
        modifyMaxSuccess (const maxTestCount) $ do
        describe moduleName $ do
          parserSanityTests "Stream.parseBreak" sanityParseBreak
          parserSanityTests "StreamK.parseDBreak" sanityParseDBreak
          -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK
          parserSanityTests "Stream.parseMany" sanityParseMany
          parserSanityTests "Stream.parseIterate" sanityParseIterate
          describe "Stream parsing" $ do
              prop "parseMany" parseMany
              prop "parseMany2Events" parseMany2Events
              prop "parseUnfold" parseUnfold
              prop "parserSequence" parserSequence
  
          describe "test for sequence parser" $ do
              parseManyWordQuotedBy
              prop "P.many == S.parseMany" manyEqParseMany
              prop "takeEndBy2" takeEndBy2
  
          describe "quotedWordTest" $ do
              it "Single quote test" $ do
                 quotedWordTest "'hello\\\\\"world'" ["hello\\\\\"world"]
                 quotedWordTest "'hello\\'" ["hello\\"]
              it "Double quote test" $ do
                 quotedWordTest
                     "\"hello\\\"\\\\w\\'orld\""
                     ["hello\"\\w\\'orld"]
  
  
          altTests
          Common.main
  