{-# LANGUAGE LambdaCase #-}
module Data.ProtoLens.Encoding.Parser.Internal
( Parser(..)
, ParseResult(..)
) where
import Control.Monad (ap)
import Data.Word (Word8)
import Foreign.Ptr
newtype Parser a = Parser
{ unParser :: Ptr Word8
-> Ptr Word8
-> IO (ParseResult a)
}
data ParseResult a
= ParseSuccess
{ _newPos :: !(Ptr Word8)
, unParserResult :: a
}
| ParseFailure String
instance Functor ParseResult where
fmap f (ParseSuccess p x) = ParseSuccess p (f x)
fmap _ (ParseFailure s) = ParseFailure s
instance Functor Parser where
fmap f (Parser g) = Parser $ \end cur -> fmap f <$> g end cur
instance Applicative Parser where
pure x = Parser $ \_ cur -> return $ ParseSuccess cur x
(<*>) = ap
instance Monad Parser where
fail s = Parser $ \_ _ -> return $ ParseFailure s
return = pure
Parser f >>= g = Parser $ \end pos -> f end pos >>= \case
ParseSuccess pos' x -> unParser (g x) end pos'
ParseFailure s -> return $ ParseFailure s