|
|
{-# 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 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 (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) =
Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1)
compareResults (Done t0 r0) (Done t1 r1) =
Just (t0 == t1 && r0 == r1)
compareResults (Partial _) (Partial _) = Nothing
compareResults _ _ = Just 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 t pos _more lose succ = Partial $ \s ->
if nullChunk s
then lose t pos Complete
else succ (pappendChunk t s) pos Incomplete
{-# SPECIALIZE prompt :: State ByteString -> Pos -> More
-> (State ByteString -> Pos -> More
-> IResult ByteString r)
-> (State ByteString -> Pos -> More
-> IResult ByteString r)
-> IResult ByteString r #-}
-- | Immediately demand more input via a 'Partial' continuation
-- result.
demandInput :: Chunk t => Parser t ()
demandInput = Parser $ \t pos more lose succ ->
case more of
Complete -> lose t pos more [] "not enough input"
_ -> let lose' _ pos' more' = lose t pos' more' [] "not enough input"
succ' t' pos' more' = succ t' pos' more' ()
in prompt t pos more lose' succ'
{-# SPECIALIZE demandInput :: Parser ByteString () #-}
-- | Immediately demand more input via a 'Partial' continuation
-- result. Return the new input.
demandInput_ :: Chunk t => Parser t t
demandInput_ = Parser $ \t pos more lose succ ->
case more of
Complete -> lose t pos more [] "not enough input"
_ -> Partial $ \s ->
if nullChunk s
then lose t pos Complete [] "not enough input"
else succ (pappendChunk t s) pos more s
{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-}
-- | 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 pos more _lose succ ->
case () of
_ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True
| more == Complete -> succ t pos more False
| otherwise -> let lose' t' pos' more' = succ t' pos' more' False
succ' t' pos' more' = succ t' pos' more' True
in prompt t pos more lose' succ'
{-# INLINE wantInput #-}
-- | Match only if all input has been consumed.
endOfInput :: forall t . Chunk t => Parser t ()
endOfInput = Parser $ \t pos more lose succ ->
case () of
_| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput"
| more == Complete -> succ t pos more ()
| otherwise ->
let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()
succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"
in runParser demandInput t pos more lose' succ'
{-# SPECIALIZE endOfInput :: Parser ByteString () #-}
-- | Return an indication of whether the end of input has been
-- reached.
atEnd :: Chunk t => Parser t Bool
atEnd = not <$> 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 p t pos more lose succ =
runParser (demandInput >> go) t pos more lose succ
where go = Parser $ \t' pos' more' lose' succ' ->
case bufferElemAt (undefined :: t) pos' t' of
Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e
| otherwise -> lose' t' pos' more' [] "satisfyElem"
Nothing -> runParser (demandInput >> go) t' pos' more' lose' 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 #-}
-- | 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 p = Parser $ \t pos more lose succ ->
case bufferElemAt (undefined :: t) pos t of
Just (e, l) | p e -> succ t (pos + Pos l) more e
| otherwise -> lose t pos more [] "satisfyElem"
Nothing -> satisfySuspended p t pos more lose 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 [x] = x
concatReverse xs = mconcat (reverse xs)
{-# INLINE concatReverse #-}
|