aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal')
-rw-r--r--haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs227
1 files changed, 227 insertions, 0 deletions
diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs
new file mode 100644
index 00000000..e47e5c9e
--- /dev/null
+++ b/haddock-library/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 (<>) #-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-03 23:10:28 +0000