Add ByteString version of Attoparsec

1 files changed, 227 insertions, 0 deletions

diff --git a/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs b/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs
new file mode 100644
index 00000000..e47e5c9e
--- /dev/null
+++ b/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE BangPatterns, CPP, GeneralizedNewtypeDeriving, OverloadedStrings,
+    Rank2Types, RecordWildCards #-}
+-- |
+-- Module      :  Data.Attoparsec.Internal.Types
+-- Copyright   :  Bryan O'Sullivan 2007-2011
+-- License     :  BSD3
+--
+-- Maintainer  :  bos@serpentine.com
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Simple, efficient parser combinators, loosely based on the Parsec
+-- library.
+
+module Data.Attoparsec.Internal.Types
+    (
+      Parser(..)
+    , Failure
+    , Success
+    , IResult(..)
+    , Input(..)
+    , Added(..)
+    , More(..)
+    , addS
+    , (<>)
+    ) 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)
+
+-- | The result of a parse.  This is parameterised over the type @t@
+-- of string that was processed.
+--
+-- This type is an instance of 'Functor', where 'fmap' transforms the
+-- value in a 'Done' result.
+data IResult t r = Fail t [String] String
+                 -- ^ The parse failed.  The 't' parameter is the
+                 -- input that had not yet been consumed when the
+                 -- failure occurred.  The @[@'String'@]@ is a list of
+                 -- contexts in which the error occurred.  The
+                 -- 'String' is the message describing the error, if
+                 -- any.
+                 | Partial (t -> IResult t r)
+                 -- ^ Supply this continuation with more input so that
+                 -- the parser can resume.  To indicate that no more
+                 -- input is available, use an empty string.
+                 | Done t r
+                 -- ^ The parse succeeded.  The 't' parameter is the
+                 -- input that had not yet been consumed (if any) when
+                 -- the parse succeeded.
+
+instance (Show t, Show r) => Show (IResult t r) where
+    show (Fail t stk msg) =
+        "Fail " ++ show t ++ " " ++ show stk ++ " " ++ show msg
+    show (Partial _)      = "Partial _"
+    show (Done t r)       = "Done " ++ show t ++ " " ++ show r
+
+instance (NFData t, NFData r) => NFData (IResult t 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
+    {-# INLINE rnf #-}
+
+fmapR :: (a -> b) -> IResult t a -> IResult t b
+fmapR _ (Fail t stk msg) = Fail t stk msg
+fmapR f (Partial k)       = Partial (fmapR f . k)
+fmapR f (Done t r)       = Done t (f r)
+
+instance Functor (IResult t) where
+    fmap = fmapR
+    {-# INLINE fmap #-}
+
+newtype Input t = I {unI :: t} deriving (Monoid)
+newtype Added t = A {unA :: t} deriving (Monoid)
+
+-- | The core parser type.  This is parameterised over the type @t@ of
+-- string being processed.
+--
+-- This type is an instance of the following classes:
+--
+-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an
+--   error message.
+--
+-- * 'Functor' and 'Applicative', which follow the usual definitions.
+--
+-- * 'MonadPlus', where 'mzero' fails (with no error message) and
+--   'mplus' executes the right-hand parser if the left-hand one
+--   fails.  When the parser on the right executes, the input is reset
+--   to the same state as the parser on the left started with. (In
+--   other words, Attoparsec is a backtracking parser that supports
+--   arbitrary lookahead.)
+--
+-- * 'Alternative', which follows 'MonadPlus'.
+newtype Parser t a = Parser {
+      runParser :: forall r. Input t -> Added t -> More
+                -> Failure t   r
+                -> Success t a r
+                -> IResult t r
+    }
+
+type Failure t   r = Input t -> Added t -> More -> [String] -> String
+                   -> IResult t r
+type Success t a r = Input t -> Added t -> More -> a -> IResult t r
+
+-- | Have we read all available input?
+data More = Complete | Incomplete
+            deriving (Eq, Show)
+
+instance Monoid More where
+    mappend c@Complete _ = c
+    mappend _ m          = m
+    mempty               = Incomplete
+
+addS :: (Monoid t) =>
+        Input t -> Added t -> More
+     -> Input t -> Added t -> More
+     -> (Input t -> Added t -> More -> r) -> r
+addS i0 a0 m0 _i1 a1 m1 f =
+    let !i = i0 <> I (unA a1)
+        a  = a0 <> a1
+        !m = m0 <> m1
+    in f i a m
+{-# INLINE addS #-}
+
+bindP :: Parser t a -> (a -> Parser t b) -> Parser t 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
+{-# INLINE bindP #-}
+
+returnP :: a -> Parser t a
+returnP a = Parser (\i0 a0 m0 _kf ks -> ks i0 a0 m0 a)
+{-# INLINE returnP #-}
+
+instance Monad (Parser t) where
+    return = returnP
+    (>>=)  = bindP
+    fail   = failDesc
+
+noAdds :: (Monoid t) =>
+          Input t -> Added t -> More
+       -> (Input t -> Added t -> More -> r) -> r
+noAdds i0 _a0 m0 f = f i0 mempty m0
+{-# INLINE noAdds #-}
+
+plus :: (Monoid t) => Parser t a -> Parser t a -> Parser t 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
+               ks' i1 a1 m1 = ks i1 (a0 <> a1) m1
+           in  noAdds i0 a0 m0 $ \i2 a2 m2 -> runParser a i2 a2 m2 kf' ks'
+{-# INLINE plus #-}
+
+instance (Monoid t) => MonadPlus (Parser t) where
+    mzero = failDesc "mzero"
+    {-# INLINE mzero #-}
+    mplus = plus
+
+fmapP :: (a -> b) -> Parser t a -> Parser t 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)
+{-# INLINE fmapP #-}
+
+instance Functor (Parser t) where
+    fmap = fmapP
+    {-# INLINE fmap #-}
+
+apP :: Parser t (a -> b) -> Parser t a -> Parser t b
+apP d e = do
+  b <- d
+  a <- e
+  return (b a)
+{-# INLINE apP #-}
+
+instance Applicative (Parser t) where
+    pure   = returnP
+    {-# INLINE pure #-}
+    (<*>)  = apP
+    {-# INLINE (<*>) #-}
+
+#if MIN_VERSION_base(4,2,0)
+    -- These definitions are equal to the defaults, but this
+    -- way the optimizer doesn't have to work so hard to figure
+    -- that out.
+    (*>)   = (>>)
+    {-# INLINE (*>) #-}
+    x <* y = x >>= \a -> y >> return a
+    {-# INLINE (<*) #-}
+#endif
+
+instance (Monoid t) => Monoid (Parser t a) where
+    mempty  = failDesc "mempty"
+    {-# INLINE mempty #-}
+    mappend = plus
+    {-# INLINE mappend #-}
+
+instance (Monoid t) => Alternative (Parser t) where
+    empty = failDesc "empty"
+    {-# INLINE empty #-}
+
+    (<|>) = plus
+    {-# INLINE (<|>) #-}
+
+#if MIN_VERSION_base(4,2,0)
+    many v = many_v
+        where many_v = some_v <|> pure []
+              some_v = (:) <$> v <*> many_v
+    {-# INLINE many #-}
+
+    some v = some_v
+      where
+        many_v = some_v <|> pure []
+        some_v = (:) <$> v <*> many_v
+    {-# INLINE some #-}
+#endif
+
+failDesc :: String -> Parser t a
+failDesc err = Parser (\i0 a0 m0 kf _ks -> kf i0 a0 m0 [] msg)
+    where msg = "Failed reading: " ++ err
+{-# INLINE failDesc #-}
+
+(<>) :: (Monoid m) => m -> m -> m
+(<>) = mappend
+{-# INLINE (<>) #-}