{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedSums #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedNewtypes #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

-- | A parser module using unboxed types for speed.
--
-- This is done because parsing to a JSON error report needs custom handling.
module Jordan.FromJSON.Internal.UnboxedParser where

import Control.Applicative
import Control.Monad (when)
import Data.Bifunctor
import qualified Data.ByteString as BS
import Data.ByteString.Internal
import Data.Functor
import Data.Monoid (Alt (..))
import Data.Word
import Debug.Trace (trace)
import GHC.Exts
import GHC.ForeignPtr
import GHC.Prim
import GHC.Types
import GHC.Word
import qualified Jordan.Types.Internal.AccumE as AE
import Jordan.Types.JSONError (JSONArrayError, JSONError, JSONObjectError)
import System.IO.Unsafe

#if __GLASGOW_HASKELL__ > 900
-- | Type of Word8 in GHC prim land. On GHC > 9.0, this is its own type.
type WordPrim = Word8#
#elif __GLASGOW_HASKELL__ > 800
-- | Type of word8 in GHC prim land.
-- On the GHC 8 series, this is 'Word#'.
type WordPrim = Word#
#endif

-- | Newtype wrapper around the state of an input.
--
-- This is just the offset into the buffer.
newtype InputState = InputState# {InputState -> Int#
getInputOffset :: Int#}

-- | Pattern synonym so we can use our above unlifted newtype like a record, if we do desire.
pattern InputState :: Int# -> InputState
pattern $bInputState :: Int# -> InputState
$mInputState :: forall r. InputState -> (Int# -> r) -> (Void# -> r) -> r
InputState {InputState -> Int#
offset} =
  InputState# offset

{-# COMPLETE InputState #-}

maxOffset :: InputState -> InputState -> InputState
maxOffset :: InputState -> InputState -> InputState
maxOffset (InputState# Int#
lhs) (InputState# Int#
rhs) =
  Int# -> InputState
InputState#
    (if Int# -> Bool
isTrue# (Int#
lhs Int# -> Int# -> Int#
># Int#
rhs) then Int#
lhs else Int#
rhs)

-- | Environment of a parser.
--
-- This is basically unpacked parts of a ByteString.
newtype InputRead = InputRead# {InputRead -> (# ForeignPtrContents, Addr#, Int# #)
getInputRead :: (# ForeignPtrContents, Addr#, Int# #)}

pattern InputRead :: ForeignPtrContents -> Addr# -> Int# -> InputRead
pattern $bInputRead :: ForeignPtrContents -> Addr# -> Int# -> InputRead
$mInputRead :: forall r.
InputRead
-> (ForeignPtrContents -> Addr# -> Int# -> r) -> (Void# -> r) -> r
InputRead {InputRead -> ForeignPtrContents
foreignPtr, InputRead -> Addr#
addr, InputRead -> Int#
endOffset} = InputRead# (# foreignPtr, addr, endOffset #)

{-# COMPLETE InputRead #-}

-- | Unboxed type similar to 'Jordan.Types.Internal.AccumE'.
newtype AccumE err a = AccumE {AccumE err a -> (# err | a #)
getAccumE :: (# err| a #)}

pattern AccumER :: a -> AccumE err a
pattern $bAccumER :: a -> AccumE err a
$mAccumER :: forall r a err. AccumE err a -> (a -> r) -> (Void# -> r) -> r
AccumER a = AccumE (# | a #)

pattern AccumEL :: err -> AccumE err a
pattern $bAccumEL :: err -> AccumE err a
$mAccumEL :: forall r err a. AccumE err a -> (err -> r) -> (Void# -> r) -> r
AccumEL err = AccumE (# err | #)

{-# COMPLETE AccumEL, AccumER #-}

newtype ParseResult# err res = ParseResult# {ParseResult# err res
-> (# (# InputState, AccumE err res #) | (# #) #)
getParseResult# :: (# (# InputState, AccumE err res #)| (# #) #)}

pattern JustParseResult :: InputState -> AccumE err res -> ParseResult# err res
pattern $bJustParseResult :: InputState -> AccumE err res -> ParseResult# err res
$mJustParseResult :: forall r err res.
ParseResult# err res
-> (InputState -> AccumE err res -> r) -> (Void# -> r) -> r
JustParseResult {ParseResult# err res -> InputState
inputState, ParseResult# err res -> AccumE err res
res} = ParseResult# (# (# inputState, res #) | #)

pattern NoParseResult :: ParseResult# err res
pattern $bNoParseResult :: Void# -> forall err res. ParseResult# err res
$mNoParseResult :: forall r err res.
ParseResult# err res -> (Void# -> r) -> (Void# -> r) -> r
NoParseResult = ParseResult# (# | (##) #)

bimapAcc :: (err -> err') -> (a -> a') -> AccumE err a -> AccumE err' a'
bimapAcc :: (err -> err') -> (a -> a') -> AccumE err a -> AccumE err' a'
bimapAcc err -> err'
first a -> a'
_ (AccumEL err
a) = err' -> AccumE err' a'
forall err a. err -> AccumE err a
AccumEL (err -> err'
first err
a)
bimapAcc err -> err'
_ a -> a'
second (AccumER a
a) = a' -> AccumE err' a'
forall a err. a -> AccumE err a
AccumER (a -> a'
second a
a)

eitherAcc :: Either err a -> AccumE err a
eitherAcc :: Either err a -> AccumE err a
eitherAcc (Left err
e) = err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL err
e
eitherAcc (Right a
a) = a -> AccumE err a
forall a err. a -> AccumE err a
AccumER a
a

appAcc ::
  Semigroup err =>
  AccumE err (a1 -> a2) ->
  AccumE err a1 ->
  AccumE err a2
appAcc :: AccumE err (a1 -> a2) -> AccumE err a1 -> AccumE err a2
appAcc (AccumER a1 -> a2
f) (AccumER a1
a) = a2 -> AccumE err a2
forall a err. a -> AccumE err a
AccumER (a1 -> a2
f a1
a)
appAcc (AccumEL err
lhs) (AccumEL err
rhs) = err -> AccumE err a2
forall err a. err -> AccumE err a
AccumEL (err
lhs err -> err -> err
forall a. Semigroup a => a -> a -> a
<> err
rhs)
appAcc (AccumEL err
lhs) AccumE err a1
_ = err -> AccumE err a2
forall err a. err -> AccumE err a
AccumEL err
lhs
appAcc AccumE err (a1 -> a2)
_ (AccumEL err
rhs) = err -> AccumE err a2
forall err a. err -> AccumE err a
AccumEL err
rhs

accSet :: a1 -> AccumE err a2 -> AccumE err a1
accSet :: a1 -> AccumE err a2 -> AccumE err a1
accSet a1
a (AccumER a2
_) = a1 -> AccumE err a1
forall a err. a -> AccumE err a
AccumER a1
a
accSet a1
_ (AccumEL err
err) = err -> AccumE err a1
forall err a. err -> AccumE err a
AccumEL err
err

{-# COMPLETE JustParseResult, NoParseResult #-}

-- | We need a parser with *error recovery*.
-- So the basic idea is that we separate errors reported during parsing from errors that make parsing stop.
-- IE, if we expect a JSON null but we get a JSON string, and the string is well-formed, we can keep parsing, but we
-- will *report* an error.
newtype Parser# s err res = Parser# {Parser# s err res
-> InputRead
-> InputState
-> State# s
-> (# State# s, ParseResult# err res #)
runParser :: InputRead -> InputState -> State# s -> (# State# s, ParseResult# err res #)}

bimapParser :: (err -> err') -> (a -> a') -> Parser# s err a -> Parser# s err' a'
bimapParser :: (err -> err') -> (a -> a') -> Parser# s err a -> Parser# s err' a'
bimapParser err -> err'
l a -> a'
r (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
cb) = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err' a' #))
-> Parser# s err' a'
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err' a' #))
 -> Parser# s err' a')
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err' a' #))
-> Parser# s err' a'
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
input State# s
s ->
  case InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
cb InputRead
env InputState
input State# s
s of
    (# State# s
s', ParseResult# err a
a #) ->
      (#
        State# s
s',
        case ParseResult# err a
a of
          ParseResult# err a
NoParseResult -> ParseResult# err' a'
forall err res. ParseResult# err res
NoParseResult
          JustParseResult InputState
is AccumE err a
e -> InputState -> AccumE err' a' -> ParseResult# err' a'
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
is ((err -> err') -> (a -> a') -> AccumE err a -> AccumE err' a'
forall err err' a a'.
(err -> err') -> (a -> a') -> AccumE err a -> AccumE err' a'
bimapAcc err -> err'
l a -> a'
r AccumE err a
e)
      #)

fmapParser :: (a -> res) -> Parser# s err a -> Parser# s err res
fmapParser :: (a -> res) -> Parser# s err a -> Parser# s err res
fmapParser a -> res
f (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
cb) = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err res #))
 -> Parser# s err res)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
input State# s
s ->
  case InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
cb InputRead
env InputState
input State# s
s of
    (# State# s
s', ParseResult# err a
a #) ->
      (#
        State# s
s,
        case ParseResult# err a
a of
          ParseResult# err a
NoParseResult -> ParseResult# err res
forall err res. ParseResult# err res
NoParseResult
          JustParseResult InputState
is (AccumER !a
r) -> InputState -> AccumE err res -> ParseResult# err res
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
is (res -> AccumE err res
forall a err. a -> AccumE err a
AccumER (a -> res
f a
r))
          JustParseResult InputState
is (AccumEL !err
l) -> InputState -> AccumE err res -> ParseResult# err res
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
is (err -> AccumE err res
forall err a. err -> AccumE err a
AccumEL err
l)
      #)
{-# INLINE fmapParser #-}

pureParser :: (Semigroup err) => a -> Parser# s err a
pureParser :: a -> Parser# s err a
pureParser !a
a = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err a #))
 -> Parser# s err a)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall a b. (a -> b) -> a -> b
$ \InputRead
_ InputState
state State# s
s -> (# State# s
s, InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (a -> AccumE err a
forall a err. a -> AccumE err a
AccumER a
a) #)
{-# INLINE pureParser #-}

apParser :: (Semigroup err) => Parser# s err (a -> b) -> Parser# s err a -> Parser# s err b
apParser :: Parser# s err (a -> b) -> Parser# s err a -> Parser# s err b
apParser (Parser# InputRead
-> InputState
-> State# s
-> (# State# s, ParseResult# err (a -> b) #)
fcb) (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
acb) = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err b #))
-> Parser# s err b
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err b #))
 -> Parser# s err b)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err b #))
-> Parser# s err b
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
input State# s
s ->
  case InputRead
-> InputState
-> State# s
-> (# State# s, ParseResult# err (a -> b) #)
fcb InputRead
env InputState
input State# s
s of
    (# State# s
s', ParseResult# err (a -> b)
NoParseResult #) -> (# State# s
s', ParseResult# err b
forall err res. ParseResult# err res
NoParseResult #)
    (# State# s
s', JustParseResult !InputState
input' !AccumE err (a -> b)
f #) ->
      case InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
acb InputRead
env InputState
input' State# s
s' of
        (# State# s
s'', ParseResult# err a
a #) ->
          (#
            State# s
s'',
            case ParseResult# err a
a of
              ParseResult# err a
NoParseResult -> ParseResult# err b
forall err res. ParseResult# err res
NoParseResult
              JustParseResult !InputState
input'' !AccumE err a
a -> InputState -> AccumE err b -> ParseResult# err b
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
input'' (AccumE err (a -> b)
f AccumE err (a -> b) -> AccumE err a -> AccumE err b
forall err a1 a2.
Semigroup err =>
AccumE err (a1 -> a2) -> AccumE err a1 -> AccumE err a2
`appAcc` AccumE err a
a)
          #)
{-# SPECIALIZE apParser :: Parser# s JSONError (a -> b) -> Parser# s JSONError a -> Parser# s JSONError b #-}
{-# SPECIALIZE apParser :: Parser# s JSONObjectError (a -> b) -> Parser# s JSONObjectError a -> Parser# s JSONObjectError b #-}
{-# SPECIALIZE apParser :: Parser# s JSONArrayError (a -> b) -> Parser# s JSONArrayError a -> Parser# s JSONArrayError b #-}
{-# INLINE apParser #-}

-- | Alternative instance for a parser.
-- This has weird behavior in that, if we have two results with delayed errors, this will act as if it skipped the *largest* amount
-- of said errors.
altParser :: (Monoid err) => Parser# s err a -> Parser# s err a -> Parser# s err a
altParser :: Parser# s err a -> Parser# s err a -> Parser# s err a
altParser (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
lhs) (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
rhs) = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err a #))
 -> Parser# s err a)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
input State# s
s ->
  let (# State# s
s', !ParseResult# err a
lhs' #) = InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
lhs InputRead
env InputState
input State# s
s
   in case ParseResult# err a
lhs' of
        -- If the parser failed to parse, we also fail to parse
        ParseResult# err a
NoParseResult -> InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
rhs InputRead
env InputState
input State# s
s'
        JustParseResult InputState
state (AccumER !a
res) -> (# State# s
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (a -> AccumE err a
forall a err. a -> AccumE err a
AccumER a
res) #)
        JustParseResult InputState
state res :: AccumE err a
res@(AccumEL !err
err) ->
          case InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
rhs InputRead
env InputState
input State# s
s' of
            (# State# s
s'', ParseResult# err a
NoParseResult #) -> (# State# s
s'', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state AccumE err a
res #)
            (# State# s
s'', JustParseResult InputState
state' (AccumER !a
res) #) -> (# State# s
s'', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (InputState -> InputState -> InputState
maxOffset InputState
state InputState
state') (a -> AccumE err a
forall a err. a -> AccumE err a
AccumER a
res) #)
            (# State# s
s'', JustParseResult InputState
state' (AccumEL !err
err') #) ->
              (# State# s
s'', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (InputState -> InputState -> InputState
maxOffset InputState
state InputState
state') (err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL (err
err err -> err -> err
forall a. Semigroup a => a -> a -> a
<> err
err')) #)
{-# SPECIALIZE altParser :: Parser# s JSONError a -> Parser# s JSONError a -> Parser# s JSONError a #-}
{-# SPECIALIZE altParser :: Parser# s JSONObjectError a -> Parser# s JSONObjectError a -> Parser# s JSONObjectError a #-}
{-# SPECIALIZE altParser :: Parser# s JSONArrayError a -> Parser# s JSONArrayError a -> Parser# s JSONArrayError a #-}
{-# INLINE altParser #-}

-- | Monadic bind for these parsers.
--
-- Note that this breaks the monad laws, as we do more error accumulation with (<*>) than we do ap.
-- Oh well.
bindParser :: Parser# s err a -> (a -> Parser# s err b) -> Parser# s err b
bindParser :: Parser# s err a -> (a -> Parser# s err b) -> Parser# s err b
bindParser (Parser# InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
arg) a -> Parser# s err b
cont =
  (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err b #))
-> Parser# s err b
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err b #))
 -> Parser# s err b)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err b #))
-> Parser# s err b
forall a b. (a -> b) -> a -> b
$
    {-# SCC unboxedParserBindInner #-}
    \InputRead
env InputState
state State# s
s ->
      let (# State# s
s', ParseResult# err a
result #) = InputRead
-> InputState -> State# s -> (# State# s, ParseResult# err a #)
arg InputRead
env InputState
state State# s
s
       in case ParseResult# err a
result of
            ParseResult# err a
NoParseResult -> (# State# s
s', ParseResult# err b
forall err res. ParseResult# err res
NoParseResult #)
            JustParseResult InputState
state' (AccumEL err
err) -> (# State# s
s', InputState -> AccumE err b -> ParseResult# err b
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (err -> AccumE err b
forall err a. err -> AccumE err a
AccumEL err
err) #)
            JustParseResult InputState
state' (AccumER a
r) -> Parser# s err b
-> InputRead
-> InputState
-> State# s
-> (# State# s, ParseResult# err b #)
forall s err res.
Parser# s err res
-> InputRead
-> InputState
-> State# s
-> (# State# s, ParseResult# err res #)
runParser (a -> Parser# s err b
cont a
r) InputRead
env InputState
state' State# s
s'
{-# INLINE bindParser #-}

emptyParser :: Parser# s err a
emptyParser :: Parser# s err a
emptyParser = (InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState -> State# s -> (# State# s, ParseResult# err a #))
 -> Parser# s err a)
-> (InputRead
    -> InputState -> State# s -> (# State# s, ParseResult# err a #))
-> Parser# s err a
forall a b. (a -> b) -> a -> b
$ \InputRead
_ InputState
_ State# s
s -> (# State# s
s, ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)

newtype Parser err res = Parser {Parser err res -> Parser# RealWorld err res
getParser :: Parser# RealWorld err res}
  deriving (b -> Parser err res -> Parser err res
NonEmpty (Parser err res) -> Parser err res
Parser err res -> Parser err res -> Parser err res
(Parser err res -> Parser err res -> Parser err res)
-> (NonEmpty (Parser err res) -> Parser err res)
-> (forall b. Integral b => b -> Parser err res -> Parser err res)
-> Semigroup (Parser err res)
forall b. Integral b => b -> Parser err res -> Parser err res
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall err res.
Monoid err =>
NonEmpty (Parser err res) -> Parser err res
forall err res.
Monoid err =>
Parser err res -> Parser err res -> Parser err res
forall err res b.
(Monoid err, Integral b) =>
b -> Parser err res -> Parser err res
stimes :: b -> Parser err res -> Parser err res
$cstimes :: forall err res b.
(Monoid err, Integral b) =>
b -> Parser err res -> Parser err res
sconcat :: NonEmpty (Parser err res) -> Parser err res
$csconcat :: forall err res.
Monoid err =>
NonEmpty (Parser err res) -> Parser err res
<> :: Parser err res -> Parser err res -> Parser err res
$c<> :: forall err res.
Monoid err =>
Parser err res -> Parser err res -> Parser err res
Semigroup, Semigroup (Parser err res)
Parser err res
Semigroup (Parser err res)
-> Parser err res
-> (Parser err res -> Parser err res -> Parser err res)
-> ([Parser err res] -> Parser err res)
-> Monoid (Parser err res)
[Parser err res] -> Parser err res
Parser err res -> Parser err res -> Parser err res
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall err res. Monoid err => Semigroup (Parser err res)
forall err res. Monoid err => Parser err res
forall err res. Monoid err => [Parser err res] -> Parser err res
forall err res.
Monoid err =>
Parser err res -> Parser err res -> Parser err res
mconcat :: [Parser err res] -> Parser err res
$cmconcat :: forall err res. Monoid err => [Parser err res] -> Parser err res
mappend :: Parser err res -> Parser err res -> Parser err res
$cmappend :: forall err res.
Monoid err =>
Parser err res -> Parser err res -> Parser err res
mempty :: Parser err res
$cmempty :: forall err res. Monoid err => Parser err res
$cp1Monoid :: forall err res. Monoid err => Semigroup (Parser err res)
Monoid) via (Alt (Parser err) res)

instance Bifunctor Parser where
  bimap :: (a -> b) -> (c -> d) -> Parser a c -> Parser b d
bimap a -> b
l c -> d
r (Parser Parser# RealWorld a c
p) = Parser# RealWorld b d -> Parser b d
forall err res. Parser# RealWorld err res -> Parser err res
Parser ((a -> b)
-> (c -> d) -> Parser# RealWorld a c -> Parser# RealWorld b d
forall err err' a a' s.
(err -> err') -> (a -> a') -> Parser# s err a -> Parser# s err' a'
bimapParser a -> b
l c -> d
r Parser# RealWorld a c
p)
  {-# INLINE bimap #-}

instance Functor (Parser err) where
  fmap :: (a -> b) -> Parser err a -> Parser err b
fmap a -> b
f (Parser Parser# RealWorld err a
a) = Parser# RealWorld err b -> Parser err b
forall err res. Parser# RealWorld err res -> Parser err res
Parser ((a -> b) -> Parser# RealWorld err a -> Parser# RealWorld err b
forall a res s err.
(a -> res) -> Parser# s err a -> Parser# s err res
fmapParser a -> b
f Parser# RealWorld err a
a)
  {-# INLINE fmap #-}
  a
a <$ :: a -> Parser err b -> Parser err a
<$ (Parser (Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err b #)
cb)) = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
    (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
state State# RealWorld
token ->
      let (# State# RealWorld
s', ParseResult# err b
res #) = InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err b #)
cb InputRead
env InputState
state State# RealWorld
token
       in case ParseResult# err b
res of
            ParseResult# err b
NoParseResult -> (# State# RealWorld
s', ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)
            JustParseResult InputState
state AccumE err b
r -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (a
a a -> AccumE err b -> AccumE err a
forall a1 err a2. a1 -> AccumE err a2 -> AccumE err a1
`accSet` AccumE err b
r) #)
  {-# INLINE (<$) #-}

instance (Semigroup err) => Applicative (Parser err) where
  pure :: a -> Parser err a
pure = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> (a -> Parser# RealWorld err a) -> a -> Parser err a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Parser# RealWorld err a
forall err a s. Semigroup err => a -> Parser# s err a
pureParser
  {-# INLINE pure #-}
  (Parser Parser# RealWorld err (a -> b)
f) <*> :: Parser err (a -> b) -> Parser err a -> Parser err b
<*> (Parser Parser# RealWorld err a
a) = Parser# RealWorld err b -> Parser err b
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err (a -> b)
f Parser# RealWorld err (a -> b)
-> Parser# RealWorld err a -> Parser# RealWorld err b
forall err s a b.
Semigroup err =>
Parser# s err (a -> b) -> Parser# s err a -> Parser# s err b
`apParser` Parser# RealWorld err a
a)
  {-# INLINE (<*>) #-}
  {-# SPECIALIZE (<*>) :: Parser JSONError (a -> b) -> Parser JSONError a -> Parser JSONError b #-}
  {-# SPECIALIZE (<*>) :: Parser JSONObjectError (a -> b) -> Parser JSONObjectError a -> Parser JSONObjectError b #-}

instance (Monoid err) => Alternative (Parser err) where
  empty :: Parser err a
empty = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser Parser# RealWorld err a
forall s err a. Parser# s err a
emptyParser
  {-# INLINE empty #-}
  (Parser Parser# RealWorld err a
l) <|> :: Parser err a -> Parser err a -> Parser err a
<|> (Parser Parser# RealWorld err a
r) = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a
l Parser# RealWorld err a
-> Parser# RealWorld err a -> Parser# RealWorld err a
forall err s a.
Monoid err =>
Parser# s err a -> Parser# s err a -> Parser# s err a
`altParser` Parser# RealWorld err a
r)
  {-# INLINE (<|>) #-}

instance (Semigroup err) => Monad (Parser err) where
  (Parser Parser# RealWorld err a
f) >>= :: Parser err a -> (a -> Parser err b) -> Parser err b
>>= a -> Parser err b
cb = Parser# RealWorld err b -> Parser err b
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a
f Parser# RealWorld err a
-> (a -> Parser# RealWorld err b) -> Parser# RealWorld err b
forall s err a b.
Parser# s err a -> (a -> Parser# s err b) -> Parser# s err b
`bindParser` (\a
res -> Parser err b -> Parser# RealWorld err b
forall err res. Parser err res -> Parser# RealWorld err res
getParser (a -> Parser err b
cb a
res)))
  {-# INLINE (>>=) #-}

parseBSIO :: Parser err res -> ByteString -> IO (Maybe (AE.AccumE err res))
parseBSIO :: Parser err res -> ByteString -> IO (Maybe (AccumE err res))
parseBSIO (Parser (Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err res #)
cb)) (PS (ForeignPtr Addr#
addr ForeignPtrContents
contents) Int
offset' Int
len) = (State# RealWorld
 -> (# State# RealWorld, Maybe (AccumE err res) #))
-> IO (Maybe (AccumE err res))
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO State# RealWorld -> (# State# RealWorld, Maybe (AccumE err res) #)
parse'
  where
    (I# Int#
endOffset) = Int
offset' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
    (I# Int#
startOffset) = Int
offset'
    parse' :: State# RealWorld -> (# State# RealWorld, Maybe (AccumE err res) #)
parse' State# RealWorld
s =
      let (# State# RealWorld
s', ParseResult# err res
res #) = InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err res #)
cb (ForeignPtrContents -> Addr# -> Int# -> InputRead
InputRead ForeignPtrContents
contents Addr#
addr Int#
endOffset) (Int# -> InputState
InputState# Int#
startOffset) State# RealWorld
s
       in case ParseResult# err res
res of
            ParseResult# err res
NoParseResult -> (# State# RealWorld
s', Maybe (AccumE err res)
forall a. Maybe a
Nothing #)
            JustParseResult InputState
_ (AccumEL err
err) -> (# State# RealWorld
s', AccumE err res -> Maybe (AccumE err res)
forall a. a -> Maybe a
Just (err -> AccumE err res
forall err val. err -> AccumE err val
AE.AccumEL err
err) #)
            JustParseResult InputState
_ (AccumER res
res) -> (# State# RealWorld
s', AccumE err res -> Maybe (AccumE err res)
forall a. a -> Maybe a
Just (res -> AccumE err res
forall val err. val -> AccumE err val
AE.AccumER res
res) #)

parseBS :: Parser err res -> ByteString -> Maybe (AE.AccumE err res)
parseBS :: Parser err res -> ByteString -> Maybe (AccumE err res)
parseBS Parser err res
parser ByteString
bs = IO (Maybe (AccumE err res)) -> Maybe (AccumE err res)
forall a. IO a -> a
unsafeDupablePerformIO (Parser err res -> ByteString -> IO (Maybe (AccumE err res))
forall err res.
Parser err res -> ByteString -> IO (Maybe (AccumE err res))
parseBSIO Parser err res
parser ByteString
bs)

currentOffset :: Parser err Int
currentOffset :: Parser err Int
currentOffset = Parser# RealWorld err Int -> Parser err Int
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err Int -> Parser err Int)
-> Parser# RealWorld err Int -> Parser err Int
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err Int #))
-> Parser# RealWorld err Int
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err Int #))
 -> Parser# RealWorld err Int)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err Int #))
-> Parser# RealWorld err Int
forall a b. (a -> b) -> a -> b
$ \InputRead
env i :: InputState
i@(InputState# Int#
cs) State# RealWorld
s ->
    (# State# RealWorld
s, InputState -> AccumE err Int -> ParseResult# err Int
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Int -> AccumE err Int
forall a err. a -> AccumE err a
AccumER (Int# -> Int
I# Int#
cs)) #)
{-# INLINE currentOffset #-}

getEndOffset :: Parser err Int
getEndOffset :: Parser err Int
getEndOffset = Parser# RealWorld err Int -> Parser err Int
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err Int -> Parser err Int)
-> Parser# RealWorld err Int -> Parser err Int
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err Int #))
-> Parser# RealWorld err Int
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err Int #))
 -> Parser# RealWorld err Int)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err Int #))
-> Parser# RealWorld err Int
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
i State# RealWorld
s ->
    (# State# RealWorld
s, InputState -> AccumE err Int -> ParseResult# err Int
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Int -> AccumE err Int
forall a err. a -> AccumE err a
AccumER (Int# -> Int
I# (InputRead -> Int#
endOffset InputRead
env))) #)
{-# INLINE getEndOffset #-}

parsedPtr :: Parser err (ForeignPtr Word8)
parsedPtr :: Parser err (ForeignPtr Word8)
parsedPtr = Parser# RealWorld err (ForeignPtr Word8)
-> Parser err (ForeignPtr Word8)
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err (ForeignPtr Word8)
 -> Parser err (ForeignPtr Word8))
-> Parser# RealWorld err (ForeignPtr Word8)
-> Parser err (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err (ForeignPtr Word8) #))
-> Parser# RealWorld err (ForeignPtr Word8)
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err (ForeignPtr Word8) #))
 -> Parser# RealWorld err (ForeignPtr Word8))
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err (ForeignPtr Word8) #))
-> Parser# RealWorld err (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
i State# RealWorld
s -> (# State# RealWorld
s, InputState
-> AccumE err (ForeignPtr Word8)
-> ParseResult# err (ForeignPtr Word8)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (ForeignPtr Word8 -> AccumE err (ForeignPtr Word8)
forall a err. a -> AccumE err a
AccumER (ForeignPtr Word8 -> AccumE err (ForeignPtr Word8))
-> ForeignPtr Word8 -> AccumE err (ForeignPtr Word8)
forall a b. (a -> b) -> a -> b
$ Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (InputRead -> Addr#
addr InputRead
env) (InputRead -> ForeignPtrContents
foreignPtr InputRead
env)) #)

currentEnv :: Parser err (ForeignPtrContents, Ptr a, Int)
currentEnv :: Parser err (ForeignPtrContents, Ptr a, Int)
currentEnv = Parser# RealWorld err (ForeignPtrContents, Ptr a, Int)
-> Parser err (ForeignPtrContents, Ptr a, Int)
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err (ForeignPtrContents, Ptr a, Int)
 -> Parser err (ForeignPtrContents, Ptr a, Int))
-> Parser# RealWorld err (ForeignPtrContents, Ptr a, Int)
-> Parser err (ForeignPtrContents, Ptr a, Int)
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld,
       ParseResult# err (ForeignPtrContents, Ptr a, Int) #))
-> Parser# RealWorld err (ForeignPtrContents, Ptr a, Int)
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld,
        ParseResult# err (ForeignPtrContents, Ptr a, Int) #))
 -> Parser# RealWorld err (ForeignPtrContents, Ptr a, Int))
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld,
          ParseResult# err (ForeignPtrContents, Ptr a, Int) #))
-> Parser# RealWorld err (ForeignPtrContents, Ptr a, Int)
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
i State# RealWorld
s -> (# State# RealWorld
s, InputState
-> AccumE err (ForeignPtrContents, Ptr a, Int)
-> ParseResult# err (ForeignPtrContents, Ptr a, Int)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i ((ForeignPtrContents, Ptr a, Int)
-> AccumE err (ForeignPtrContents, Ptr a, Int)
forall a err. a -> AccumE err a
AccumER (InputRead -> ForeignPtrContents
foreignPtr InputRead
env, Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr (InputRead -> Addr#
addr InputRead
env), Int# -> Int
I# (InputRead -> Int#
endOffset InputRead
env))) #)

failParse :: Parser err a
failParse :: Parser err a
failParse = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
i State# RealWorld
s -> (# State# RealWorld
s, ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)

maybeWord :: Parser err (Maybe Word8)
maybeWord :: Parser err (Maybe Word8)
maybeWord = Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8)
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8))
-> Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
-> Parser# RealWorld err (Maybe Word8)
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
 -> Parser# RealWorld err (Maybe Word8))
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
-> Parser# RealWorld err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \InputRead
env state :: InputState
state@(InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, InputState
-> AccumE err (Maybe Word8) -> ParseResult# err (Maybe Word8)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (Maybe Word8 -> AccumE err (Maybe Word8)
forall a err. a -> AccumE err a
AccumER Maybe Word8
forall a. Maybe a
Nothing) #)
      else
        let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
input State# RealWorld
s
         in (# State# RealWorld
s', InputState
-> AccumE err (Maybe Word8) -> ParseResult# err (Maybe Word8)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (Int# -> InputState
InputState# (Int#
input Int# -> Int# -> Int#
+# Int#
1#)) (Maybe Word8 -> AccumE err (Maybe Word8)
forall a err. a -> AccumE err a
AccumER (Maybe Word8 -> AccumE err (Maybe Word8))
-> Maybe Word8 -> AccumE err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ Word# -> Word8
W8# Word#
word) #)

orFail :: Parser err (Maybe a) -> Parser err a
orFail :: Parser err (Maybe a) -> Parser err a
orFail (Parser (Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err (Maybe a) #)
cb)) = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
s State# RealWorld
state ->
    let (# State# RealWorld
s', ParseResult# err (Maybe a)
r #) = InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err (Maybe a) #)
cb InputRead
env InputState
s State# RealWorld
state
     in case ParseResult# err (Maybe a)
r of
          ParseResult# err (Maybe a)
NoParseResult -> (# State# RealWorld
s', ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)
          JustParseResult InputState
state AccumE err (Maybe a)
a ->
            case AccumE err (Maybe a)
a of
              AccumER (Just a
a) -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (a -> AccumE err a
forall a err. a -> AccumE err a
AccumER a
a) #)
              AccumE err (Maybe a)
_ -> (# State# RealWorld
s', ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)

failWith :: err -> Parser err a
failWith :: err -> Parser err a
failWith err
err = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
s State# RealWorld
state -> (# State# RealWorld
state, InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
s (err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL err
err) #)

asFailure :: Parser err err -> Parser err a
asFailure :: Parser err err -> Parser err a
asFailure (Parser (Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err err #)
cb)) = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
s State# RealWorld
state ->
    let (# State# RealWorld
s', ParseResult# err err
r #) = InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err err #)
cb InputRead
env InputState
s State# RealWorld
state
     in case ParseResult# err err
r of
          ParseResult# err err
NoParseResult -> (# State# RealWorld
s', ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)
          JustParseResult InputState
state AccumE err err
a ->
            case AccumE err err
a of
              AccumER err
a -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL err
a) #)
              AccumEL err
a -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL err
a) #)

-- | Lower a parsed error to a *parser error*.
lowerErr :: Parser err (Either err a) -> Parser err a
lowerErr :: Parser err (Either err a) -> Parser err a
lowerErr (Parser (Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err (Either err a) #)
cb)) = Parser# RealWorld err a -> Parser err a
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err a -> Parser err a)
-> Parser# RealWorld err a -> Parser err a
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err a #))
 -> Parser# RealWorld err a)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err a #))
-> Parser# RealWorld err a
forall a b. (a -> b) -> a -> b
$ \InputRead
env InputState
s State# RealWorld
state ->
    let (# State# RealWorld
s', ParseResult# err (Either err a)
r #) = InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err (Either err a) #)
cb InputRead
env InputState
s State# RealWorld
state
     in case ParseResult# err (Either err a)
r of
          ParseResult# err (Either err a)
NoParseResult -> (# State# RealWorld
s', ParseResult# err a
forall err res. ParseResult# err res
NoParseResult #)
          JustParseResult InputState
state AccumE err (Either err a)
res ->
            case AccumE err (Either err a)
res of
              AccumER Either err a
e -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (Either err a -> AccumE err a
forall err a. Either err a -> AccumE err a
eitherAcc Either err a
e) #)
              AccumEL err
l -> (# State# RealWorld
s', InputState -> AccumE err a -> ParseResult# err a
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
state (err -> AccumE err a
forall err a. err -> AccumE err a
AccumEL err
l) #)

-- | Do we have any further input?
hasFurther :: Parser err Bool
hasFurther :: Parser err Bool
hasFurther = Parser# RealWorld err Bool -> Parser err Bool
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err Bool -> Parser err Bool)
-> Parser# RealWorld err Bool -> Parser err Bool
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err Bool #))
-> Parser# RealWorld err Bool
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err Bool #))
 -> Parser# RealWorld err Bool)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err Bool #))
-> Parser# RealWorld err Bool
forall a b. (a -> b) -> a -> b
$ \InputRead
env i :: InputState
i@(InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, InputState -> AccumE err Bool -> ParseResult# err Bool
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Bool -> AccumE err Bool
forall a err. a -> AccumE err a
AccumER Bool
False) #)
      else (# State# RealWorld
s, InputState -> AccumE err Bool -> ParseResult# err Bool
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Bool -> AccumE err Bool
forall a err. a -> AccumE err a
AccumER Bool
True) #)

-- | Advance forward one word, fail if we can't
advanceWord :: Parser err ()
advanceWord :: Parser err ()
advanceWord = Parser# RealWorld err () -> Parser err ()
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err () -> Parser err ())
-> Parser# RealWorld err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err () #))
-> Parser# RealWorld err ()
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err () #))
 -> Parser# RealWorld err ())
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err () #))
-> Parser# RealWorld err ()
forall a b. (a -> b) -> a -> b
$ \InputRead
env (InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, ParseResult# err ()
forall err res. ParseResult# err res
NoParseResult #)
      else (# State# RealWorld
s, InputState -> AccumE err () -> ParseResult# err ()
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (Int# -> InputState
InputState# (Int#
input Int# -> Int# -> Int#
+# Int#
1#)) (() -> AccumE err ()
forall a err. a -> AccumE err a
AccumER ()) #)

-- | Peek the next word, fail if there's nothing there
peekWord :: Parser err Word8
peekWord :: Parser err Word8
peekWord = Parser# RealWorld err Word8 -> Parser err Word8
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err Word8 -> Parser err Word8)
-> Parser# RealWorld err Word8 -> Parser err Word8
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err Word8 #))
-> Parser# RealWorld err Word8
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err Word8 #))
 -> Parser# RealWorld err Word8)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err Word8 #))
-> Parser# RealWorld err Word8
forall a b. (a -> b) -> a -> b
$ \InputRead
env i :: InputState
i@(InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, ParseResult# err Word8
forall err res. ParseResult# err res
NoParseResult #)
      else
        let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
input State# RealWorld
s
         in (# State# RealWorld
s', InputState -> AccumE err Word8 -> ParseResult# err Word8
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Word8 -> AccumE err Word8
forall a err. a -> AccumE err a
AccumER (Word8 -> AccumE err Word8) -> Word8 -> AccumE err Word8
forall a b. (a -> b) -> a -> b
$ Word# -> Word8
W8# Word#
word) #)

-- | Peek a word, or nothing.
-- Never fails.
peekWordMaybe :: Parser err (Maybe Word8)
peekWordMaybe :: Parser err (Maybe Word8)
peekWordMaybe = Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8)
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8))
-> Parser# RealWorld err (Maybe Word8) -> Parser err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
-> Parser# RealWorld err (Maybe Word8)
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
 -> Parser# RealWorld err (Maybe Word8))
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err (Maybe Word8) #))
-> Parser# RealWorld err (Maybe Word8)
forall a b. (a -> b) -> a -> b
$ \InputRead
env i :: InputState
i@(InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, InputState
-> AccumE err (Maybe Word8) -> ParseResult# err (Maybe Word8)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Maybe Word8 -> AccumE err (Maybe Word8)
forall a err. a -> AccumE err a
AccumER Maybe Word8
forall a. Maybe a
Nothing) #)
      else
        let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
input State# RealWorld
s
         in (# State# RealWorld
s', InputState
-> AccumE err (Maybe Word8) -> ParseResult# err (Maybe Word8)
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult InputState
i (Maybe Word8 -> AccumE err (Maybe Word8)
forall a err. a -> AccumE err a
AccumER (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word# -> Word8
W8# Word#
word))) #)

word :: Parser err Word8
word :: Parser err Word8
word = Parser# RealWorld err Word8 -> Parser err Word8
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err Word8 -> Parser err Word8)
-> Parser# RealWorld err Word8 -> Parser err Word8
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err Word8 #))
-> Parser# RealWorld err Word8
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err Word8 #))
 -> Parser# RealWorld err Word8)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err Word8 #))
-> Parser# RealWorld err Word8
forall a b. (a -> b) -> a -> b
$ \InputRead
env (InputState# Int#
input) State# RealWorld
s ->
    if Int# -> Bool
isTrue# (Int#
input Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
      then (# State# RealWorld
s, ParseResult# err Word8
forall err res. ParseResult# err res
NoParseResult #)
      else
        let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
input State# RealWorld
s
         in (# State# RealWorld
s', InputState -> AccumE err Word8 -> ParseResult# err Word8
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (Int# -> InputState
InputState# (Int#
input Int# -> Int# -> Int#
+# Int#
1#)) (Word8 -> AccumE err Word8
forall a err. a -> AccumE err a
AccumER (Word8 -> AccumE err Word8) -> Word8 -> AccumE err Word8
forall a b. (a -> b) -> a -> b
$ Word# -> Word8
W8# Word#
word) #)

specificWord :: Word8 -> Parser err ()
specificWord Word8
w = Parser err (Maybe ()) -> Parser err ()
forall err a. Parser err (Maybe a) -> Parser err a
orFail (Word8 -> Maybe ()
cb (Word8 -> Maybe ()) -> Parser err Word8 -> Parser err (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser err Word8
forall err. Parser err Word8
word)
  where
    cb :: Word8 -> Maybe ()
cb Word8
w' =
      if Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w' then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing

-- | Skip over while the callback returns true.
--
-- Unlifted version, probably use skipWord8
skipWord8# :: (WordPrim -> Bool) -> Parser err ()
skipWord8# :: (Word# -> Bool) -> Parser err ()
skipWord8# Word# -> Bool
cb =
  Parser# RealWorld err () -> Parser err ()
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err () -> Parser err ())
-> Parser# RealWorld err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$
    (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err () #))
-> Parser# RealWorld err ()
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((Word# -> Bool)
-> InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
forall err.
(Word# -> Bool)
-> InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
skipWord8CB# Word# -> Bool
cb)
{-# INLINE skipWord8# #-}

-- | Skip over while the callback returns true
skipWord8 :: (Word8 -> Bool) -> Parser err ()
skipWord8 :: (Word8 -> Bool) -> Parser err ()
skipWord8 Word8 -> Bool
cb = (Word# -> Bool) -> Parser err ()
forall err. (Word# -> Bool) -> Parser err ()
skipWord8# (\Word#
byte -> Word8 -> Bool
cb (Word# -> Word8
W8# Word#
byte {- HLINT ignore "Avoid lambda" -}))
{-# INLINE skipWord8 #-}

-- | Private: callback used for skipWord8
skipWord8CB# ::
  (WordPrim -> Bool) ->
  InputRead ->
  InputState ->
  State# RealWorld ->
  (# State# RealWorld, ParseResult# err () #)
skipWord8CB# :: (Word# -> Bool)
-> InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
skipWord8CB# Word# -> Bool
cb InputRead
env (InputState# Int#
input) State# RealWorld
s =
  let (# State# RealWorld
s', Int#
newOff #) = Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Int#
input State# RealWorld
s
   in (# State# RealWorld
s', InputState -> AccumE err () -> ParseResult# err ()
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (Int# -> InputState
InputState# Int#
newOff) (() -> AccumE err ()
forall a err. a -> AccumE err a
AccumER ()) #)
  where
    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Int#
inputOffset State# RealWorld
s =
      if Int# -> Bool
isTrue# (Int#
inputOffset Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env)
        then (# State# RealWorld
s, Int#
inputOffset #)
        else
          let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
inputOffset State# RealWorld
s
           in if Word# -> Bool
cb Word#
word then Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s' else (# State# RealWorld
s', Int#
inputOffset #)

skipWhitespace :: Parser err ()
skipWhitespace :: Parser err ()
skipWhitespace = Parser# RealWorld err () -> Parser err ()
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err () -> Parser err ())
-> Parser# RealWorld err () -> Parser err ()
forall a b. (a -> b) -> a -> b
$ (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err () #))
-> Parser# RealWorld err ()
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
forall err.
InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
skipWhitespaceCB
{-# INLINE skipWhitespace #-}

skipWhitespaceCB ::
  InputRead ->
  InputState ->
  State# RealWorld ->
  (# State# RealWorld, ParseResult# err () #)
skipWhitespaceCB :: InputRead
-> InputState
-> State# RealWorld
-> (# State# RealWorld, ParseResult# err () #)
skipWhitespaceCB InputRead
env (InputState# Int#
input) State# RealWorld
s =
  let (# State# RealWorld
s', Int#
newOff #) = Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Int#
input State# RealWorld
s
   in (# State# RealWorld
s', InputState -> AccumE err () -> ParseResult# err ()
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult (Int# -> InputState
InputState# Int#
newOff) (() -> AccumE err ()
forall a err. a -> AccumE err a
AccumER ()) #)
  where
    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go Int#
inputOffset State# RealWorld
s
      | Int# -> Bool
isTrue# (Int#
inputOffset Int# -> Int# -> Int#
==# InputRead -> Int#
endOffset InputRead
env) = (# State# RealWorld
s, Int#
inputOffset #)
      | Bool
otherwise =
        let (# State# RealWorld
s', Word#
word #) = Addr# -> Int# -> State# RealWorld -> (# State# RealWorld, Word# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Word# #)
readWord8OffAddr# (InputRead -> Addr#
addr InputRead
env) Int#
inputOffset State# RealWorld
s
         in case Word# -> Word8
W8# Word#
word of
              Word8
40 -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'
              Word8
0x20 -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'
              Word8
0x0A -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'
              Word8
0x0D -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'
              Word8
0x09 -> Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
go (Int#
inputOffset Int# -> Int# -> Int#
+# Int#
1#) State# RealWorld
s'
              Word8
_ -> (# State# RealWorld
s', Int#
inputOffset #)
    {-# INLINE go #-}
{-# INLINE skipWhitespaceCB #-}

signed :: (Monoid err, Num a) => Parser err a -> Parser err a
signed :: Parser err a -> Parser err a
signed Parser err a
parser = Parser err a
withSign Parser err a -> Parser err a -> Parser err a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err a
parser
  where
    withSign :: Parser err a
withSign = do
      Bool
r <- (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
43 Parser err () -> Bool -> Parser err Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) Parser err Bool -> Parser err Bool -> Parser err Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
45 Parser err () -> Bool -> Parser err Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False)
      if Bool
r
        then a -> a
forall a. Num a => a -> a
negate (a -> a) -> Parser err a -> Parser err a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser err a
parser
        else Parser err a
parser
{-# INLINE signed #-}

orNegative :: (Monoid err, Num a) => Parser err a -> Parser err a
orNegative :: Parser err a -> Parser err a
orNegative Parser err a
parse =
  (Word8 -> Parser err ()
forall err. Word8 -> Parser err ()
specificWord Word8
45 Parser err () -> Parser err a -> Parser err a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (a -> a
forall a. Num a => a -> a
negate (a -> a) -> Parser err a -> Parser err a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser err a
parse))
    Parser err a -> Parser err a -> Parser err a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser err a
parse
{-# INLINE orNegative #-}

-- | Parse an integral number with possible leading zeros.
parseIntegral :: forall err i. (Monoid err, Integral i) => Parser err (Int, i)
parseIntegral :: Parser err (Int, i)
parseIntegral = Int -> i -> Parser err (Int, i)
forall err i.
(Monoid err, Integral i) =>
Int -> i -> Parser err (Int, i)
parseIntegralGo Int
0 i
0
{-# INLINE parseIntegral #-}

parseIntegralNoLeadingZero :: forall err i. (Monoid err, Integral i) => Parser err (Int, i)
parseIntegralNoLeadingZero :: Parser err (Int, i)
parseIntegralNoLeadingZero = do
  Word8
w <- Parser err Word8
forall err. Parser err Word8
word
  if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
49 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57
    then Int -> i -> Parser err (Int, i)
forall err i.
(Monoid err, Integral i) =>
Int -> i -> Parser err (Int, i)
parseIntegralGo Int
1 (Word8 -> i
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> i) -> Word8 -> i
forall a b. (a -> b) -> a -> b
$ Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48)
    else Parser err (Int, i)
forall err a. Parser err a
failParse
{-# INLINE parseIntegralNoLeadingZero #-}

parseIntegralGo :: (Monoid err, Integral i) => Int -> i -> Parser err (Int, i)
parseIntegralGo :: Int -> i -> Parser err (Int, i)
parseIntegralGo Int
digits i
acc = do
  Maybe Word8
r <- Parser err (Maybe Word8)
forall err. Parser err (Maybe Word8)
peekWordMaybe
  case Maybe Word8
r of
    Maybe Word8
Nothing -> (Int, i) -> Parser err (Int, i)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
digits, i
acc)
    Just !Word8
w
      | Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 -> do
        let !accd :: b
accd = Word8 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> b) -> Word8 -> b
forall a b. (a -> b) -> a -> b
$ Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
- Word8
48
        let !after :: i
after = (i
acc i -> i -> i
forall a. Num a => a -> a -> a
* i
10) i -> i -> i
forall a. Num a => a -> a -> a
+ i
forall b. Num b => b
accd
        if i
after i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 -- checks for overflow.
          then Parser err (Int, i)
forall err a. Parser err a
failParse
          else Parser err Word8
forall err. Parser err Word8
word Parser err Word8 -> Parser err (Int, i) -> Parser err (Int, i)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> i -> Parser err (Int, i)
forall err i.
(Monoid err, Integral i) =>
Int -> i -> Parser err (Int, i)
parseIntegralGo (Int
digits Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) i
after
      | Bool
otherwise -> Parser err (Int, i)
forall err a. Parser err a
failParse
{-# SPECIALIZE parseIntegralGo :: (Monoid err) => Int -> Int -> Parser err (Int, Int) #-}
{-# SPECIALIZE parseIntegralGo :: (Monoid err) => Int -> Integer -> Parser err (Int, Integer) #-}

takeWord8Cont :: (Semigroup err) => (Word8 -> Bool) -> (BS.ByteString -> a) -> Parser err a
takeWord8Cont :: (Word8 -> Bool) -> (ByteString -> a) -> Parser err a
takeWord8Cont Word8 -> Bool
cb ByteString -> a
cont = do
  ForeignPtr Word8
ptr <- Parser err (ForeignPtr Word8)
forall err. Parser err (ForeignPtr Word8)
parsedPtr
  Int
offsetBefore <- Parser err Int
forall err. Parser err Int
currentOffset
  (Word8 -> Bool) -> Parser err ()
forall err. (Word8 -> Bool) -> Parser err ()
skipWord8 Word8 -> Bool
cb
  Int
offsetAfter <- Parser err Int
forall err. Parser err Int
currentOffset
  pure $ ByteString -> a
cont (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
ptr Int
offsetBefore (Int
offsetAfter Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offsetBefore))
{-# INLINE takeWord8Cont #-}

takeWord8 :: (Semigroup err) => (Word8 -> Bool) -> Parser err BS.ByteString
takeWord8 :: (Word8 -> Bool) -> Parser err ByteString
takeWord8 Word8 -> Bool
cb = (Word8 -> Bool)
-> (ByteString -> ByteString) -> Parser err ByteString
forall err a.
Semigroup err =>
(Word8 -> Bool) -> (ByteString -> a) -> Parser err a
takeWord8Cont Word8 -> Bool
cb ByteString -> ByteString
forall a. a -> a
id

takeWord81 :: (Semigroup err) => (Word8 -> Bool) -> Parser err BS.ByteString
takeWord81 :: (Word8 -> Bool) -> Parser err ByteString
takeWord81 Word8 -> Bool
cb = (Word8 -> Bool)
-> (ByteString -> ByteString) -> Parser err ByteString
forall err a.
Semigroup err =>
(Word8 -> Bool) -> (ByteString -> a) -> Parser err a
takeWord81Cont Word8 -> Bool
cb ByteString -> ByteString
forall a. a -> a
id

takeWord81Cont ::
  Semigroup err =>
  (Word8 -> Bool) ->
  (ByteString -> b) ->
  Parser err b
takeWord81Cont :: (Word8 -> Bool) -> (ByteString -> b) -> Parser err b
takeWord81Cont Word8 -> Bool
cb ByteString -> b
cont = do
  ForeignPtr Word8
ptr <- Parser err (ForeignPtr Word8)
forall err. Parser err (ForeignPtr Word8)
parsedPtr
  Int
offsetBefore <- Parser err Int
forall err. Parser err Int
currentOffset
  (Word8 -> Bool) -> Parser err ()
forall err. (Word8 -> Bool) -> Parser err ()
skipWord8 Word8 -> Bool
cb
  Int
offsetAfter <- Parser err Int
forall err. Parser err Int
currentOffset
  let len :: Int
len = Int
offsetAfter Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offsetBefore
  Bool -> Parser err () -> Parser err ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1) Parser err ()
forall err a. Parser err a
failParse
  pure $ ByteString -> b
cont (ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
ptr Int
offsetBefore Int
len)

peekRest :: (Semigroup err) => Parser err BS.ByteString
peekRest :: Parser err ByteString
peekRest = do
  ForeignPtr Word8
ptr <- Parser err (ForeignPtr Word8)
forall err. Parser err (ForeignPtr Word8)
parsedPtr
  Int
offset <- Parser err Int
forall err. Parser err Int
currentOffset
  Int
es <- Parser err Int
forall err. Parser err Int
getEndOffset
  pure $ ForeignPtr Word8 -> Int -> Int -> ByteString
PS ForeignPtr Word8
ptr Int
offset (Int
es Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset)

chunkOfLength :: Int -> Parser err BS.ByteString
chunkOfLength :: Int -> Parser err ByteString
chunkOfLength len :: Int
len@(I# Int#
len') = Parser# RealWorld err ByteString -> Parser err ByteString
forall err res. Parser# RealWorld err res -> Parser err res
Parser (Parser# RealWorld err ByteString -> Parser err ByteString)
-> Parser# RealWorld err ByteString -> Parser err ByteString
forall a b. (a -> b) -> a -> b
$
  (InputRead
 -> InputState
 -> State# RealWorld
 -> (# State# RealWorld, ParseResult# err ByteString #))
-> Parser# RealWorld err ByteString
forall s err res.
(InputRead
 -> InputState -> State# s -> (# State# s, ParseResult# err res #))
-> Parser# s err res
Parser# ((InputRead
  -> InputState
  -> State# RealWorld
  -> (# State# RealWorld, ParseResult# err ByteString #))
 -> Parser# RealWorld err ByteString)
-> (InputRead
    -> InputState
    -> State# RealWorld
    -> (# State# RealWorld, ParseResult# err ByteString #))
-> Parser# RealWorld err ByteString
forall a b. (a -> b) -> a -> b
$ \InputRead
env is :: InputState
is@(InputState# Int#
off) State# RealWorld
s ->
    if
        | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> (# State# RealWorld
s, ParseResult# err ByteString
forall err res. ParseResult# err res
NoParseResult #)
        | Int# -> Bool
isTrue# (Int#
off Int# -> Int# -> Int#
+# Int#
len' Int# -> Int# -> Int#
># InputRead -> Int#
endOffset InputRead
env) -> (# State# RealWorld
s, ParseResult# err ByteString
forall err res. ParseResult# err res
NoParseResult #)
        | Bool
otherwise ->
          (#
            State# RealWorld
s,
            InputState -> AccumE err ByteString -> ParseResult# err ByteString
forall err res.
InputState -> AccumE err res -> ParseResult# err res
JustParseResult
              (Int# -> InputState
InputState# (Int#
off Int# -> Int# -> Int#
+# Int#
len'))
              (ByteString -> AccumE err ByteString
forall a err. a -> AccumE err a
AccumER (ByteString -> AccumE err ByteString)
-> ByteString -> AccumE err ByteString
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> Int -> ByteString
PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (InputRead -> Addr#
addr InputRead
env) (InputRead -> ForeignPtrContents
foreignPtr InputRead
env)) (Int# -> Int
I# Int#
off) Int
len)
          #)

parseChunk :: ByteString -> Parser err ()
parseChunk :: ByteString -> Parser err ()
parseChunk ByteString
chunk = Parser err (Maybe ()) -> Parser err ()
forall err a. Parser err (Maybe a) -> Parser err a
orFail (Parser err (Maybe ()) -> Parser err ())
-> Parser err (Maybe ()) -> Parser err ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ()
isChunkMaybe (ByteString -> Maybe ())
-> Parser err ByteString -> Parser err (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser err ByteString
forall err. Int -> Parser err ByteString
chunkOfLength (ByteString -> Int
BS.length ByteString
chunk)
  where
    isChunkMaybe :: ByteString -> Maybe ()
isChunkMaybe ByteString
c = if ByteString
chunk ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
c then () -> Maybe ()
forall a. a -> Maybe a
Just () else Maybe ()
forall a. Maybe a
Nothing

testParser :: Parser () (Word8, ByteString)
testParser :: Parser () (Word8, ByteString)
testParser = ((,) (Word8 -> ByteString -> (Word8, ByteString))
-> Parser () Word8 -> Parser () (ByteString -> (Word8, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () Word8
forall err. Parser err Word8
word Parser () (ByteString -> (Word8, ByteString))
-> Parser () ByteString -> Parser () (Word8, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Bool) -> Parser () ByteString
forall err.
Semigroup err =>
(Word8 -> Bool) -> Parser err ByteString
takeWord8 (\Word8
c -> Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
38 Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57)) Parser () (Word8, ByteString)
-> Parser () (Word8, ByteString) -> Parser () (Word8, ByteString)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((,) (Word8 -> ByteString -> (Word8, ByteString))
-> Parser () Word8 -> Parser () (ByteString -> (Word8, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser () Word8
forall err. Parser err Word8
word Parser () (ByteString -> (Word8, ByteString))
-> Parser () ByteString -> Parser () (Word8, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Parser () ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
forall a. Monoid a => a
mempty)