{-# 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
    { 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
        { ParseResult a -> Ptr Word8
_newPos :: !(Ptr Word8) -- ^ New position in the input
        , ParseResult a -> a
unParserResult :: a
        }
    | ParseFailure String

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

instance Functor Parser where
    fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
g) = (Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b
forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser ((Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b)
-> (Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
end Ptr Word8
cur -> (a -> b) -> ParseResult a -> ParseResult b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ParseResult a -> ParseResult b)
-> IO (ParseResult a) -> IO (ParseResult b)
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 :: a -> Parser a
pure a
x = (Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser ((Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a)
-> (Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
_ Ptr Word8
cur -> ParseResult a -> IO (ParseResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseResult a -> IO (ParseResult a))
-> ParseResult a -> IO (ParseResult a)
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> a -> ParseResult a
forall a. Ptr Word8 -> a -> ParseResult a
ParseSuccess Ptr Word8
cur a
x
    <*> :: Parser (a -> b) -> Parser a -> Parser 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 :: a -> Parser a
return = a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Parser Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)
f >>= :: Parser a -> (a -> Parser b) -> Parser b
>>= a -> Parser b
g = (Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b
forall a.
(Ptr Word8 -> Ptr Word8 -> IO (ParseResult a)) -> Parser a
Parser ((Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b)
-> (Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)) -> Parser b
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 IO (ParseResult a)
-> (ParseResult a -> IO (ParseResult b)) -> IO (ParseResult b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        ParseSuccess Ptr Word8
pos' a
x -> Parser b -> Ptr Word8 -> Ptr Word8 -> IO (ParseResult b)
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 -> ParseResult b -> IO (ParseResult b)
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseResult b -> IO (ParseResult b))
-> ParseResult b -> IO (ParseResult b)
forall a b. (a -> b) -> a -> b
$ String -> ParseResult b
forall a. String -> ParseResult a
ParseFailure String
s

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