module Data.Attoparsec.Internal.Types
(
Parser(..)
, Failure
, Success
, Result(..)
, Input(..)
, Added(..)
, More(..)
, (<>)
) where
import Control.Applicative (Alternative(..), Applicative(..))
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Prelude hiding (getChar, take, takeWhile)
import qualified Data.ByteString.Char8 as B
data Result r = Fail B.ByteString [String] String
| Partial (B.ByteString -> Result r)
| Done B.ByteString r
instance Show r => Show (Result r) where
show (Fail bs stk msg) =
"Fail " ++ show bs ++ " " ++ show stk ++ " " ++ show msg
show (Partial _) = "Partial _"
show (Done bs r) = "Done " ++ show bs ++ " " ++ show r
instance (NFData r) => NFData (Result r) where
rnf (Fail _ _ _) = ()
rnf (Partial _) = ()
rnf (Done _ r) = rnf r
fmapR :: (a -> b) -> Result a -> Result b
fmapR _ (Fail st stk msg) = Fail st stk msg
fmapR f (Partial k) = Partial (fmapR f . k)
fmapR f (Done bs r) = Done bs (f r)
instance Functor Result where
fmap = fmapR
newtype Input = I {unI :: B.ByteString}
deriving (Show)
instance Monoid Input where
mempty = I B.empty
mappend (I a) (I b) = I (a <> b)
data Added = Dropped
| Added B.ByteString
deriving (Show)
instance Monoid Added where
mempty = Dropped
mappend a@Dropped _ = a
mappend a Dropped = a
mappend (Added a) (Added b) = Added (a <> b)
newtype Parser a = Parser {
runParser :: forall r. Input -> Added -> More
-> Failure r
-> Success a r
-> Result r
}
type Failure r = Input -> Added -> More -> [String] -> String -> Result r
type Success a r = Input -> Added -> More -> a -> Result r
data More = Complete | Incomplete
deriving (Eq, Show)
instance Monoid More where
mempty = Incomplete
mappend Complete _ = Complete
mappend _ Complete = Complete
mappend _ _ = Incomplete
bindP :: Parser a -> (a -> Parser b) -> Parser b
bindP m g =
Parser $ \i0 a0 m0 kf ks -> runParser m i0 a0 m0 kf $
\i1 a1 m1 a -> runParser (g a) i1 a1 m1 kf ks
returnP :: a -> Parser a
returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
instance Monad Parser where
return = returnP
(>>=) = bindP
fail = failDesc
plus :: Parser a -> Parser a -> Parser a
plus a b = Parser $ \i0 a0 m0 kf ks ->
let kf' i1 a1 m1 _ _ = runParser b i1 a1 m1 kf ks
in runParser a i0 a0 m0 kf' ks
instance MonadPlus Parser where
mzero = failDesc "mzero"
mplus = plus
fmapP :: (a -> b) -> Parser a -> Parser b
fmapP p m = Parser $ \i0 a0 m0 f k ->
runParser m i0 a0 m0 f $ \i1 a1 s1 a -> k i1 a1 s1 (p a)
instance Functor Parser where
fmap = fmapP
apP :: Parser (a -> b) -> Parser a -> Parser b
apP d e = do
b <- d
a <- e
return (b a)
instance Applicative Parser where
pure = returnP
(<*>) = apP
(*>) = (>>)
x <* y = x >>= \a -> y >> return a
instance Monoid (Parser a) where
mempty = failDesc "mempty"
mappend = plus
instance Alternative Parser where
empty = failDesc "empty"
(<|>) = plus
failDesc :: String -> Parser a
failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
where msg = "Failed reading: " ++ err
(<>) :: (Monoid a) => a -> a -> a
(<>) = mappend