{-# LANGUAGE CPP, BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
    Rank2Types, RecordWildCards, TypeFamilies #-}
-- |
-- Module      :  Data.Attoparsec.Internal.Types
-- 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.Types
    (
      Parser(..)
    , State
    , Failure
    , Success
    , Pos(..)
    , IResult(..)
    , More(..)
    , (<>)
    , Chunk(..)
    ) where

import Control.Applicative as App (Applicative(..), (<$>))
import Control.Applicative (Alternative(..))
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import qualified Control.Monad.Fail as Fail (MonadFail(..))
import Data.Monoid as Mon (Monoid(..))
import Data.Semigroup  (Semigroup(..))
import Data.Word (Word8)
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Internal (w2c)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Unsafe (Iter(..))
import Prelude hiding (succ)
import qualified Data.Attoparsec.ByteString.Buffer as B
import qualified Data.Attoparsec.Text.Buffer as T

newtype Pos = Pos { Pos -> Int
fromPos :: Int }
            deriving (Pos -> Pos -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c== :: Pos -> Pos -> Bool
Eq, Eq Pos
Pos -> Pos -> Bool
Pos -> Pos -> Ordering
Pos -> Pos -> Pos
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Pos -> Pos -> Pos
$cmin :: Pos -> Pos -> Pos
max :: Pos -> Pos -> Pos
$cmax :: Pos -> Pos -> Pos
>= :: Pos -> Pos -> Bool
$c>= :: Pos -> Pos -> Bool
> :: Pos -> Pos -> Bool
$c> :: Pos -> Pos -> Bool
<= :: Pos -> Pos -> Bool
$c<= :: Pos -> Pos -> Bool
< :: Pos -> Pos -> Bool
$c< :: Pos -> Pos -> Bool
compare :: Pos -> Pos -> Ordering
$ccompare :: Pos -> Pos -> Ordering
Ord, Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pos] -> ShowS
$cshowList :: [Pos] -> ShowS
show :: Pos -> String
$cshow :: Pos -> String
showsPrec :: Int -> Pos -> ShowS
$cshowsPrec :: Int -> Pos -> ShowS
Show, Integer -> Pos
Pos -> Pos
Pos -> Pos -> Pos
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Pos
$cfromInteger :: Integer -> Pos
signum :: Pos -> Pos
$csignum :: Pos -> Pos
abs :: Pos -> Pos
$cabs :: Pos -> Pos
negate :: Pos -> Pos
$cnegate :: Pos -> Pos
* :: Pos -> Pos -> Pos
$c* :: Pos -> Pos -> Pos
- :: Pos -> Pos -> Pos
$c- :: Pos -> Pos -> Pos
+ :: Pos -> Pos -> Pos
$c+ :: Pos -> Pos -> Pos
Num)

-- | The result of a parse.  This is parameterised over the type @i@
-- of string that was processed.
--
-- This type is an instance of 'Functor', where 'fmap' transforms the
-- value in a 'Done' result.
data IResult i r =
    Fail i [String] String
    -- ^ The parse failed.  The @i@ parameter is the input that had
    -- not yet been consumed when the failure occurred.  The
    -- @[@'String'@]@ is a list of contexts in which the error
    -- occurred.  The 'String' is the message describing the error, if
    -- any.
  | Partial (i -> IResult i r)
    -- ^ Supply this continuation with more input so that the parser
    -- can resume.  To indicate that no more input is available, pass
    -- an empty string to the continuation.
    --
    -- __Note__: if you get a 'Partial' result, do not call its
    -- continuation more than once.
  | Done i r
    -- ^ The parse succeeded.  The @i@ parameter is the input that had
    -- not yet been consumed (if any) when the parse succeeded.

instance (Show i, Show r) => Show (IResult i r) where
    showsPrec :: Int -> IResult i r -> ShowS
showsPrec Int
d IResult i r
ir = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      case IResult i r
ir of
        (Fail i
t [String]
stk String
msg) -> String -> ShowS
showString String
"Fail" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
f i
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
f [String]
stk forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
f String
msg
        (Partial i -> IResult i r
_)      -> String -> ShowS
showString String
"Partial _"
        (Done i
t r
r)       -> String -> ShowS
showString String
"Done" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
f i
t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
f r
r
      where f :: Show a => a -> ShowS
            f :: forall a. Show a => a -> ShowS
f a
x = Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
x

instance (NFData i, NFData r) => NFData (IResult i r) where
    rnf :: IResult i r -> ()
rnf (Fail i
t [String]
stk String
msg) = forall a. NFData a => a -> ()
rnf i
t seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf [String]
stk seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf String
msg
    rnf (Partial i -> IResult i r
_)  = ()
    rnf (Done i
t r
r)   = forall a. NFData a => a -> ()
rnf i
t seq :: forall a b. a -> b -> b
`seq` forall a. NFData a => a -> ()
rnf r
r
    {-# INLINE rnf #-}

instance Functor (IResult i) where
    fmap :: forall a b. (a -> b) -> IResult i a -> IResult i b
fmap a -> b
_ (Fail i
t [String]
stk String
msg) = forall i r. i -> [String] -> String -> IResult i r
Fail i
t [String]
stk String
msg
    fmap a -> b
f (Partial i -> IResult i a
k)      = forall i r. (i -> IResult i r) -> IResult i r
Partial (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> IResult i a
k)
    fmap a -> b
f (Done i
t a
r)   = forall i r. i -> r -> IResult i r
Done i
t (a -> b
f a
r)

-- | The core parser type.  This is parameterised over the type @i@
-- of string being processed.
--
-- This type is an instance of the following classes:
--
-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an
--   error message.
--
-- * 'Functor' and 'Applicative', which follow the usual definitions.
--
-- * 'MonadPlus', where 'mzero' fails (with no error message) and
--   'mplus' executes the right-hand parser if the left-hand one
--   fails.  When the parser on the right executes, the input is reset
--   to the same state as the parser on the left started with. (In
--   other words, attoparsec is a backtracking parser that supports
--   arbitrary lookahead.)
--
-- * 'Alternative', which follows 'MonadPlus'.
newtype Parser i a = Parser {
      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 :: forall r.
                   State i -> Pos -> More
                -> Failure i (State i)   r
                -> Success i (State i) a r
                -> IResult i r
    }

type family State i
type instance State ByteString = B.Buffer
type instance State Text = T.Buffer

type Failure i t   r = t -> Pos -> More -> [String] -> String
                       -> IResult i r
type Success i t a r = t -> Pos -> More -> a -> IResult i r

-- | Have we read all available input?
data More = Complete | Incomplete
            deriving (More -> More -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: More -> More -> Bool
$c/= :: More -> More -> Bool
== :: More -> More -> Bool
$c== :: More -> More -> Bool
Eq, Int -> More -> ShowS
[More] -> ShowS
More -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [More] -> ShowS
$cshowList :: [More] -> ShowS
show :: More -> String
$cshow :: More -> String
showsPrec :: Int -> More -> ShowS
$cshowsPrec :: Int -> More -> ShowS
Show)

instance Semigroup More where
    c :: More
c@More
Complete <> :: More -> More -> More
<> More
_ = More
c
    More
_          <> More
m = More
m

instance Mon.Monoid More where
    mappend :: More -> More -> More
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: More
mempty  = More
Incomplete

instance Monad (Parser i) where
#if !(MIN_VERSION_base(4,13,0))
    fail = Fail.fail
    {-# INLINE fail #-}
#endif

    return :: forall a. a -> Parser i a
return = forall (f :: * -> *) a. Applicative f => a -> f a
App.pure
    {-# INLINE return #-}

    Parser i a
m >>= :: forall a b. Parser i a -> (a -> Parser i b) -> Parser i b
>>= a -> Parser i b
k = 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 a b. (a -> b) -> a -> b
$ \State i
t !Pos
pos More
more Failure i (State i) r
lose Success i (State i) b r
succ ->
        let succ' :: State i -> Pos -> More -> a -> IResult i r
succ' State i
t' !Pos
pos' More
more' a
a = 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 (a -> Parser i b
k a
a) State i
t' Pos
pos' More
more' Failure i (State i) r
lose Success i (State i) b r
succ
        in 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 i a
m State i
t Pos
pos More
more Failure i (State i) r
lose State i -> Pos -> More -> a -> IResult i r
succ'
    {-# INLINE (>>=) #-}

    >> :: forall a b. Parser i a -> Parser i b -> Parser i b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}


instance Fail.MonadFail (Parser i) where
    fail :: forall a. String -> Parser i a
fail String
err = 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 a b. (a -> b) -> a -> b
$ \State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) a r
_succ -> Failure i (State i) r
lose State i
t Pos
pos More
more [] String
msg
      where msg :: String
msg = String
"Failed reading: " forall a. [a] -> [a] -> [a]
++ String
err
    {-# INLINE fail #-}

plus :: Parser i a -> Parser i a -> Parser i a
plus :: forall i a. Parser i a -> Parser i a -> Parser i a
plus Parser i a
f Parser i a
g = 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 a b. (a -> b) -> a -> b
$ \State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) a r
succ ->
  let lose' :: Failure i (State i) r
lose' State i
t' Pos
_pos' More
more' [String]
_ctx String
_msg = 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 i a
g State i
t' Pos
pos More
more' Failure i (State i) r
lose Success i (State i) a r
succ
  in 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 i a
f State i
t Pos
pos More
more Failure i (State i) r
lose' Success i (State i) a r
succ

instance MonadPlus (Parser i) where
    mzero :: forall a. Parser i a
mzero = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mzero"
    {-# INLINE mzero #-}
    mplus :: forall a. Parser i a -> Parser i a -> Parser i a
mplus = forall i a. Parser i a -> Parser i a -> Parser i a
plus

instance Functor (Parser i) where
    fmap :: forall a b. (a -> b) -> Parser i a -> Parser i b
fmap a -> b
f Parser i a
p = 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 a b. (a -> b) -> a -> b
$ \State i
t Pos
pos More
more Failure i (State i) r
lose Success i (State i) b r
succ ->
      let succ' :: State i -> Pos -> More -> a -> IResult i r
succ' State i
t' Pos
pos' More
more' a
a = Success i (State i) b r
succ State i
t' Pos
pos' More
more' (a -> b
f a
a)
      in 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 i a
p State i
t Pos
pos More
more Failure i (State i) r
lose State i -> Pos -> More -> a -> IResult i r
succ'
    {-# INLINE fmap #-}

apP :: Parser i (a -> b) -> Parser i a -> Parser i b
apP :: forall i a b. Parser i (a -> b) -> Parser i a -> Parser i b
apP Parser i (a -> b)
d Parser i a
e = do
  a -> b
b <- Parser i (a -> b)
d
  a
a <- Parser i a
e
  forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
b a
a)
{-# INLINE apP #-}

instance Applicative (Parser i) where
    pure :: forall a. a -> Parser i a
pure a
v = 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 a b. (a -> b) -> a -> b
$ \State i
t !Pos
pos More
more Failure i (State i) r
_lose Success i (State i) a r
succ -> Success i (State i) a r
succ State i
t Pos
pos More
more a
v
    {-# INLINE pure #-}
    <*> :: forall a b. Parser i (a -> b) -> Parser i a -> Parser i b
(<*>)  = forall i a b. Parser i (a -> b) -> Parser i a -> Parser i b
apP
    {-# INLINE (<*>) #-}
    Parser i a
m *> :: forall a b. Parser i a -> Parser i b -> Parser i b
*> Parser i b
k = Parser i a
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
_ -> Parser i b
k
    {-# INLINE (*>) #-}
    Parser i a
x <* :: forall a b. Parser i a -> Parser i b -> Parser i a
<* Parser i b
y = Parser i a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> Parser i b
y forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    {-# INLINE (<*) #-}

instance Semigroup (Parser i a) where
    <> :: Parser i a -> Parser i a -> Parser i a
(<>) = forall i a. Parser i a -> Parser i a -> Parser i a
plus
    {-# INLINE (<>) #-}

instance Monoid (Parser i a) where
    mempty :: Parser i a
mempty  = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"mempty"
    {-# INLINE mempty #-}
    mappend :: Parser i a -> Parser i a -> Parser i a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

instance Alternative (Parser i) where
    empty :: forall a. Parser i a
empty = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"empty"
    {-# INLINE empty #-}

    <|> :: forall a. Parser i a -> Parser i a -> Parser i a
(<|>) = forall i a. Parser i a -> Parser i a -> Parser i a
plus
    {-# INLINE (<|>) #-}

    many :: forall a. Parser i a -> Parser i [a]
many Parser i a
v = Parser i [a]
many_v
      where
        many_v :: Parser i [a]
many_v = Parser i [a]
some_v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: Parser i [a]
some_v = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser i a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser i [a]
many_v
    {-# INLINE many #-}

    some :: forall a. Parser i a -> Parser i [a]
some Parser i a
v = Parser i [a]
some_v
      where
        many_v :: Parser i [a]
many_v = Parser i [a]
some_v forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        some_v :: Parser i [a]
some_v = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser i a
v forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser i [a]
many_v
    {-# INLINE some #-}

-- | A common interface for input chunks.
class Monoid c => Chunk c where
  type ChunkElem c
  -- | Test if the chunk is empty.
  nullChunk :: c -> Bool
  -- | Append chunk to a buffer.
  pappendChunk :: State c -> c -> State c
  -- | Position at the end of a buffer. The first argument is ignored.
  atBufferEnd :: c -> State c -> Pos
  -- | Return the buffer element at the given position along with its length.
  bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)
  -- | Map an element to the corresponding character.
  --   The first argument is ignored.
  chunkElemToChar :: c -> ChunkElem c -> Char

instance Chunk ByteString where
  type ChunkElem ByteString = Word8
  nullChunk :: ByteString -> Bool
nullChunk = ByteString -> Bool
BS.null
  {-# INLINE nullChunk #-}
  pappendChunk :: State ByteString -> ByteString -> State ByteString
pappendChunk = Buffer -> ByteString -> Buffer
B.pappend
  {-# INLINE pappendChunk #-}
  atBufferEnd :: ByteString -> State ByteString -> Pos
atBufferEnd ByteString
_ = Int -> Pos
Pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
B.length
  {-# INLINE atBufferEnd #-}
  bufferElemAt :: ByteString
-> Pos -> State ByteString -> Maybe (ChunkElem ByteString, Int)
bufferElemAt ByteString
_ (Pos Int
i) State ByteString
buf
    | Int
i forall a. Ord a => a -> a -> Bool
< Buffer -> Int
B.length State ByteString
buf = forall a. a -> Maybe a
Just (Buffer -> Int -> Word8
B.unsafeIndex State ByteString
buf Int
i, Int
1)
    | Bool
otherwise = forall a. Maybe a
Nothing
  {-# INLINE bufferElemAt #-}
  chunkElemToChar :: ByteString -> ChunkElem ByteString -> Char
chunkElemToChar ByteString
_ = Word8 -> Char
w2c
  {-# INLINE chunkElemToChar #-}

instance Chunk Text where
  type ChunkElem Text = Char
  nullChunk :: Text -> Bool
nullChunk = Text -> Bool
Text.null
  {-# INLINE nullChunk #-}
  pappendChunk :: State Text -> Text -> State Text
pappendChunk = Buffer -> Text -> Buffer
T.pappend
  {-# INLINE pappendChunk #-}
  atBufferEnd :: Text -> State Text -> Pos
atBufferEnd Text
_ = Int -> Pos
Pos forall b c a. (b -> c) -> (a -> b) -> a -> c
. Buffer -> Int
T.length
  {-# INLINE atBufferEnd #-}
  bufferElemAt :: Text -> Pos -> State Text -> Maybe (ChunkElem Text, Int)
bufferElemAt Text
_ (Pos Int
i) State Text
buf
    | Int
i forall a. Ord a => a -> a -> Bool
< Buffer -> Int
T.length State Text
buf = let Iter Char
c Int
l = Buffer -> Int -> Iter
T.iter State Text
buf Int
i in forall a. a -> Maybe a
Just (Char
c, Int
l)
    | Bool
otherwise = forall a. Maybe a
Nothing
  {-# INLINE bufferElemAt #-}
  chunkElemToChar :: Text -> ChunkElem Text -> Char
chunkElemToChar Text
_ = forall a. a -> a
id
  {-# INLINE chunkElemToChar #-}