module Data.Attoparsec.Internal.Types
(
Parser(..)
, Failure
, Success
, Result(..)
, Input(..)
, Added(..)
, More(..)
, addS
, noAdds
, (+++)
) 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}
newtype Added = A {unA :: B.ByteString}
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)
addS :: Input -> Added -> More
-> Input -> Added -> More
-> (Input -> Added -> More -> r) -> r
addS i0 a0 m0 _i1 a1 m1 f =
let !i = I (unI i0 +++ unA a1)
a = A (unA a0 +++ unA a1)
!m = m0 <> m1
in f i a m
where
Complete <> _ = Complete
_ <> Complete = Complete
_ <> _ = 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
noAdds :: Input -> Added -> More
-> (Input -> Added -> More -> r) -> r
noAdds i0 _a0 m0 f = f i0 (A B.empty) m0
plus :: Parser a -> Parser a -> Parser a
plus a b = Parser $ \i0 a0 m0 kf ks ->
let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $
\ i2 a2 m2 -> runParser b i2 a2 m2 kf ks
in noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 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
#if MIN_VERSION_base(4,2,0)
(*>) = (>>)
x <* y = x >>= \a -> y >> return a
#endif
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
(+++) :: B.ByteString -> B.ByteString -> B.ByteString
(+++) = B.append