module Data.Attoparsec.Internal.Types
(
Parser(..)
, Input(..)
, Failure
, Success
, Pos(..)
, IResult(..)
, More(..)
, (<>)
) where
import Control.Applicative (Alternative(..), Applicative(..), (<$>))
import Control.DeepSeq (NFData(rnf))
import Control.Monad (MonadPlus(..))
import Data.ByteString (ByteString)
import Data.Monoid (Monoid(..))
import Data.Text (Text)
import Prelude hiding (getChar, succ)
import qualified Data.Attoparsec.ByteString.Buffer as B
import qualified Data.Attoparsec.Text.Buffer as T
newtype Pos = Pos { fromPos :: Int }
deriving (Eq, Ord, Show, Num)
data IResult i r =
Fail i [String] String
| Partial (i -> IResult i r)
| Done i r
instance (Show i, Show r) => Show (IResult i r) where
show (Fail t stk msg) =
unwords [ "Fail", show t, show stk, show msg]
show (Partial _) = "Partial _"
show (Done t r) = unwords ["Done", show t, show r]
instance (NFData i, NFData r) => NFData (IResult i r) where
rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg
rnf (Partial _) = ()
rnf (Done t r) = rnf t `seq` rnf r
instance Functor (IResult i) where
fmap _ (Fail t stk msg) = Fail t stk msg
fmap f (Partial k) = Partial (fmap f . k)
fmap f (Done t r) = Done t (f r)
newtype Parser i a = Parser {
runParser :: forall r. Input i =>
State i -> Pos -> More
-> Failure i (State i) r
-> Success i (State i) a r
-> IResult i r
}
class Input i where
type State i :: *
instance Input ByteString where
type State ByteString = B.Buffer
instance Input Text where
type State Text = T.Buffer
type Failure i t r = t -> Pos -> More -> [String] -> String
-> IResult i r
type Success i t a r = t -> Pos -> More -> a -> IResult i r
data More = Complete | Incomplete
deriving (Eq, Show)
instance Monoid More where
mappend c@Complete _ = c
mappend _ m = m
mempty = Incomplete
instance Monad (Parser i) where
fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
where msg = "Failed reading: " ++ err
return v = Parser $ \t pos more _lose succ -> succ t pos more v
m >>= k = Parser $ \t !pos more lose succ ->
let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ
in runParser m t pos more lose succ'
plus :: Parser i a -> Parser i a -> Parser i a
plus f g = Parser $ \t pos more lose succ ->
let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ
in runParser f t pos more lose' succ
instance MonadPlus (Parser i) where
mzero = fail "mzero"
mplus = plus
instance Functor (Parser i) where
fmap f p = Parser $ \t pos more lose succ ->
let succ' t' pos' more' a = succ t' pos' more' (f a)
in runParser p t pos more lose succ'
apP :: Parser i (a -> b) -> Parser i a -> Parser i b
apP d e = do
b <- d
a <- e
return (b a)
instance Applicative (Parser i) where
pure = return
(<*>) = apP
(*>) = (>>)
x <* y = x >>= \a -> y >> return a
instance Monoid (Parser i a) where
mempty = fail "mempty"
mappend = plus
instance Alternative (Parser i) where
empty = fail "empty"
(<|>) = plus
many v = many_v
where many_v = some_v <|> pure []
some_v = (:) <$> v <*> many_v
some v = some_v
where
many_v = some_v <|> pure []
some_v = (:) <$> v <*> many_v
(<>) :: (Monoid m) => m -> m -> m
(<>) = mappend