diff options
Diffstat (limited to 'haddock-library')
17 files changed, 979 insertions, 728 deletions
diff --git a/haddock-library/.ghci b/haddock-library/.ghci index 6a26395e..f0bc9104 100644 --- a/haddock-library/.ghci +++ b/haddock-library/.ghci @@ -1 +1 @@ -:set -isrc -ivendor/attoparsec-0.10.4.0 -itest -idist/build -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h +:set -isrc -ivendor/attoparsec-0.12.1.1 -itest -idist/build -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -fobject-code diff --git a/haddock-library/haddock-library.cabal b/haddock-library/haddock-library.cabal index aa091ae4..6ddb1c6e 100644 --- a/haddock-library/haddock-library.cabal +++ b/haddock-library/haddock-library.cabal @@ -36,15 +36,17 @@ library other-modules: Data.Attoparsec Data.Attoparsec.ByteString + Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.Char8 - Data.Attoparsec.Combinator - Data.Attoparsec.Number Data.Attoparsec.ByteString.FastSet Data.Attoparsec.ByteString.Internal + Data.Attoparsec.Combinator Data.Attoparsec.Internal + Data.Attoparsec.Internal.Fhthagn Data.Attoparsec.Internal.Types - Documentation.Haddock.Utf8 + Data.Attoparsec.Number Documentation.Haddock.Parser.Util + Documentation.Haddock.Utf8 test-suite spec type: exitcode-stdio-1.0 @@ -53,8 +55,7 @@ test-suite spec hs-source-dirs: test , src - , vendor/attoparsec-0.10.4.0 - + , vendor/attoparsec-0.12.1.1 ghc-options: -Wall cpp-options: diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec.hs deleted file mode 100644 index 41b4ed30..00000000 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec.hs +++ /dev/null @@ -1,18 +0,0 @@ --- | --- Module : Data.Attoparsec --- Copyright : Bryan O'Sullivan 2007-2011 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient combinator parsing for 'ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec - ( - module Data.Attoparsec.ByteString - ) where - -import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal.hs deleted file mode 100644 index 0572d682..00000000 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Internal.hs +++ /dev/null @@ -1,31 +0,0 @@ --- | --- Module : Data.Attoparsec.Internal --- Copyright : Bryan O'Sullivan 2012 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators, loosely based on the Parsec --- library. - -module Data.Attoparsec.Internal - ( - compareResults - ) where - -import Data.Attoparsec.Internal.Types (IResult(..)) - --- | Compare two 'IResult' values for equality. --- --- If both 'IResult's are 'Partial', the result will be 'Nothing', as --- they are incomplete and hence their equality cannot be known. --- (This is why there is no 'Eq' instance for 'IResult'.) -compareResults :: (Eq t, Eq r) => IResult t r -> IResult t r -> Maybe Bool -compareResults (Fail i0 ctxs0 msg0) (Fail i1 ctxs1 msg1) = - Just (i0 == i1 && ctxs0 == ctxs1 && msg0 == msg1) -compareResults (Done i0 r0) (Done i1 r1) = - Just (i0 == i1 && r0 == r1) -compareResults (Partial _) (Partial _) = Nothing -compareResults _ _ = Just False 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 deleted file mode 100644 index e47e5c9e..00000000 --- a/haddock-library/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 (<>) #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs new file mode 100644 index 00000000..53d91190 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs @@ -0,0 +1,23 @@ +-- | +-- Module : Data.Attoparsec +-- Copyright : Bryan O'Sullivan 2007-2014 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for +-- 'Data.ByteString.ByteString' strings, loosely based on the Parsec +-- library. +-- +-- This module is deprecated. Use "Data.Attoparsec.ByteString" +-- instead. + +module Data.Attoparsec + {-# DEPRECATED "This module will be removed in the next major release." #-} + ( + module Data.Attoparsec.ByteString + ) where + +import Data.Attoparsec.ByteString diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs index d2f3761c..da28b723 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs @@ -1,6 +1,6 @@ -- | -- Module : Data.Attoparsec.ByteString --- Copyright : Bryan O'Sullivan 2007-2011 +-- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -38,20 +38,18 @@ module Data.Attoparsec.ByteString , maybeResult , eitherResult - -- * Combinators - , (I.<?>) - , I.try - , module Data.Attoparsec.Combinator - -- * Parsing individual bytes , I.word8 , I.anyWord8 , I.notWord8 - , I.peekWord8 , I.satisfy , I.satisfyWith , I.skip + -- ** Lookahead + , I.peekWord8 + , I.peekWord8' + -- ** Byte classes , I.inClass , I.notInClass @@ -69,6 +67,25 @@ module Data.Attoparsec.ByteString , I.takeByteString , I.takeLazyByteString + -- * Combinators + , try + , (<?>) + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match -- * State observation and manipulation functions , I.endOfInput , I.atEnd @@ -83,49 +100,51 @@ import qualified Data.Attoparsec.Internal.Types as T -- $parsec -- --- Compared to Parsec 3, Attoparsec makes several tradeoffs. It is +-- Compared to Parsec 3, attoparsec makes several tradeoffs. It is -- not intended for, or ideal for, all possible uses. -- --- * While Attoparsec can consume input incrementally, Parsec cannot. +-- * While attoparsec can consume input incrementally, Parsec cannot. -- Incremental input is a huge deal for efficient and secure network -- and system programming, since it gives much more control to users -- of the library over matters such as resource usage and the I/O -- model to use. -- --- * Much of the performance advantage of Attoparsec is gained via +-- * Much of the performance advantage of attoparsec is gained via -- high-performance parsers such as 'I.takeWhile' and 'I.string'. -- If you use complicated combinators that return lists of bytes or -- characters, there is less performance difference between the two -- libraries. -- --- * Unlike Parsec 3, Attoparsec does not support being used as a +-- * Unlike Parsec 3, attoparsec does not support being used as a -- monad transformer. -- --- * Attoparsec is specialised to deal only with strict 'B.ByteString' +-- * attoparsec is specialised to deal only with strict 'B.ByteString' -- input. Efficiency concerns rule out both lists and lazy -- bytestrings. The usual use for lazy bytestrings would be to -- allow consumption of very large input without a large footprint. --- For this need, Attoparsec's incremental input provides an +-- For this need, attoparsec's incremental input provides an -- excellent substitute, with much more control over when input --- takes place. If you must use lazy bytestrings, see the 'Lazy' --- module, which feeds lazy chunks to a regular parser. +-- takes place. If you must use lazy bytestrings, see the +-- "Data.Attoparsec.ByteString.Lazy" module, which feeds lazy chunks +-- to a regular parser. -- -- * Parsec parsers can produce more helpful error messages than --- Attoparsec parsers. This is a matter of focus: Attoparsec avoids +-- attoparsec parsers. This is a matter of focus: attoparsec avoids -- the extra book-keeping in favour of higher performance. -- $incremental -- --- Attoparsec supports incremental input, meaning that you can feed it +-- attoparsec supports incremental input, meaning that you can feed it -- a bytestring that represents only part of the expected total amount -- of data to parse. If your parser reaches the end of a fragment of -- input and could consume more input, it will suspend parsing and -- return a 'T.Partial' continuation. -- --- Supplying the 'T.Partial' continuation with another bytestring will --- resume parsing at the point where it was suspended. You must be --- prepared for the result of the resumed parse to be another --- 'T.Partial' continuation. +-- Supplying the 'T.Partial' continuation with a bytestring will +-- resume parsing at the point where it was suspended, with the +-- bytestring you supplied used as new input at the end of the +-- existing input. You must be prepared for the result of the resumed +-- parse to be another 'T.Partial' continuation. -- -- To indicate that you have no more input, supply the 'T.Partial' -- continuation with an empty bytestring. @@ -137,12 +156,19 @@ import qualified Data.Attoparsec.Internal.Types as T -- If you do not need support for incremental input, consider using -- the 'I.parseOnly' function to run your parser. It will never -- prompt for more input. +-- +-- /Note/: incremental input does /not/ imply that attoparsec will +-- release portions of its internal state for garbage collection as it +-- proceeds. Its internal representation is equivalent to a single +-- 'ByteString': if you feed incremental input to a parser, it will +-- require memory proportional to the amount of input you supply. +-- (This is necessary to support arbitrary backtracking.) -- $performance -- --- If you write an Attoparsec-based parser carefully, it can be --- realistic to expect it to perform within a factor of 2 of a --- hand-rolled C parser (measuring megabytes parsed per second). +-- If you write an attoparsec-based parser carefully, it can be +-- realistic to expect it to perform similarly to a hand-rolled C +-- parser (measuring megabytes parsed per second). -- -- To actually achieve high performance, there are a few guidelines -- that it is useful to follow. @@ -163,14 +189,6 @@ import qualified Data.Attoparsec.Internal.Types as T -- Make active use of benchmarking and profiling tools to measure, -- find the problems with, and improve the performance of your parser. --- | If a parser has returned a 'T.Partial' result, supply it with more --- input. -feed :: Result r -> B.ByteString -> Result r -feed f@(T.Fail _ _ _) _ = f -feed (T.Partial k) d = k d -feed (T.Done bs r) d = T.Done (B.append bs d) r -{-# INLINE feed #-} - -- | Run a parser and print its result to standard output. parseTest :: (Show a) => I.Parser a -> B.ByteString -> IO () parseTest p s = print (parse p s) diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs new file mode 100644 index 00000000..5e32d022 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs @@ -0,0 +1,151 @@ +{-# LANGUAGE BangPatterns #-} +-- | +-- Module : Data.Attoparsec.ByteString.Buffer +-- Copyright : Bryan O'Sullivan 2007-2014 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : GHC +-- +-- An "immutable" buffer that supports cheap appends. +-- +-- A Buffer is divided into an immutable read-only zone, followed by a +-- mutable area that we've preallocated, but not yet written to. +-- +-- We overallocate at the end of a Buffer so that we can cheaply +-- append. Since a user of an existing Buffer cannot see past the end +-- of its immutable zone into the data that will change during an +-- append, this is safe. +-- +-- Once we run out of space at the end of a Buffer, we do the usual +-- doubling of the buffer size. +-- +-- The fact of having a mutable buffer really helps with performance, +-- but it does have a consequence: if someone misuses the Partial API +-- that attoparsec uses by calling the same continuation repeatedly +-- (which never makes sense in practice), they could overwrite data. +-- +-- Since the API *looks* pure, it should *act* pure, too, so we use +-- two generation counters (one mutable, one immutable) to track the +-- number of appends to a mutable buffer. If the counters ever get out +-- of sync, someone is appending twice to a mutable buffer, so we +-- duplicate the entire buffer in order to preserve the immutability +-- of its older self. +-- +-- While we could go a step further and gain protection against API +-- abuse on a multicore system, by use of an atomic increment +-- instruction to bump the mutable generation counter, that would be +-- very expensive, and feels like it would also be in the realm of the +-- ridiculous. Clients should never call a continuation more than +-- once; we lack a linear type system that could enforce this; and +-- there's only so far we should go to accommodate broken uses. + +module Data.Attoparsec.ByteString.Buffer + ( + Buffer + , buffer + , unbuffer + , pappend + , length + , unsafeIndex + , substring + , unsafeDrop + ) where + +import Control.Exception (assert) +import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr) +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.List (foldl1') +import Data.Monoid (Monoid(..)) +import Data.Word (Word8) +import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) +import Foreign.Ptr (castPtr, plusPtr) +import Foreign.Storable (peek, peekByteOff, poke, sizeOf) +import GHC.ForeignPtr (mallocPlainForeignPtrBytes) +import Prelude hiding (length) + +data Buffer = Buf { + _fp :: {-# UNPACK #-} !(ForeignPtr Word8) + , _off :: {-# UNPACK #-} !Int + , _len :: {-# UNPACK #-} !Int + , _cap :: {-# UNPACK #-} !Int + , _gen :: {-# UNPACK #-} !Int + } + +instance Show Buffer where + showsPrec p = showsPrec p . unbuffer + +-- | The initial 'Buffer' has no mutable zone, so we can avoid all +-- copies in the (hopefully) common case of no further input being fed +-- to us. +buffer :: ByteString -> Buffer +buffer (PS fp off len) = Buf fp off len len 0 + +unbuffer :: Buffer -> ByteString +unbuffer (Buf fp off len _ _) = PS fp off len + +instance Monoid Buffer where + mempty = Buf nullForeignPtr 0 0 0 0 + + mappend (Buf _ _ _ 0 _) b = b + mappend a (Buf _ _ _ 0 _) = a + mappend buf (Buf fp off len _ _) = append buf fp off len + + mconcat [] = mempty + mconcat xs = foldl1' mappend xs + +pappend :: Buffer -> ByteString -> Buffer +pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0 +pappend buf (PS fp off len) = append buf fp off len + +append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer +append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 = + inlinePerformIO . withForeignPtr fp0 $ \ptr0 -> + withForeignPtr fp1 $ \ptr1 -> do + let genSize = sizeOf (0::Int) + newlen = len0 + len1 + gen <- if gen0 == 0 + then return 0 + else peek (castPtr ptr0) + if gen == gen0 && newlen <= cap0 + then do + let newgen = gen + 1 + poke (castPtr ptr0) newgen + memcpy (ptr0 `plusPtr` (off0+len0)) + (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp0 off0 newlen cap0 newgen) + else do + let newcap = newlen * 2 + fp <- mallocPlainForeignPtrBytes (newcap + genSize) + withForeignPtr fp $ \ptr_ -> do + let ptr = ptr_ `plusPtr` genSize + newgen = 1 + poke (castPtr ptr_) newgen + memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0) + memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1) + (fromIntegral len1) + return (Buf fp genSize newlen newcap newgen) + +length :: Buffer -> Int +length (Buf _ _ len _ _) = len +{-# INLINE length #-} + +unsafeIndex :: Buffer -> Int -> Word8 +unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) . + inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i) +{-# INLINE unsafeIndex #-} + +substring :: Int -> Int -> Buffer -> ByteString +substring s l (Buf fp off len _ _) = + assert (s >= 0 && s <= len) . + assert (l >= 0 && l <= len-s) $ + PS fp (off+s) l +{-# INLINE substring #-} + +unsafeDrop :: Int -> Buffer -> ByteString +unsafeDrop s (Buf fp off len _ _) = + assert (s >= 0 && s <= len) $ + PS fp (off+s) (len-s) +{-# INLINE unsafeDrop #-} diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs index 3bbe51f0..eda8fd88 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Char8.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs @@ -1,10 +1,10 @@ {-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, TypeSynonymInstances, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} -- | -- Module : Data.Attoparsec.ByteString.Char8 --- Copyright : Bryan O'Sullivan 2007-2011 +-- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -29,26 +29,24 @@ module Data.Attoparsec.ByteString.Char8 , A.parse , A.feed , A.parseOnly - , A.parseTest , A.parseWith + , A.parseTest -- ** Result conversion , A.maybeResult , A.eitherResult - -- * Combinators - , (I.<?>) - , I.try - , module Data.Attoparsec.Combinator - -- * Parsing individual characters , char , char8 , anyChar , notChar - , peekChar , satisfy + -- ** Lookahead + , peekChar + , peekChar' + -- ** Special character parsers , digit , letter_iso8859_15 @@ -96,11 +94,27 @@ module Data.Attoparsec.ByteString.Char8 , decimal , hexadecimal , signed - , double , Number(..) - , number - , rational + -- * Combinators + , try + , (<?>) + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , I.match -- * State observation and manipulation functions , I.endOfInput , I.atEnd @@ -108,13 +122,12 @@ module Data.Attoparsec.ByteString.Char8 import Control.Applicative ((*>), (<*), (<$>), (<|>)) import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) -import Data.Attoparsec.ByteString.Internal (Parser, (<?>)) +import Data.Attoparsec.ByteString.Internal (Parser) import Data.Attoparsec.Combinator import Data.Attoparsec.Number (Number(..)) import Data.Bits (Bits, (.|.), shiftL) import Data.ByteString.Internal (c2w, w2c) import Data.Int (Int8, Int16, Int32, Int64) -import Data.Ratio ((%)) import Data.String (IsString(..)) import Data.Word (Word8, Word16, Word32, Word64, Word) import Prelude hiding (takeWhile) @@ -223,8 +236,8 @@ anyChar :: Parser Char anyChar = satisfy $ const True {-# INLINE anyChar #-} --- | Match any character. Returns 'Nothing' if end of input has been --- reached. Does not consume any input. +-- | Match any character, to perform lookahead. Returns 'Nothing' if +-- end of input has been reached. Does not consume any input. -- -- /Note/: Because this parser does not fail, do not use it with -- combinators such as 'many', because such parsers loop until a @@ -233,6 +246,12 @@ peekChar :: Parser (Maybe Char) peekChar = (fmap w2c) `fmap` I.peekWord8 {-# INLINE peekChar #-} +-- | Match any character, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekChar' :: Parser Char +peekChar' = w2c `fmap` I.peekWord8' +{-# INLINE peekChar' #-} + -- | Fast predicate for matching ASCII space characters. -- -- /Note/: This predicate only gives correct answers for the ASCII @@ -348,30 +367,39 @@ skipSpace = I.skipWhile isSpace_w8 -- $specalt -- --- The '.*>' and '<*.' combinators are intended for use with the --- @OverloadedStrings@ language extension. They simplify the common --- task of matching a statically known string, then immediately --- parsing something else. +-- If you enable the @OverloadedStrings@ language extension, you can +-- use the '*>' and '<*' combinators to simplify the common task of +-- matching a statically known string, then immediately parsing +-- something else. +-- +-- Instead of writing something like this: -- --- An example makes this easier to understand: +-- @ +--'I.string' \"foo\" '*>' wibble +-- @ -- --- @{-\# LANGUAGE OverloadedStrings #-} +-- Using @OverloadedStrings@, you can omit the explicit use of +-- 'I.string', and write a more compact version: -- --- shoeSize = \"Shoe size: \" '.*>' 'decimal' +-- @ +-- \"foo\" '*>' wibble -- @ -- --- If we were to try to use '*>' above instead, the type checker would --- not be able to tell which 'IsString' instance to use for the text --- in quotes. We would have to be explicit, using either a type --- signature or the 'I.string' parser. +-- (Note: the '.*>' and '<*.' combinators that were originally +-- provided for this purpose are obsolete and unnecessary, and will be +-- removed in the next major version.) --- | Type-specialized version of '*>' for 'B.ByteString'. +-- | /Obsolete/. A type-specialized version of '*>' for +-- 'B.ByteString'. Use '*>' instead. (.*>) :: B.ByteString -> Parser a -> Parser a s .*> f = I.string s *> f +{-# DEPRECATED (.*>) "This is no longer necessary, and will be removed. Use '*>' instead." #-} --- | Type-specialized version of '<*' for 'B.ByteString'. +-- | /Obsolete/. A type-specialized version of '<*' for +-- 'B.ByteString'. Use '<*' instead. (<*.) :: Parser a -> B.ByteString -> Parser a f <*. s = f <* I.string s +{-# DEPRECATED (<*.) "This is no longer necessary, and will be removed. Use '<*' instead." #-} -- | A predicate that matches either a carriage return @\'\\r\'@ or -- newline @\'\\n\'@ character. @@ -439,111 +467,3 @@ signed :: Num a => Parser a -> Parser a signed p = (negate <$> (char8 '-' *> p)) <|> (char8 '+' *> p) <|> p - --- | Parse a rational number. --- --- This parser accepts an optional leading sign character, followed by --- at least one decimal digit. The syntax similar to that accepted by --- the 'read' function, with the exception that a trailing @\'.\'@ or --- @\'e\'@ /not/ followed by a number is not consumed. --- --- Examples with behaviour identical to 'read', if you feed an empty --- continuation to the first result: --- --- >rational "3" == Done 3.0 "" --- >rational "3.1" == Done 3.1 "" --- >rational "3e4" == Done 30000.0 "" --- >rational "3.1e4" == Done 31000.0, "" --- --- Examples with behaviour identical to 'read': --- --- >rational ".3" == Fail "input does not start with a digit" --- >rational "e3" == Fail "input does not start with a digit" --- --- Examples of differences from 'read': --- --- >rational "3.foo" == Done 3.0 ".foo" --- >rational "3e" == Done 3.0 "e" --- --- This function does not accept string representations of \"NaN\" or --- \"Infinity\". -rational :: Fractional a => Parser a -{-# SPECIALIZE rational :: Parser Double #-} -{-# SPECIALIZE rational :: Parser Float #-} -{-# SPECIALIZE rational :: Parser Rational #-} -rational = floaty $ \real frac fracDenom -> fromRational $ - real % 1 + frac % fracDenom - --- | Parse a rational number. --- --- The syntax accepted by this parser is the same as for 'rational'. --- --- /Note/: This function is almost ten times faster than 'rational', --- but is slightly less accurate. --- --- The 'Double' type supports about 16 decimal places of accuracy. --- For 94.2% of numbers, this function and 'rational' give identical --- results, but for the remaining 5.8%, this function loses precision --- around the 15th decimal place. For 0.001% of numbers, this --- function will lose precision at the 13th or 14th decimal place. --- --- This function does not accept string representations of \"NaN\" or --- \"Infinity\". -double :: Parser Double -double = floaty asDouble - -asDouble :: Integer -> Integer -> Integer -> Double -asDouble real frac fracDenom = - fromIntegral real + fromIntegral frac / fromIntegral fracDenom -{-# INLINE asDouble #-} - --- | Parse a number, attempting to preserve both speed and precision. --- --- The syntax accepted by this parser is the same as for 'rational'. --- --- /Note/: This function is almost ten times faster than 'rational'. --- On integral inputs, it gives perfectly accurate answers, and on --- floating point inputs, it is slightly less accurate than --- 'rational'. --- --- This function does not accept string representations of \"NaN\" or --- \"Infinity\". -number :: Parser Number -number = floaty $ \real frac fracDenom -> - if frac == 0 && fracDenom == 0 - then I real - else D (asDouble real frac fracDenom) -{-# INLINE number #-} - -data T = T !Integer !Int - -floaty :: Fractional a => (Integer -> Integer -> Integer -> a) -> Parser a -{-# INLINE floaty #-} -floaty f = do - let minus = 45 - plus = 43 - !positive <- ((== plus) <$> I.satisfy (\c -> c == minus || c == plus)) <|> - return True - real <- decimal - let tryFraction = do - let dot = 46 - _ <- I.satisfy (==dot) - ds <- I.takeWhile isDigit_w8 - case I.parseOnly decimal ds of - Right n -> return $ T n (B.length ds) - _ -> fail "no digits after decimal" - T fraction fracDigits <- tryFraction <|> return (T 0 0) - let littleE = 101 - bigE = 69 - e w = w == littleE || w == bigE - power <- (I.satisfy e *> signed decimal) <|> return (0::Int) - let n = if fracDigits == 0 - then if power == 0 - then fromIntegral real - else fromIntegral real * (10 ^^ power) - else if power == 0 - then f real fraction (10 ^ fracDigits) - else f real fraction (10 ^ fracDigits) * (10 ^^ power) - return $ if positive - then n - else -n diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs index 73d02056..cb615167 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/FastSet.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Attoparsec.ByteString.FastSet --- Copyright : Bryan O'Sullivan 2008 +-- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -83,7 +83,7 @@ memberWord8 w (Sorted s) = search 0 (B.length s - 1) where search lo hi | hi < lo = False | otherwise = - let mid = (lo + hi) `div` 2 + let mid = (lo + hi) `quot` 2 in case compare w (U.unsafeIndex s mid) of GT -> search (mid + 1) hi LT -> search lo (mid - 1) diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs index b3699728..f6ec3b32 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Internal.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs @@ -1,15 +1,14 @@ -{-# LANGUAGE BangPatterns, CPP, Rank2Types, OverloadedStrings, - RecordWildCards, MagicHash, UnboxedTuples #-} +{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-} -- | -- Module : Data.Attoparsec.ByteString.Internal --- Copyright : Bryan O'Sullivan 2007-2011 +-- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- --- Simple, efficient parser combinators for 'B.ByteString' strings, +-- Simple, efficient parser combinators for 'ByteString' strings, -- loosely based on the Parsec library. module Data.Attoparsec.ByteString.Internal @@ -23,8 +22,6 @@ module Data.Attoparsec.ByteString.Internal , parseOnly -- * Combinators - , (<?>) - , try , module Data.Attoparsec.Combinator -- * Parsing individual bytes @@ -34,7 +31,10 @@ module Data.Attoparsec.ByteString.Internal , skip , word8 , notWord8 + + -- ** Lookahead , peekWord8 + , peekWord8' -- ** Byte classes , inClass @@ -49,6 +49,7 @@ module Data.Attoparsec.ByteString.Internal , stringTransform , take , scan + , runScanner , takeWhile , takeWhile1 , takeTill @@ -57,26 +58,28 @@ module Data.Attoparsec.ByteString.Internal , takeByteString , takeLazyByteString - -- * State observation and manipulation functions - , endOfInput - , atEnd - -- * Utilities , endOfLine + , endOfInput + , match + , atEnd ) where import Control.Applicative ((<|>), (<$>)) import Control.Monad (when) +import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) -import Data.Attoparsec.Combinator -import Data.Attoparsec.Internal.Types - hiding (Parser, Input, Added, Failure, Success) -import Data.Monoid (Monoid(..)) +import Data.Attoparsec.Combinator ((<?>)) +import Data.Attoparsec.Internal +import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO) +import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success) +import Data.ByteString (ByteString) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (castPtr, minusPtr, plusPtr) import Foreign.Storable (Storable(peek, sizeOf)) -import Prelude hiding (getChar, take, takeWhile) +import Prelude hiding (getChar, succ, take, takeWhile) +import qualified Data.Attoparsec.ByteString.Buffer as Buf import qualified Data.Attoparsec.Internal.Types as T import qualified Data.ByteString as B8 import qualified Data.ByteString.Char8 as B @@ -84,88 +87,10 @@ import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Unsafe as B -#if defined(__GLASGOW_HASKELL__) -import GHC.Base (realWorld#) -import GHC.IO (IO(IO)) -#else -import System.IO.Unsafe (unsafePerformIO) -#endif - -type Parser = T.Parser B.ByteString -type Result = IResult B.ByteString -type Input = T.Input B.ByteString -type Added = T.Added B.ByteString -type Failure r = T.Failure B.ByteString r -type Success a r = T.Success B.ByteString a r - -ensure' :: Int -> Input -> Added -> More -> Failure r -> Success B.ByteString r - -> IResult B.ByteString r -ensure' !n0 i0 a0 m0 kf0 ks0 = - T.runParser (demandInput >> go n0) i0 a0 m0 kf0 ks0 - where - go !n = T.Parser $ \i a m kf ks -> - if B.length (unI i) >= n - then ks i a m (unI i) - else T.runParser (demandInput >> go n) i a m kf ks - --- | If at least @n@ bytes of input are available, return the current --- input, otherwise fail. -ensure :: Int -> Parser B.ByteString -ensure !n = T.Parser $ \i0 a0 m0 kf ks -> - if B.length (unI i0) >= n - then ks i0 a0 m0 (unI i0) - -- The uncommon case is kept out-of-line to reduce code size: - else ensure' n i0 a0 m0 kf ks --- Non-recursive so the bounds check can be inlined: -{-# INLINE ensure #-} - --- | Ask for input. If we receive any, pass it to a success --- continuation, otherwise to a failure continuation. -prompt :: Input -> Added -> More - -> (Input -> Added -> More -> Result r) - -> (Input -> Added -> More -> Result r) - -> Result r -prompt i0 a0 _m0 kf ks = Partial $ \s -> - if B.null s - then kf i0 a0 Complete - else ks (i0 <> I s) (a0 <> A s) Incomplete - --- | Immediately demand more input via a 'Partial' continuation --- result. -demandInput :: Parser () -demandInput = T.Parser $ \i0 a0 m0 kf ks -> - if m0 == Complete - then kf i0 a0 m0 ["demandInput"] "not enough bytes" - else let kf' i a m = kf i a m ["demandInput"] "not enough bytes" - ks' i a m = ks i a m () - in prompt i0 a0 m0 kf' ks' - --- | This parser always succeeds. It returns 'True' if any input is --- available either immediately or on demand, and 'False' if the end --- of all input has been reached. -wantInput :: Parser Bool -wantInput = T.Parser $ \i0 a0 m0 _kf ks -> - case () of - _ | not (B.null (unI i0)) -> ks i0 a0 m0 True - | m0 == Complete -> ks i0 a0 m0 False - | otherwise -> let kf' i a m = ks i a m False - ks' i a m = ks i a m True - in prompt i0 a0 m0 kf' ks' - -get :: Parser B.ByteString -get = T.Parser $ \i0 a0 m0 _kf ks -> ks i0 a0 m0 (unI i0) - -put :: B.ByteString -> Parser () -put s = T.Parser $ \_i0 a0 m0 _kf ks -> ks (I s) a0 m0 () - --- | Attempt a parse, and if it fails, rewind the input so that no --- input appears to have been consumed. --- --- This combinator is provided for compatibility with Parsec. --- Attoparsec parsers always backtrack on failure. -try :: Parser a -> Parser a -try p = p -{-# INLINE try #-} +type Parser = T.Parser ByteString +type Result = IResult ByteString +type Failure r = T.Failure ByteString Buffer r +type Success a r = T.Success ByteString Buffer a r -- | The parser @satisfy p@ succeeds for any byte for which the -- predicate @p@ returns 'True'. Returns the byte that is actually @@ -175,10 +100,9 @@ try p = p -- > where isDigit w = w >= 48 && w <= 57 satisfy :: (Word8 -> Bool) -> Parser Word8 satisfy p = do - s <- ensure 1 - let !w = B.unsafeHead s - if p w - then put (B.unsafeTail s) >> return w + h <- peekWord8' + if p h + then advance 1 >> return h else fail "satisfy" {-# INLINE satisfy #-} @@ -189,9 +113,9 @@ satisfy p = do -- > where isDigit w = w >= 48 && w <= 57 skip :: (Word8 -> Bool) -> Parser () skip p = do - s <- ensure 1 - if p (B.unsafeHead s) - then put (B.unsafeTail s) + h <- peekWord8' + if p h + then advance 1 else fail "skip" -- | The parser @satisfyWith f p@ transforms a byte, and succeeds if @@ -199,11 +123,10 @@ skip p = do -- parser returns the transformed byte that was parsed. satisfyWith :: (Word8 -> a) -> (a -> Bool) -> Parser a satisfyWith f p = do - s <- ensure 1 - let c = f $! B.unsafeHead s + h <- peekWord8' + let c = f h if p c - then let !t = B.unsafeTail s - in put t >> return c + then advance 1 >> return c else fail "satisfyWith" {-# INLINE satisfyWith #-} @@ -218,18 +141,16 @@ storable = hack undefined -- | Consume @n@ bytes of input, but succeed only if the predicate -- returns 'True'. -takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.ByteString +takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString takeWith n0 p = do let n = max n0 0 s <- ensure n - let h = B.unsafeTake n s - t = B.unsafeDrop n s - if p h - then put t >> return h + if p s + then advance n >> return s else fail "takeWith" -- | Consume exactly @n@ bytes of input. -take :: Int -> Parser B.ByteString +take :: Int -> Parser ByteString take n = takeWith n (const True) {-# INLINE take #-} @@ -246,14 +167,14 @@ take n = takeWith n (const True) -- -- The reason for its failure is that the first branch is a -- partial match, and will consume the letters @\'f\'@ and @\'o\'@ --- before failing. In Attoparsec, the above parser will /succeed/ on +-- before failing. In attoparsec, the above parser will /succeed/ on -- that input, because the failed first branch will consume nothing. -string :: B.ByteString -> Parser B.ByteString +string :: ByteString -> Parser ByteString string s = takeWith (B.length s) (==s) {-# INLINE string #-} -stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString - -> Parser B.ByteString +stringTransform :: (ByteString -> ByteString) -> ByteString + -> Parser ByteString stringTransform f s = takeWith (B.length s) ((==f s) . f) {-# INLINE stringTransform #-} @@ -262,11 +183,9 @@ skipWhile :: (Word8 -> Bool) -> Parser () skipWhile p = go where go = do - t <- B8.dropWhile p <$> get - put t - when (B.null t) $ do - input <- wantInput - when input go + t <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length t) + when continue go {-# INLINE skipWhile #-} -- | Consume input as long as the predicate returns 'False' @@ -276,9 +195,10 @@ skipWhile p = go -- predicate returns 'True' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeTill :: (Word8 -> Bool) -> Parser B.ByteString +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeTill :: (Word8 -> Bool) -> Parser ByteString takeTill p = takeWhile (not . p) {-# INLINE takeTill #-} @@ -289,24 +209,21 @@ takeTill p = takeWhile (not . p) -- predicate returns 'False' on the first byte of input. -- -- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -takeWhile :: (Word8 -> Bool) -> Parser B.ByteString +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +takeWhile :: (Word8 -> Bool) -> Parser ByteString takeWhile p = (B.concat . reverse) `fmap` go [] where go acc = do - (h,t) <- B8.span p <$> get - put t - if B.null t - then do - input <- wantInput - if input - then go (h:acc) - else return (h:acc) - else return (h:acc) + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then go (s:acc) + else return (s:acc) {-# INLINE takeWhile #-} -takeRest :: Parser [B.ByteString] +takeRest :: Parser [ByteString] takeRest = go [] where go acc = do @@ -314,12 +231,12 @@ takeRest = go [] if input then do s <- get - put B.empty + advance (B.length s) go (s:acc) else return (reverse acc) -- | Consume all remaining input and return it as a single string. -takeByteString :: Parser B.ByteString +takeByteString :: Parser ByteString takeByteString = B.concat `fmap` takeRest -- | Consume all remaining input and return it as a single string. @@ -328,23 +245,9 @@ takeLazyByteString = L.fromChunks `fmap` takeRest data T s = T {-# UNPACK #-} !Int s --- | A stateful scanner. The predicate consumes and transforms a --- state argument, and each transformed state is passed to successive --- invocations of the predicate on each byte of the input until one --- returns 'Nothing' or the input ends. --- --- This parser does not fail. It will return an empty string if the --- predicate returns 'Nothing' on the first byte of input. --- --- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. -scan :: s -> (s -> Word8 -> Maybe s) -> Parser B.ByteString -scan s0 p = do - chunks <- go [] s0 - case chunks of - [x] -> return x - xs -> return $! B.concat $ reverse xs +scan_ :: (s -> [ByteString] -> Parser r) -> s -> (s -> Word8 -> Maybe s) + -> Parser r +scan_ f s0 p = go [] s0 where go acc s1 = do let scanner (B.PS fp off len) = @@ -363,32 +266,56 @@ scan s0 p = do bs <- get let T i s' = inlinePerformIO $ scanner bs !h = B.unsafeTake i bs - !t = B.unsafeDrop i bs - put t - if B.null t - then do - input <- wantInput - if input - then go (h:acc) s' - else return (h:acc) - else return (h:acc) + continue <- inputSpansChunks i + if continue + then go (h:acc) s' + else f s' (h:acc) +{-# INLINE scan_ #-} + +-- | A stateful scanner. The predicate consumes and transforms a +-- state argument, and each transformed state is passed to successive +-- invocations of the predicate on each byte of the input until one +-- returns 'Nothing' or the input ends. +-- +-- This parser does not fail. It will return an empty string if the +-- predicate returns 'Nothing' on the first byte of input. +-- +-- /Note/: Because this parser does not fail, do not use it with +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. +scan :: s -> (s -> Word8 -> Maybe s) -> Parser ByteString +scan = scan_ $ \_ chunks -> + case chunks of + [x] -> return x + xs -> return $! B.concat $ reverse xs {-# INLINE scan #-} +-- | Like 'scan', but generalized to return the final state of the +-- scanner. +runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s) +runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s) +{-# INLINE runScanner #-} + -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- -- This parser requires the predicate to succeed on at least one byte -- of input: it will fail if the predicate never returns 'True' or if -- there is no input left. -takeWhile1 :: (Word8 -> Bool) -> Parser B.ByteString +takeWhile1 :: (Word8 -> Bool) -> Parser ByteString takeWhile1 p = do - (`when` demandInput) =<< B.null <$> get - (h,t) <- B8.span p <$> get - when (B.null h) $ fail "takeWhile1" - put t - if B.null t - then (h<>) `fmap` takeWhile p - else return h + (`when` demandInput) =<< endOfChunk + s <- B8.takeWhile p <$> get + let len = B.length s + if len == 0 + then fail "takeWhile1" + else do + advance len + eoc <- endOfChunk + if eoc + then (s<>) `fmap` takeWhile p + else return s -- | Match any byte in a set. -- @@ -426,91 +353,133 @@ notWord8 :: Word8 -> Parser Word8 notWord8 c = satisfy (/= c) <?> "not " ++ show c {-# INLINE notWord8 #-} --- | Match any byte. Returns 'Nothing' if end of input has been --- reached. Does not consume any input. +-- | Match any byte, to perform lookahead. Returns 'Nothing' if end of +-- input has been reached. Does not consume any input. -- -- /Note/: Because this parser does not fail, do not use it with --- combinators such as 'many', because such parsers loop until a --- failure occurs. Careless use will thus result in an infinite loop. +-- combinators such as 'Control.Applicative.many', because such +-- parsers loop until a failure occurs. Careless use will thus result +-- in an infinite loop. peekWord8 :: Parser (Maybe Word8) -peekWord8 = T.Parser $ \i0 a0 m0 _kf ks -> - if B.null (unI i0) - then if m0 == Complete - then ks i0 a0 m0 Nothing - else let ks' i a m = let !w = B.unsafeHead (unI i) - in ks i a m (Just w) - kf' i a m = ks i a m Nothing - in prompt i0 a0 m0 kf' ks' - else let !w = B.unsafeHead (unI i0) - in ks i0 a0 m0 (Just w) +peekWord8 = T.Parser $ \t pos@(Pos pos_) more _lose succ -> + case () of + _| pos_ < Buf.length t -> + let !w = Buf.unsafeIndex t pos_ + in succ t pos more (Just w) + | more == Complete -> + succ t pos more Nothing + | otherwise -> + let succ' t' pos' more' = let !w = Buf.unsafeIndex t' pos_ + in succ t' pos' more' (Just w) + lose' t' pos' more' = succ t' pos' more' Nothing + in prompt t pos more lose' succ' {-# INLINE peekWord8 #-} --- | Match only if all input has been consumed. -endOfInput :: Parser () -endOfInput = T.Parser $ \i0 a0 m0 kf ks -> - if B.null (unI i0) - then if m0 == Complete - then ks i0 a0 m0 () - else let kf' i1 a1 m1 _ _ = addS i0 a0 m0 i1 a1 m1 $ - \ i2 a2 m2 -> ks i2 a2 m2 () - ks' i1 a1 m1 _ = addS i0 a0 m0 i1 a1 m1 $ - \ i2 a2 m2 -> kf i2 a2 m2 [] - "endOfInput" - in T.runParser demandInput i0 a0 m0 kf' ks' - else kf i0 a0 m0 [] "endOfInput" - --- | Return an indication of whether the end of input has been --- reached. -atEnd :: Parser Bool -atEnd = not <$> wantInput -{-# INLINE atEnd #-} +-- | Match any byte, to perform lookahead. Does not consume any +-- input, but will fail if end of input has been reached. +peekWord8' :: Parser Word8 +peekWord8' = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos 1 t + then succ t pos more (Buf.unsafeIndex t (fromPos pos)) + else let succ' t' pos' more' bs' = succ t' pos' more' $! B.unsafeHead bs' + in ensureSuspended 1 t pos more lose succ' +{-# INLINE peekWord8' #-} -- | Match either a single newline character @\'\\n\'@, or a carriage -- return followed by a newline character @\"\\r\\n\"@. endOfLine :: Parser () endOfLine = (word8 10 >> return ()) <|> (string "\r\n" >> return ()) --- | Name the parser, in case failure occurs. -(<?>) :: Parser a - -> String -- ^ the name to use if parsing fails - -> Parser a -p <?> msg0 = T.Parser $ \i0 a0 m0 kf ks -> - let kf' i a m strs msg = kf i a m (msg0:strs) msg - in T.runParser p i0 a0 m0 kf' ks -{-# INLINE (<?>) #-} -infix 0 <?> - -- | Terminal failure continuation. failK :: Failure a -failK i0 _a0 _m0 stack msg = Fail (unI i0) stack msg +failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg {-# INLINE failK #-} -- | Terminal success continuation. successK :: Success a a -successK i0 _a0 _m0 a = Done (unI i0) a +successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a {-# INLINE successK #-} -- | Run a parser. -parse :: Parser a -> B.ByteString -> Result a -parse m s = T.runParser m (I s) mempty Incomplete failK successK +parse :: Parser a -> ByteString -> Result a +parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK {-# INLINE parse #-} -- | Run a parser that cannot be resupplied via a 'Partial' result. -parseOnly :: Parser a -> B.ByteString -> Either String a -parseOnly m s = case T.runParser m (I s) mempty Complete failK successK of +-- +-- This function does not force a parser to consume all of its input. +-- Instead, any residual input will be discarded. To force a parser +-- to consume all of its input, use something like this: +-- +-- @ +--'parseOnly' (myParser 'Control.Applicative.<*' 'endOfInput') +-- @ +parseOnly :: Parser a -> ByteString -> Either String a +parseOnly m s = case T.runParser m (buffer s) (Pos 0) Complete failK successK of Fail _ _ err -> Left err Done _ a -> Right a _ -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-} --- | 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 -#if defined(__GLASGOW_HASKELL__) -inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r -#else -inlinePerformIO = unsafePerformIO -#endif -{-# INLINE inlinePerformIO #-} +get :: Parser ByteString +get = T.Parser $ \t pos more _lose succ -> + succ t pos more (Buf.unsafeDrop (fromPos pos) t) +{-# INLINE get #-} + +endOfChunk :: Parser Bool +endOfChunk = T.Parser $ \t pos more _lose succ -> + succ t pos more (fromPos pos == Buf.length t) +{-# INLINE endOfChunk #-} + +inputSpansChunks :: Int -> Parser Bool +inputSpansChunks i = T.Parser $ \t pos_ more _lose succ -> + let pos = pos_ + Pos i + in if fromPos pos < Buf.length t || more == Complete + then succ t pos more False + else let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE inputSpansChunks #-} + +advance :: Int -> Parser () +advance n = T.Parser $ \t pos more _lose succ -> + succ t (pos + Pos n) more () +{-# INLINE advance #-} + +ensureSuspended :: Int -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +ensureSuspended n t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = T.Parser $ \t' pos' more' lose' succ' -> + if lengthAtLeast pos' n t' + then succ' t' pos' more' (substring pos (Pos n) t') + else runParser (demandInput >> go) t' pos' more' lose' succ' + +-- | If at least @n@ elements of input are available, return the +-- current input, otherwise fail. +ensure :: Int -> Parser ByteString +ensure n = T.Parser $ \t pos more lose succ -> + if lengthAtLeast pos n t + then succ t pos more (substring pos (Pos n) t) + -- The uncommon case is kept out-of-line to reduce code size: + else ensureSuspended n t pos more lose succ +-- Non-recursive so the bounds check can be inlined: +{-# INLINE ensure #-} + +-- | Return both the result of a parse and the portion of the input +-- that was consumed while it was being parsed. +match :: Parser a -> Parser (ByteString, a) +match p = T.Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = + succ t' pos' more' (substring pos (pos'-pos) t', a) + in runParser p t pos more lose succ' + +lengthAtLeast :: Pos -> Int -> Buffer -> Bool +lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n +{-# INLINE lengthAtLeast #-} + +substring :: Pos -> Pos -> Buffer -> ByteString +substring (Pos pos) (Pos n) = Buf.substring pos n +{-# INLINE substring #-} diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs index cb9cee83..65788ce9 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Combinator.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE BangPatterns, CPP #-} +{-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Attoparsec.Combinator --- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2009-2010 +-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -11,7 +11,10 @@ -- Useful parser combinators, similar to those provided by Parsec. module Data.Attoparsec.Combinator ( - choice + -- * Combinators + try + , (<?>) + , choice , count , option , many' @@ -26,28 +29,47 @@ module Data.Attoparsec.Combinator , skipMany , skipMany1 , eitherP + , feed + , satisfyElem + , endOfInput + , atEnd ) where import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, - (<|>), (*>), (<$>)) + many, (<|>), (*>), (<$>)) import Control.Monad (MonadPlus(..)) -#if !MIN_VERSION_base(4,2,0) -import Control.Applicative (many) -#endif - -#if __GLASGOW_HASKELL__ >= 700 -import Data.Attoparsec.Internal.Types (Parser) +import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) +import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) import Data.ByteString (ByteString) -#endif +import Data.Monoid (Monoid(mappend)) +import Prelude hiding (succ) + +-- | Attempt a parse, and if it fails, rewind the input so that no +-- input appears to have been consumed. +-- +-- This combinator is provided for compatibility with Parsec. +-- attoparsec parsers always backtrack on failure. +try :: Parser i a -> Parser i a +try p = p +{-# INLINE try #-} + +-- | Name the parser, in case failure occurs. +(<?>) :: Parser i a + -> String -- ^ the name to use if parsing fails + -> Parser i a +p <?> msg0 = Parser $ \t pos more lose succ -> + let lose' t' pos' more' strs msg = lose t' pos' more' (msg0:strs) msg + in runParser p t pos more lose' succ +{-# INLINE (<?>) #-} +infix 0 <?> -- | @choice ps@ tries to apply the actions in the list @ps@ in order, -- until one of them succeeds. Returns the value of the succeeding -- action. choice :: Alternative f => [f a] -> f a choice = foldr (<|>) empty -#if __GLASGOW_HASKELL__ >= 700 -{-# SPECIALIZE choice :: [Parser ByteString a] -> Parser ByteString a #-} -#endif +{-# SPECIALIZE choice :: [Parser ByteString a] + -> Parser ByteString a #-} -- | @option x p@ tries to apply action @p@. If @p@ fails without -- consuming input, it returns the value @x@, otherwise the value @@ -56,9 +78,7 @@ choice = foldr (<|>) empty -- > priority = option 0 (digitToInt <$> digit) option :: Alternative f => a -> f a -> f a option x p = p <|> pure x -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} -#endif -- | A version of 'liftM2' that is strict in the result of its first -- action. @@ -103,10 +123,8 @@ many1' p = liftM2' (:) p (many' p) -- > commaSep p = p `sepBy` (symbol ",") sepBy :: Alternative f => f a -> f s -> f [a] sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -#endif -- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value @@ -116,10 +134,8 @@ sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] sepBy' :: (MonadPlus m) => m a -> m s -> m [a] sepBy' p s = scan `mplus` return [] where scan = liftM2' (:) p ((s >> sepBy1' p s) `mplus` return []) -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -#endif -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. @@ -128,10 +144,8 @@ sepBy' p s = scan `mplus` return [] sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan where scan = liftA2 (:) p ((s *> scan) <|> pure []) -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -#endif -- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. The value @@ -141,58 +155,51 @@ sepBy1 p s = scan sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] sepBy1' p s = scan where scan = liftM2' (:) p ((s >> scan) `mplus` return []) -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s -> Parser ByteString [a] #-} -#endif -- | @manyTill p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@. This can be used to scan comments: -- --- > simpleComment = string "<!--" *> manyTill anyChar (try (string "-->")) +-- > simpleComment = string "<!--" *> manyTill anyChar (string "-->") -- --- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and --- therefore the use of the 'try' combinator. +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) manyTill :: Alternative f => f a -> f b -> f [a] manyTill p end = scan where scan = (end *> pure []) <|> liftA2 (:) p scan -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b -> Parser ByteString [a] #-} -#endif -- | @manyTill' p end@ applies action @p@ /zero/ or more times until -- action @end@ succeeds, and returns the list of values returned by -- @p@. This can be used to scan comments: -- --- > simpleComment = string "<!--" *> manyTill' anyChar (try (string "-->")) +-- > simpleComment = string "<!--" *> manyTill' anyChar (string "-->") -- --- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and --- therefore the use of the 'try' combinator. The value returned by @p@ --- is forced to WHNF. +-- (Note the overlapping parsers @anyChar@ and @string \"-->\"@. +-- While this will work, it is not very efficient, as it will cause a +-- lot of backtracking.) +-- +-- The value returned by @p@ is forced to WHNF. manyTill' :: (MonadPlus m) => m a -> m b -> m [a] manyTill' p end = scan where scan = (end >> return []) `mplus` liftM2' (:) p scan -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b -> Parser ByteString [a] #-} -#endif -- | Skip zero or more instances of an action. skipMany :: Alternative f => f a -> f () skipMany p = scan where scan = (p *> scan) <|> pure () -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} -#endif -- | Skip one or more instances of an action. skipMany1 :: Alternative f => f a -> f () skipMany1 p = p *> skipMany p -#if __GLASGOW_HASKELL__ >= 700 {-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} -#endif -- | Apply the given action repeatedly, returning every result. count :: Monad m => Int -> m a -> m [a] @@ -203,3 +210,11 @@ count n p = sequence (replicate n p) eitherP :: (Alternative f) => f a -> f b -> f (Either a b) eitherP a b = (Left <$> a) <|> (Right <$> b) {-# INLINE eitherP #-} + +-- | If a parser has returned a 'T.Partial' result, supply it with more +-- input. +feed :: Monoid i => IResult i r -> i -> IResult i r +feed f@(Fail _ _ _) _ = f +feed (Partial k) d = k d +feed (Done t r) d = Done (mappend t d) r +{-# INLINE feed #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs new file mode 100644 index 00000000..371770a9 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs @@ -0,0 +1,142 @@ +{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-} +-- | +-- Module : Data.Attoparsec.Internal +-- Copyright : Bryan O'Sullivan 2007-2014 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal + ( compareResults + , prompt + , demandInput + , wantInput + , endOfInput + , atEnd + , satisfyElem + ) where + +import Control.Applicative ((<$>)) +#if __GLASGOW_HASKELL__ >= 700 +import Data.ByteString (ByteString) +#endif +import Data.Attoparsec.Internal.Types +import Prelude hiding (succ) + +-- | Compare two 'IResult' values for equality. +-- +-- If both 'IResult's are 'Partial', the result will be 'Nothing', as +-- they are incomplete and hence their equality cannot be known. +-- (This is why there is no 'Eq' instance for 'IResult'.) +compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool +compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) = + Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1) +compareResults (Done t0 r0) (Done t1 r1) = + Just (t0 == t1 && r0 == r1) +compareResults (Partial _) (Partial _) = Nothing +compareResults _ _ = Just False + +-- | Ask for input. If we receive any, pass it to a success +-- continuation, otherwise to a failure continuation. +prompt :: Chunk t + => State t -> Pos -> More + -> (State t -> Pos -> More -> IResult t r) + -> (State t -> Pos -> More -> IResult t r) + -> IResult t r +prompt t pos _more lose succ = Partial $ \s -> + if nullChunk s + then lose t pos Complete + else succ (pappendChunk t s) pos Incomplete +#if __GLASGOW_HASKELL__ >= 700 +{-# SPECIALIZE prompt :: State ByteString -> Pos -> More + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> IResult ByteString r #-} +#endif + +-- | Immediately demand more input via a 'Partial' continuation +-- result. +demandInput :: Chunk t => Parser t () +demandInput = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input" + succ' t' pos' more' = succ t' pos' more' () + in prompt t pos more lose' succ' +#if __GLASGOW_HASKELL__ >= 700 +{-# SPECIALIZE demandInput :: Parser ByteString () #-} +#endif + +-- | This parser always succeeds. It returns 'True' if any input is +-- available either immediately or on demand, and 'False' if the end +-- of all input has been reached. +wantInput :: forall t . Chunk t => Parser t Bool +wantInput = Parser $ \t pos more _lose succ -> + case () of + _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True + | more == Complete -> succ t pos more False + | otherwise -> let lose' t' pos' more' = succ t' pos' more' False + succ' t' pos' more' = succ t' pos' more' True + in prompt t pos more lose' succ' +{-# INLINE wantInput #-} + +-- | Match only if all input has been consumed. +endOfInput :: forall t . Chunk t => Parser t () +endOfInput = Parser $ \t pos more lose succ -> + case () of + _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput" + | more == Complete -> succ t pos more () + | otherwise -> + let lose' t' pos' more' _ctx _msg = succ t' pos' more' () + succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput" + in runParser demandInput t pos more lose' succ' +#if __GLASGOW_HASKELL__ >= 700 +{-# SPECIALIZE endOfInput :: Parser ByteString () #-} +#endif + +-- | Return an indication of whether the end of input has been +-- reached. +atEnd :: Chunk t => Parser t Bool +atEnd = not <$> wantInput +{-# INLINE atEnd #-} + +satisfySuspended :: forall t r . Chunk t + => (ChunkElem t -> Bool) + -> State t -> Pos -> More + -> Failure t (State t) r + -> Success t (State t) (ChunkElem t) r + -> IResult t r +satisfySuspended p t pos more lose succ = + runParser (demandInput >> go) t pos more lose succ + where go = Parser $ \t' pos' more' lose' succ' -> + case bufferElemAt (undefined :: t) pos' t' of + Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e + | otherwise -> lose' t' pos' more' [] "satisfyElem" + Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ' +#if __GLASGOW_HASKELL__ >= 700 +{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) + -> State ByteString -> Pos -> More + -> Failure ByteString (State ByteString) r + -> Success ByteString (State ByteString) + (ChunkElem ByteString) r + -> IResult ByteString r #-} +#endif + +-- | The parser @satisfyElem p@ succeeds for any chunk element for which the +-- predicate @p@ returns 'True'. Returns the element that is +-- actually parsed. +satisfyElem :: forall t . Chunk t + => (ChunkElem t -> Bool) -> Parser t (ChunkElem t) +satisfyElem p = Parser $ \t pos more lose succ -> + case bufferElemAt (undefined :: t) pos t of + Just (e, l) | p e -> succ t (pos + Pos l) more e + | otherwise -> lose t pos more [] "satisfyElem" + Nothing -> satisfySuspended p t pos more lose succ +{-# INLINE satisfyElem #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs new file mode 100644 index 00000000..0e00ed2c --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/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.12.1.1/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs new file mode 100644 index 00000000..6719e09a --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, + Rank2Types, RecordWildCards, TypeFamilies #-} +-- | +-- Module : Data.Attoparsec.Internal.Types +-- Copyright : Bryan O'Sullivan 2007-2014 +-- 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 (Alternative(..), Applicative(..), (<$>)) +import Control.DeepSeq (NFData(rnf)) +import Control.Monad (MonadPlus(..)) +import Data.Word (Word8) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (w2c) +import Data.Monoid (Monoid(..)) +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 + 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 + {-# 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 types @i@ +-- of string being processed and @t@ of internal state representation. +-- +-- 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 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 + {-# INLINE fail #-} + + return v = Parser $ \t pos more _lose succ -> succ t pos more v + {-# 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 (>>=) #-} + +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 = return + {-# INLINE pure #-} + (<*>) = apP + {-# INLINE (<*>) #-} + + -- 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 (<*) #-} + +instance Monoid (Parser i a) where + mempty = fail "mempty" + {-# INLINE mempty #-} + mappend = plus + {-# 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 = (:) <$> v <*> many_v + {-# INLINE many #-} + + some v = some_v + where + many_v = some_v <|> pure [] + some_v = (:) <$> v <*> many_v + {-# INLINE some #-} + +(<>) :: (Monoid m) => m -> m -> m +(<>) = mappend +{-# INLINE (<>) #-} + +-- | 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 #-} diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs index bf175f4b..7438a912 100644 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/Number.hs +++ b/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs @@ -1,16 +1,22 @@ {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Attoparsec.Number --- Copyright : Bryan O'Sullivan 2011 +-- Copyright : Bryan O'Sullivan 2007-2014 -- License : BSD3 -- -- Maintainer : bos@serpentine.com -- Stability : experimental -- Portability : unknown -- +-- This module is deprecated, and both the module and 'Number' type +-- will be removed in the next major release. Use the +-- <http://hackage.haskell.org/package/scientific scientific> package +-- and the 'Data.Scientific.Scientific' type instead. +-- -- A simple number type, useful for parsing both exact and inexact -- quantities without losing much precision. module Data.Attoparsec.Number + {-# DEPRECATED "This module will be removed in the next major release." #-} ( Number(..) ) where @@ -22,9 +28,13 @@ import Data.Typeable (Typeable) -- | A numeric type that can represent integers accurately, and -- floating point numbers to the precision of a 'Double'. +-- +-- /Note/: this type is deprecated, and will be removed in the next +-- major release. Use the 'Data.Scientific.Scientific' type instead. data Number = I !Integer | D {-# UNPACK #-} !Double deriving (Typeable, Data) +{-# DEPRECATED Number "Use Scientific instead." #-} instance Show Number where show (I a) = show a diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE b/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE new file mode 100644 index 00000000..97392a62 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) Lennart Kolmodin + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. |