{-# LANGUAGE CPP #-}
-- |
-- Module      : Streamly.Internal.Data.ParserDrivers
-- Copyright   : (c) 2018 Composewell Technologies
-- License     : BSD-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : experimental
-- Portability : GHC

module Streamly.Internal.Data.ParserDrivers
    (
    -- * Running a Parser
      parseBreak
    , parseBreakPos
    , parseBreakStreamK
    , parseBreakStreamKPos
    , parseBreakChunks
    , parseBreakChunksPos
    , parseBreakChunksGeneric
    , parseBreakChunksGenericPos
    , parseMany
    , parseManyPos
    , parseIterate
    , parseIteratePos
    )
    where

#include "assert.hs"
#include "inline.hs"
#include "ArrayMacros.h"

import Data.Proxy (Proxy(..))
import Fusion.Plugin.Types (Fuse(..))
import GHC.Exts (SpecConstrAnnotation(..))
import GHC.Types (SPEC(..))
import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))
import Streamly.Internal.Data.ParserK.Type (ParserK)
import Streamly.Internal.Data.StreamK.Type (StreamK)
import Streamly.Internal.Data.SVar.Type (adaptState, defState)
import Streamly.Internal.Data.Unbox (Unbox(..))

import qualified Streamly.Internal.Data.Array.Type as Array
import qualified Streamly.Internal.Data.Array.Generic.Type as GArray
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser as PRD
import qualified Streamly.Internal.Data.ParserK.Type as ParserK
import qualified Streamly.Internal.Data.Stream.Type as Nesting
import qualified Streamly.Internal.Data.Stream.Type as Stream
import qualified Streamly.Internal.Data.Stream.Generate as StreamD
import qualified Streamly.Internal.Data.StreamK.Type as StreamK

import Streamly.Internal.Data.Stream.Type hiding (splitAt)
import Prelude hiding (splitAt)

-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need
-- to make a newtype.
{-# ANN type List NoSpecConstr #-}
newtype List a = List {forall a. List a -> [a]
getList :: [a]}

-- The backracking buffer consists of arrays in the most-recent-first order. We
-- want to take a total of n array elements from this buffer. Note: when we
-- have to take an array partially, we must take the last part of the array.
{-# INLINE backtrack #-}
backtrack :: forall m a. Unbox a =>
       Int
    -> [Array a]
    -> StreamK m (Array a)
    -> (StreamK m (Array a), [Array a])
backtrack :: forall (m :: * -> *) a.
Unbox a =>
Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
backtrack Int
count [Array a]
buf StreamK m (Array a)
inp
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> (StreamK m (Array a), [Array a])
forall {a} {a}. (Show a, Num a) => a -> a
seekOver Int
count
  -- XXX this is handled at the call site, so we can assert that here.
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (StreamK m (Array a)
inp, [Array a]
buf)
  | Bool
otherwise = Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
forall {a} {m :: * -> *}.
Unbox a =>
Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go Int
count [Array a]
buf StreamK m (Array a)
inp

    where

    go :: Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go Int
n [] StreamK m (Array a)
_ = Int -> Int -> (StreamK m (Array a), [Array a])
forall {a} {a} {a}. (Show a, Show a) => a -> a -> a
seekUnder Int
count Int
n
    go Int
n (Array a
x:[Array a]
xs) StreamK m (Array a)
stream =
        let len :: Int
len = Array a -> Int
forall a. Unbox a => Array a -> Int
Array.length Array a
x
        in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
           then Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) [Array a]
xs (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
x StreamK m (Array a)
stream)
           else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
           then (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
x StreamK m (Array a)
stream, [Array a]
xs)
           else let !(Array MutByteArray
contents Int
start Int
end) = Array a
x
                    !start1 :: Int
start1 = Int
end Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
                    arr1 :: Array a
arr1 = MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
contents Int
start1 Int
end
                    arr2 :: Array a
arr2 = MutByteArray -> Int -> Int -> Array a
forall a. MutByteArray -> Int -> Int -> Array a
Array MutByteArray
contents Int
start Int
start1
                 in (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
forall {a}. Array a
arr1 StreamK m (Array a)
stream, Array a
forall {a}. Array a
arr2Array a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
xs)

    seekOver :: a -> a
seekOver a
x =
        String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Array.parseBreak: bug in parser, seeking ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (a -> a
forall a. Num a => a -> a
negate a
x)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements in future"

    seekUnder :: a -> a -> a
seekUnder a
x a
y =
        String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Array.parseBreak: bug in parser, backtracking ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements. Goes ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements beyond backtrack buffer"

{-# INLINE backtrackGeneric #-}
backtrackGeneric ::
       Int
    -> [GArray.Array a]
    -> StreamK m (GArray.Array a)
    -> (StreamK m (GArray.Array a), [GArray.Array a])
backtrackGeneric :: forall a (m :: * -> *).
Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
backtrackGeneric Int
count [Array a]
buf StreamK m (Array a)
inp
  | Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Int -> (StreamK m (Array a), [Array a])
forall {a} {a}. (Show a, Num a) => a -> a
seekOver Int
count
  | Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (StreamK m (Array a)
inp, [Array a]
buf)
  | Bool
otherwise = Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
forall a (m :: * -> *).
Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go Int
count [Array a]
buf StreamK m (Array a)
inp

    where

    go :: Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go Int
n [] StreamK m (Array a)
_ = Int -> Int -> (StreamK m (Array a), [Array a])
forall {a} {a} {a}. (Show a, Show a) => a -> a -> a
seekUnder Int
count Int
n
    go Int
n (Array a
x:[Array a]
xs) StreamK m (Array a)
stream =
        let len :: Int
len = Array a -> Int
forall a. Array a -> Int
GArray.length Array a
x
        in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
           then Int
-> [Array a]
-> StreamK m (Array a)
-> (StreamK m (Array a), [Array a])
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) [Array a]
xs (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
x StreamK m (Array a)
stream)
           else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
           then (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
x StreamK m (Array a)
stream, [Array a]
xs)
           else let arr1 :: Array a
arr1 = Int -> Int -> Array a -> Array a
forall a. Int -> Int -> Array a -> Array a
GArray.unsafeSliceOffLen (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Int
n Array a
x
                    arr2 :: Array a
arr2 = Int -> Int -> Array a -> Array a
forall a. Int -> Int -> Array a -> Array a
GArray.unsafeSliceOffLen Int
0 (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) Array a
x
                 in (Array a -> StreamK m (Array a) -> StreamK m (Array a)
forall a (m :: * -> *). a -> StreamK m a -> StreamK m a
StreamK.cons Array a
arr1 StreamK m (Array a)
stream, Array a
arr2Array a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
xs)

    seekOver :: a -> a
seekOver a
x =
        String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Array.Generic.parseBreak: bug in parser, seeking ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show (a -> a
forall a. Num a => a -> a
negate a
x)
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements in future"

    seekUnder :: a -> a -> a
seekUnder a
x a
y =
        String -> a
forall a. (?callStack::CallStack) => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Array.Generic.parseBreak: bug in parser, backtracking ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements. Goes ["
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y
            String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"] elements beyond backtrack buffer"

#include "ParserDrivers.h"
#define PARSER_WITH_POS
#include "ParserDrivers.h"