{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
-- | Definition of the parsing monad, plus internal
-- unsafe functions.
module Data.ProtoLens.Encoding.Parser.Internal
    ( Parser(..)
    , ParseResult(..)
    ) where

import Control.Monad (ap)
import qualified Control.Monad.Fail as Fail
import Data.Word (Word8)
import Foreign.Ptr

-- | A monad for parsing an input buffer.
newtype Parser a = Parser
    { forall a. Parser a -> Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
unParser :: Ptr Word8 -- End position of the input
               -> Ptr Word8 -- Current position in the input
               -> IO (ParseResult a)
    }

data ParseResult a
    = ParseSuccess
        { forall a. ParseResult a -> Ptr Word8
_newPos :: !(Ptr Word8) -- ^ New position in the input
        , forall a. ParseResult a -> a
unParserResult :: a
        }
    | ParseFailure String

instance Functor ParseResult where
    fmap :: forall a b. (a -> b) -> ParseResult a -> ParseResult b
fmap a -> b
f (ParseSuccess Ptr Word8
p a
x) = forall a. Ptr Word8 -> a -> ParseResult a
ParseSuccess Ptr Word8
p (a -> b
f a
x)
    fmap a -> b
_ (ParseFailure String
s) = forall a. String -> ParseResult a
ParseFailure String
s

instance Functor Parser where
    fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
g) = forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end Ptr Word8
cur -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
g Ptr Word8
end Ptr Word8
cur

instance Applicative Parser where
    pure :: forall a. a -> Parser a
pure a
x = forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Ptr Word8
_ Ptr Word8
cur -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Ptr Word8 -> a -> ParseResult a
ParseSuccess Ptr Word8
cur a
x
    <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) = forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Parser where
#if !MIN_VERSION_base(4,13,0)
    fail = Fail.fail
#endif
    return :: forall a. a -> Parser a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Parser Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
f >>= :: forall a b. Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end Ptr Word8
pos -> Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
f Ptr Word8
end Ptr Word8
pos forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ParseSuccess Ptr Word8
pos' a
x -> forall a. Parser a -> Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
unParser (a -> Parser b
g a
x) Ptr Word8
end Ptr Word8
pos'
        ParseFailure String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. String -> ParseResult a
ParseFailure String
s

instance Fail.MonadFail Parser where
    fail :: forall a. String -> Parser a
fail String
s = forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser forall a b. (a -> b) -> a -> b
$ \Ptr Word8
_ Ptr Word8
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. String -> ParseResult a
ParseFailure String
s