{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-}
-- |
-- Module      :  Data.Attoparsec.Internal
-- Copyright   :  Bryan O'Sullivan 2007-2015
-- License     :  BSD3
--
-- Maintainer  :  bos@serpentine.com
-- Stability   :  experimental
-- Portability :  unknown
--
-- Simple, efficient parser combinators, loosely based on the Parsec
-- library.

module Data.Attoparsec.Internal
    ( compareResults
    , prompt
    , demandInput
    , demandInput_
    , wantInput
    , endOfInput
    , atEnd
    , satisfyElem
    , concatReverse
    ) where

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
import Data.Monoid (Monoid, mconcat)
#endif
import Data.Attoparsec.Internal.Types
import Data.ByteString (ByteString)
import Data.Text (Text)
import Prelude hiding (succ)

-- | Compare two 'IResult' values for equality.
--
-- If both 'IResult's are 'Partial', the result will be 'Nothing', as
-- they are incomplete and hence their equality cannot be known.
-- (This is why there is no 'Eq' instance for 'IResult'.)
compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool
compareResults :: IResult i r -> IResult i r -> Maybe Bool
compareResults (Fail i
t0 [String]
ctxs0 String
msg0) (Fail i
t1 [String]
ctxs1 String
msg1) =
    Bool -> Maybe Bool
forall a. a -> Maybe a
Just (i
t0 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
t1 Bool -> Bool -> Bool
&& [String]
ctxs0 [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== [String]
ctxs1 Bool -> Bool -> Bool
&& String
msg0 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
msg1)
compareResults (Done i
t0 r
r0) (Done i
t1 r
r1) =
    Bool -> Maybe Bool
forall a. a -> Maybe a
Just (i
t0 i -> i -> Bool
forall a. Eq a => a -> a -> Bool
== i
t1 Bool -> Bool -> Bool
&& r
r0 r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
r1)
compareResults (Partial i -> IResult i r
_) (Partial i -> IResult i r
_) = Maybe Bool
forall a. Maybe a
Nothing
compareResults IResult i r
_ IResult i r
_ = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False

-- | Ask for input.  If we receive any, pass the augmented input to a
-- success continuation, otherwise to a failure continuation.
prompt :: Chunk t
       => State t -> Pos -> More
       -> (State t -> Pos -> More -> IResult t r)
       -> (State t -> Pos -> More -> IResult t r)
       -> IResult t r
prompt :: State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State t
t Pos
pos More
_more State t -> Pos -> More -> IResult t r
lose State t -> Pos -> More -> IResult t r
succ = (t -> IResult t r) -> IResult t r
forall i r. (i -> IResult i r) -> IResult i r
Partial ((t -> IResult t r) -> IResult t r)
-> (t -> IResult t r) -> IResult t r
forall a b. (a -> b) -> a -> b
$ \t
s ->
  if t -> Bool
forall c. Chunk c => c -> Bool
nullChunk t
s
  then State t -> Pos -> More -> IResult t r
lose State t
t Pos
pos More
Complete
  else State t -> Pos -> More -> IResult t r
succ (State t -> t -> State t
forall c. Chunk c => State c -> c -> State c
pappendChunk State t
t t
s) Pos
pos More
Incomplete
{-# SPECIALIZE prompt :: State ByteString -> Pos -> More
                      -> (State ByteString -> Pos -> More
                          -> IResult ByteString r)
                      -> (State ByteString -> Pos -> More
                          -> IResult ByteString r)
                      -> IResult ByteString r #-}
{-# SPECIALIZE prompt :: State Text -> Pos -> More
                      -> (State Text -> Pos -> More -> IResult Text r)
                      -> (State Text -> Pos -> More -> IResult Text r)
                      -> IResult Text r #-}

-- | Immediately demand more input via a 'Partial' continuation
-- result.
demandInput :: Chunk t => Parser t ()
demandInput :: Parser t ()
demandInput = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) () r
 -> IResult t r)
-> Parser t ()
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) () r
  -> IResult t r)
 -> Parser t ())
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) () r
    -> IResult t r)
-> Parser t ()
forall a b. (a -> b) -> a -> b
$ \State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) () r
succ ->
  case More
more of
    More
Complete -> Failure t (State t) r
lose State t
t Pos
pos More
more [] String
"not enough input"
    More
_ -> let lose' :: p -> Pos -> More -> IResult t r
lose' p
_ Pos
pos' More
more' = Failure t (State t) r
lose State t
t Pos
pos' More
more' [] String
"not enough input"
             succ' :: State t -> Pos -> More -> IResult t r
succ' State t
t' Pos
pos' More
more' = Success t (State t) () r
succ State t
t' Pos
pos' More
more' ()
         in State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State t
t Pos
pos More
more State t -> Pos -> More -> IResult t r
forall p. p -> Pos -> More -> IResult t r
lose' State t -> Pos -> More -> IResult t r
succ'
{-# SPECIALIZE demandInput :: Parser ByteString () #-}
{-# SPECIALIZE demandInput :: Parser Text () #-}

-- | Immediately demand more input via a 'Partial' continuation
-- result.  Return the new input.
demandInput_ :: Chunk t => Parser t t
demandInput_ :: Parser t t
demandInput_ = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) t r
 -> IResult t r)
-> Parser t t
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) t r
  -> IResult t r)
 -> Parser t t)
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) t r
    -> IResult t r)
-> Parser t t
forall a b. (a -> b) -> a -> b
$ \State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) t r
succ ->
  case More
more of
    More
Complete -> Failure t (State t) r
lose State t
t Pos
pos More
more [] String
"not enough input"
    More
_ -> (t -> IResult t r) -> IResult t r
forall i r. (i -> IResult i r) -> IResult i r
Partial ((t -> IResult t r) -> IResult t r)
-> (t -> IResult t r) -> IResult t r
forall a b. (a -> b) -> a -> b
$ \t
s ->
         if t -> Bool
forall c. Chunk c => c -> Bool
nullChunk t
s
         then Failure t (State t) r
lose State t
t Pos
pos More
Complete [] String
"not enough input"
         else Success t (State t) t r
succ (State t -> t -> State t
forall c. Chunk c => State c -> c -> State c
pappendChunk State t
t t
s) Pos
pos More
more t
s
{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}
{-# SPECIALIZE demandInput_ :: Parser Text Text #-}

-- | This parser always succeeds.  It returns 'True' if any input is
-- available either immediately or on demand, and 'False' if the end
-- of all input has been reached.
wantInput :: forall t . Chunk t => Parser t Bool
wantInput :: Parser t Bool
wantInput = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) Bool r
 -> IResult t r)
-> Parser t Bool
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) Bool r
  -> IResult t r)
 -> Parser t Bool)
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) Bool r
    -> IResult t r)
-> Parser t Bool
forall a b. (a -> b) -> a -> b
$ \State t
t Pos
pos More
more Failure t (State t) r
_lose Success t (State t) Bool r
succ ->
  case () of
    ()
_ | Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< t -> State t -> Pos
forall c. Chunk c => c -> State c -> Pos
atBufferEnd (t
forall a. HasCallStack => a
undefined :: t) State t
t -> Success t (State t) Bool r
succ State t
t Pos
pos More
more Bool
True
      | More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete -> Success t (State t) Bool r
succ State t
t Pos
pos More
more Bool
False
      | Bool
otherwise       -> let lose' :: State t -> Pos -> More -> IResult t r
lose' State t
t' Pos
pos' More
more' = Success t (State t) Bool r
succ State t
t' Pos
pos' More
more' Bool
False
                               succ' :: State t -> Pos -> More -> IResult t r
succ' State t
t' Pos
pos' More
more' = Success t (State t) Bool r
succ State t
t' Pos
pos' More
more' Bool
True
                           in State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
forall t r.
Chunk t =>
State t
-> Pos
-> More
-> (State t -> Pos -> More -> IResult t r)
-> (State t -> Pos -> More -> IResult t r)
-> IResult t r
prompt State t
t Pos
pos More
more State t -> Pos -> More -> IResult t r
lose' State t -> Pos -> More -> IResult t r
succ'
{-# INLINE wantInput #-}

-- | Match only if all input has been consumed.
endOfInput :: forall t . Chunk t => Parser t ()
endOfInput :: Parser t ()
endOfInput = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) () r
 -> IResult t r)
-> Parser t ()
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) () r
  -> IResult t r)
 -> Parser t ())
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) () r
    -> IResult t r)
-> Parser t ()
forall a b. (a -> b) -> a -> b
$ \State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) () r
succ ->
  case () of
    ()
_| Pos
pos Pos -> Pos -> Bool
forall a. Ord a => a -> a -> Bool
< t -> State t -> Pos
forall c. Chunk c => c -> State c -> Pos
atBufferEnd (t
forall a. HasCallStack => a
undefined :: t) State t
t -> Failure t (State t) r
lose State t
t Pos
pos More
more [] String
"endOfInput"
     | More
more More -> More -> Bool
forall a. Eq a => a -> a -> Bool
== More
Complete -> Success t (State t) () r
succ State t
t Pos
pos More
more ()
     | Bool
otherwise ->
       let lose' :: State t -> Pos -> More -> p -> p -> IResult t r
lose' State t
t' Pos
pos' More
more' p
_ctx p
_msg = Success t (State t) () r
succ State t
t' Pos
pos' More
more' ()
           succ' :: State t -> Pos -> More -> p -> IResult t r
succ' State t
t' Pos
pos' More
more' p
_a = Failure t (State t) r
lose State t
t' Pos
pos' More
more' [] String
"endOfInput"
       in  Parser t ()
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) () r
-> IResult t r
forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser Parser t ()
forall t. Chunk t => Parser t ()
demandInput State t
t Pos
pos More
more Failure t (State t) r
forall p p. State t -> Pos -> More -> p -> p -> IResult t r
lose' Success t (State t) () r
forall p. State t -> Pos -> More -> p -> IResult t r
succ'
{-# SPECIALIZE endOfInput :: Parser ByteString () #-}
{-# SPECIALIZE endOfInput :: Parser Text () #-}

-- | Return an indication of whether the end of input has been
-- reached.
atEnd :: Chunk t => Parser t Bool
atEnd :: Parser t Bool
atEnd = Bool -> Bool
not (Bool -> Bool) -> Parser t Bool -> Parser t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser t Bool
forall t. Chunk t => Parser t Bool
wantInput
{-# INLINE atEnd #-}

satisfySuspended :: forall t r . Chunk t
                 => (ChunkElem t -> Bool)
                 -> State t -> Pos -> More
                 -> Failure t (State t) r
                 -> Success t (State t) (ChunkElem t) r
                 -> IResult t r
satisfySuspended :: (ChunkElem t -> Bool)
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) (ChunkElem t) r
-> IResult t r
satisfySuspended ChunkElem t -> Bool
p State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) (ChunkElem t) r
succ =
    Parser t (ChunkElem t)
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) (ChunkElem t) r
-> IResult t r
forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser (Parser t ()
forall t. Chunk t => Parser t ()
demandInput Parser t () -> Parser t (ChunkElem t) -> Parser t (ChunkElem t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser t (ChunkElem t)
go) State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) (ChunkElem t) r
succ
  where go :: Parser t (ChunkElem t)
go = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) (ChunkElem t) r
 -> IResult t r)
-> Parser t (ChunkElem t)
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) (ChunkElem t) r
  -> IResult t r)
 -> Parser t (ChunkElem t))
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) (ChunkElem t) r
    -> IResult t r)
-> Parser t (ChunkElem t)
forall a b. (a -> b) -> a -> b
$ \State t
t' Pos
pos' More
more' Failure t (State t) r
lose' Success t (State t) (ChunkElem t) r
succ' ->
          case t -> Pos -> State t -> Maybe (ChunkElem t, Int)
forall c.
Chunk c =>
c -> Pos -> State c -> Maybe (ChunkElem c, Int)
bufferElemAt (t
forall a. HasCallStack => a
undefined :: t) Pos
pos' State t
t' of
            Just (ChunkElem t
e, Int
l) | ChunkElem t -> Bool
p ChunkElem t
e -> Success t (State t) (ChunkElem t) r
succ' State t
t' (Pos
pos' Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
l) More
more' ChunkElem t
e
                        | Bool
otherwise -> Failure t (State t) r
lose' State t
t' Pos
pos' More
more' [] String
"satisfyElem"
            Maybe (ChunkElem t, Int)
Nothing -> Parser t (ChunkElem t)
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) (ChunkElem t) r
-> IResult t r
forall i a.
Parser i a
-> forall r.
   State i
   -> Pos
   -> More
   -> Failure i (State i) r
   -> Success i (State i) a r
   -> IResult i r
runParser (Parser t ()
forall t. Chunk t => Parser t ()
demandInput Parser t () -> Parser t (ChunkElem t) -> Parser t (ChunkElem t)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser t (ChunkElem t)
go) State t
t' Pos
pos' More
more' Failure t (State t) r
lose' Success t (State t) (ChunkElem t) r
succ'
{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool)
                                -> State ByteString -> Pos -> More
                                -> Failure ByteString (State ByteString) r
                                -> Success ByteString (State ByteString)
                                           (ChunkElem ByteString) r
                                -> IResult ByteString r #-}
{-# SPECIALIZE satisfySuspended :: (ChunkElem Text -> Bool)
                                -> State Text -> Pos -> More
                                -> Failure Text (State Text) r
                                -> Success Text (State Text)
                                           (ChunkElem Text) r
                                -> IResult Text r #-}

-- | The parser @satisfyElem p@ succeeds for any chunk element for which the
-- predicate @p@ returns 'True'. Returns the element that is
-- actually parsed.
satisfyElem :: forall t . Chunk t
            => (ChunkElem t -> Bool) -> Parser t (ChunkElem t)
satisfyElem :: (ChunkElem t -> Bool) -> Parser t (ChunkElem t)
satisfyElem ChunkElem t -> Bool
p = (forall r.
 State t
 -> Pos
 -> More
 -> Failure t (State t) r
 -> Success t (State t) (ChunkElem t) r
 -> IResult t r)
-> Parser t (ChunkElem t)
forall i a.
(forall r.
 State i
 -> Pos
 -> More
 -> Failure i (State i) r
 -> Success i (State i) a r
 -> IResult i r)
-> Parser i a
Parser ((forall r.
  State t
  -> Pos
  -> More
  -> Failure t (State t) r
  -> Success t (State t) (ChunkElem t) r
  -> IResult t r)
 -> Parser t (ChunkElem t))
-> (forall r.
    State t
    -> Pos
    -> More
    -> Failure t (State t) r
    -> Success t (State t) (ChunkElem t) r
    -> IResult t r)
-> Parser t (ChunkElem t)
forall a b. (a -> b) -> a -> b
$ \State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) (ChunkElem t) r
succ ->
    case t -> Pos -> State t -> Maybe (ChunkElem t, Int)
forall c.
Chunk c =>
c -> Pos -> State c -> Maybe (ChunkElem c, Int)
bufferElemAt (t
forall a. HasCallStack => a
undefined :: t) Pos
pos State t
t of
      Just (ChunkElem t
e, Int
l) | ChunkElem t -> Bool
p ChunkElem t
e -> Success t (State t) (ChunkElem t) r
succ State t
t (Pos
pos Pos -> Pos -> Pos
forall a. Num a => a -> a -> a
+ Int -> Pos
Pos Int
l) More
more ChunkElem t
e
                  | Bool
otherwise -> Failure t (State t) r
lose State t
t Pos
pos More
more [] String
"satisfyElem"
      Maybe (ChunkElem t, Int)
Nothing -> (ChunkElem t -> Bool)
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) (ChunkElem t) r
-> IResult t r
forall t r.
Chunk t =>
(ChunkElem t -> Bool)
-> State t
-> Pos
-> More
-> Failure t (State t) r
-> Success t (State t) (ChunkElem t) r
-> IResult t r
satisfySuspended ChunkElem t -> Bool
p State t
t Pos
pos More
more Failure t (State t) r
lose Success t (State t) (ChunkElem t) r
succ
{-# INLINE satisfyElem #-}

-- | Concatenate a monoid after reversing its elements.  Used to
-- glue together a series of textual chunks that have been accumulated
-- \"backwards\".
concatReverse :: Monoid m => [m] -> m
concatReverse :: [m] -> m
concatReverse [m
x] = m
x
concatReverse [m]
xs  = [m] -> m
forall a. Monoid a => [a] -> a
mconcat ([m] -> [m]
forall a. [a] -> [a]
reverse [m]
xs)
{-# INLINE concatReverse #-}