aboutsummaryrefslogtreecommitdiff
path: root/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-04-28 11:28:08 +0200
committerAlex Biehl <alexbiehl@gmail.com>2017-04-29 22:00:25 +0200
commit799a41fffde7ec6e1c2097b895925a4adac5419f (patch)
treed90259eab8e1e2d452777a4ad3496115f1e6dffa /haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal
parent7ec72d3ad81657f5a5298ac1465229fa7cafb35c (diff)
Update attoparsec-0.12.1.1 to attoparsec-0.13.1.0
Diffstat (limited to 'haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal')
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs18
-rw-r--r--haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs243
2 files changed, 261 insertions, 0 deletions
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
new file mode 100644
index 00000000..0e00ed2c
--- /dev/null
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings,
+ RecordWildCards, MagicHash, UnboxedTuples #-}
+
+module Data.Attoparsec.Internal.Fhthagn
+ (
+ inlinePerformIO
+ ) where
+
+import GHC.Base (realWorld#)
+import GHC.IO (IO(IO))
+
+-- | Just like unsafePerformIO, but we inline it. Big performance gains as
+-- it exposes lots of things to further inlining. /Very unsafe/. In
+-- particular, you should do no memory allocation inside an
+-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@.
+inlinePerformIO :: IO a -> a
+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+{-# INLINE inlinePerformIO #-}
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
new file mode 100644
index 00000000..96bc319e
--- /dev/null
+++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs
@@ -0,0 +1,243 @@
+{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,
+ Rank2Types, RecordWildCards, TypeFamilies #-}
+-- |
+-- Module : Data.Attoparsec.Internal.Types
+-- Copyright : Bryan O'Sullivan 2007-2015
+-- 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(..)
+ , State
+ , Failure
+ , Success
+ , Pos(..)
+ , IResult(..)
+ , More(..)
+ , (<>)
+ , Chunk(..)
+ ) where
+
+import Control.Applicative as App (Applicative(..), (<$>))
+import Control.Applicative (Alternative(..))
+import Control.DeepSeq (NFData(rnf))
+import Control.Monad (MonadPlus(..))
+import qualified Control.Monad.Fail as Fail (MonadFail(..))
+import Data.Monoid as Mon (Monoid(..))
+import Data.Semigroup (Semigroup(..))
+import Data.Word (Word8)
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.ByteString.Internal (w2c)
+import Prelude hiding (getChar, succ)
+import qualified Data.Attoparsec.ByteString.Buffer as B
+
+newtype Pos = Pos { fromPos :: Int }
+ deriving (Eq, Ord, Show, Num)
+
+-- | The result of a parse. This is parameterised over the type @i@
+-- of string that was processed.
+--
+-- This type is an instance of 'Functor', where 'fmap' transforms the
+-- value in a 'Done' result.
+data IResult i r =
+ Fail i [String] String
+ -- ^ The parse failed. The @i@ 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 (i -> IResult i r)
+ -- ^ Supply this continuation with more input so that the parser
+ -- can resume. To indicate that no more input is available, pass
+ -- an empty string to the continuation.
+ --
+ -- __Note__: if you get a 'Partial' result, do not call its
+ -- continuation more than once.
+ | Done i r
+ -- ^ The parse succeeded. The @i@ parameter is the input that had
+ -- not yet been consumed (if any) when the parse succeeded.
+
+instance (Show i, Show r) => Show (IResult i r) where
+ showsPrec d ir = showParen (d > 10) $
+ case ir of
+ (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg
+ (Partial _) -> showString "Partial _"
+ (Done t r) -> showString "Done" . f t . f r
+ where f :: Show a => a -> ShowS
+ f x = showChar ' ' . showsPrec 11 x
+
+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
+ {-# INLINE rnf #-}
+
+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)
+
+-- | The core parser type. This is parameterised over the type @i@
+-- 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 i a = Parser {
+ runParser :: forall r.
+ State i -> Pos -> More
+ -> Failure i (State i) r
+ -> Success i (State i) a r
+ -> IResult i r
+ }
+
+type family State i
+type instance State ByteString = B.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
+
+-- | Have we read all available input?
+data More = Complete | Incomplete
+ deriving (Eq, Show)
+
+instance Semigroup More where
+ c@Complete <> _ = c
+ _ <> m = m
+
+instance Mon.Monoid More where
+ mappend = (<>)
+ mempty = Incomplete
+
+instance Monad (Parser i) where
+ fail = Fail.fail
+ {-# INLINE fail #-}
+
+ return = App.pure
+ {-# INLINE return #-}
+
+ 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'
+ {-# INLINE (>>=) #-}
+
+ (>>) = (*>)
+ {-# INLINE (>>) #-}
+
+
+instance Fail.MonadFail (Parser i) where
+ fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg
+ where msg = "Failed reading: " ++ err
+ {-# INLINE fail #-}
+
+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"
+ {-# INLINE 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'
+ {-# INLINE fmap #-}
+
+apP :: Parser i (a -> b) -> Parser i a -> Parser i b
+apP d e = do
+ b <- d
+ a <- e
+ return (b a)
+{-# INLINE apP #-}
+
+instance Applicative (Parser i) where
+ pure v = Parser $ \t pos more _lose succ -> succ t pos more v
+ {-# INLINE pure #-}
+ (<*>) = apP
+ {-# INLINE (<*>) #-}
+ m *> k = m >>= \_ -> k
+ {-# INLINE (*>) #-}
+ x <* y = x >>= \a -> y >> pure a
+ {-# INLINE (<*) #-}
+
+instance Semigroup (Parser i a) where
+ (<>) = plus
+ {-# INLINE (<>) #-}
+
+instance Monoid (Parser i a) where
+ mempty = fail "mempty"
+ {-# INLINE mempty #-}
+ mappend = (<>)
+ {-# INLINE mappend #-}
+
+instance Alternative (Parser i) where
+ empty = fail "empty"
+ {-# INLINE empty #-}
+
+ (<|>) = plus
+ {-# INLINE (<|>) #-}
+
+ many v = many_v
+ where many_v = some_v <|> pure []
+ some_v = (:) App.<$> v <*> many_v
+ {-# INLINE many #-}
+
+ some v = some_v
+ where
+ many_v = some_v <|> pure []
+ some_v = (:) <$> v <*> many_v
+ {-# INLINE some #-}
+
+-- | A common interface for input chunks.
+class Monoid c => Chunk c where
+ type ChunkElem c
+ -- | Test if the chunk is empty.
+ nullChunk :: c -> Bool
+ -- | Append chunk to a buffer.
+ pappendChunk :: State c -> c -> State c
+ -- | Position at the end of a buffer. The first argument is ignored.
+ atBufferEnd :: c -> State c -> Pos
+ -- | Return the buffer element at the given position along with its length.
+ bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)
+ -- | Map an element to the corresponding character.
+ -- The first argument is ignored.
+ chunkElemToChar :: c -> ChunkElem c -> Char
+
+instance Chunk ByteString where
+ type ChunkElem ByteString = Word8
+ nullChunk = BS.null
+ {-# INLINE nullChunk #-}
+ pappendChunk = B.pappend
+ {-# INLINE pappendChunk #-}
+ atBufferEnd _ = Pos . B.length
+ {-# INLINE atBufferEnd #-}
+ bufferElemAt _ (Pos i) buf
+ | i < B.length buf = Just (B.unsafeIndex buf i, 1)
+ | otherwise = Nothing
+ {-# INLINE bufferElemAt #-}
+ chunkElemToChar _ = w2c
+ {-# INLINE chunkElemToChar #-}