aboutsummaryrefslogtreecommitdiff
path: root/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal
diff options
context:
space:
mode:
Diffstat (limited to 'vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal')
-rw-r--r--vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs227
1 files changed, 0 insertions, 227 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
deleted file mode 100644
index e47e5c9e..00000000
--- a/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal/Types.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-# 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-27 02:35:11 +0000