diff options
author | alexbiehl <alex.biehl@gmail.com> | 2017-08-21 20:05:42 +0200 |
---|---|---|
committer | alexbiehl <alex.biehl@gmail.com> | 2017-08-21 20:05:42 +0200 |
commit | 7a71af839bd71992a36d97650004c73bf11fa436 (patch) | |
tree | e64afbc9df5c97fde6ac6433e42f28df8a4acf49 /haddock-library/vendor | |
parent | c8a01b83be52e45d3890db173ffe7b09ccd4f351 (diff) | |
parent | 740458ac4d2acf197f2ef8dc94a66f9b160b9c3c (diff) |
Merge remote-tracking branch 'origin/master' into ghc-head
Diffstat (limited to 'haddock-library/vendor')
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs) | 2 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs) | 15 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs) | 19 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs) | 39 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs) | 2 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs) | 119 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs) | 33 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs) | 45 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs) | 0 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs) | 67 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs (renamed from haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs) | 2 | ||||
-rw-r--r-- | haddock-library/vendor/attoparsec-0.13.1.0/LICENSE (renamed from haddock-library/vendor/attoparsec-0.12.1.1/LICENSE) | 0 |
12 files changed, 221 insertions, 122 deletions
diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs index 53d91190..bd3c5592 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs @@ -1,6 +1,6 @@ -- | -- Module : Data.Attoparsec --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs index da28b723..84e567d9 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs @@ -1,6 +1,10 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif -- | -- Module : Data.Attoparsec.ByteString --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -59,6 +63,7 @@ module Data.Attoparsec.ByteString , I.skipWhile , I.take , I.scan + , I.runScanner , I.takeWhile , I.takeWhile1 , I.takeTill @@ -92,6 +97,7 @@ module Data.Attoparsec.ByteString ) where import Data.Attoparsec.Combinator +import Data.List (intercalate) import qualified Data.Attoparsec.ByteString.Internal as I import qualified Data.Attoparsec.Internal as I import qualified Data.ByteString as B @@ -218,6 +224,7 @@ maybeResult _ = Nothing -- | Convert a 'Result' value to an 'Either' value. A 'T.Partial' -- result is treated as failure. eitherResult :: Result r -> Either String r -eitherResult (T.Done _ r) = Right r -eitherResult (T.Fail _ _ msg) = Left msg -eitherResult _ = Left "Result: incomplete input" +eitherResult (T.Done _ r) = Right r +eitherResult (T.Fail _ [] msg) = Left msg +eitherResult (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg) +eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs index 5e32d022..ac94dfcc 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs @@ -1,7 +1,7 @@ {-# LANGUAGE BangPatterns #-} -- | -- Module : Data.Attoparsec.ByteString.Buffer --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -57,7 +57,8 @@ 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.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) import Data.Word (Word8) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (castPtr, plusPtr) @@ -65,6 +66,7 @@ import Foreign.Storable (peek, peekByteOff, poke, sizeOf) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) import Prelude hiding (length) +-- If _cap is zero, this buffer is empty. data Buffer = Buf { _fp :: {-# UNPACK #-} !(ForeignPtr Word8) , _off :: {-# UNPACK #-} !Int @@ -85,18 +87,21 @@ buffer (PS fp off len) = Buf fp off len len 0 unbuffer :: Buffer -> ByteString unbuffer (Buf fp off len _ _) = PS fp off len +instance Semigroup Buffer where + (Buf _ _ _ 0 _) <> b = b + a <> (Buf _ _ _ 0 _) = a + buf <> (Buf fp off len _ _) = append buf 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 + mappend = (<>) - mconcat [] = mempty + mconcat [] = Mon.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 _ _ _ 0 _) bs = buffer bs pappend buf (PS fp off len) = append buf fp off len append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs index 576dded9..7fafba40 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs @@ -1,10 +1,13 @@ -{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, +{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, TypeFamilies, TypeSynonymInstances, GADTs #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-} -- | -- Module : Data.Attoparsec.ByteString.Char8 --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -67,7 +70,7 @@ module Data.Attoparsec.ByteString.Char8 -- * Efficient string handling , I.string - , stringCI + , I.stringCI , skipSpace , skipWhile , I.take @@ -94,7 +97,6 @@ module Data.Attoparsec.ByteString.Char8 , decimal , hexadecimal , signed - , Number(..) -- * Combinators , try @@ -120,16 +122,19 @@ module Data.Attoparsec.ByteString.Char8 , I.atEnd ) where -import Control.Applicative ((*>), (<*), (<$>), (<|>)) +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (pure, (*>), (<*), (<$>)) +import Data.Word (Word) +#endif +import Control.Applicative ((<|>)) import Data.Attoparsec.ByteString.FastSet (charClass, memberChar) 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.String (IsString(..)) -import Data.Word +import Data.Word (Word8, Word16, Word32, Word64) import Prelude hiding (takeWhile) import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Internal as I @@ -155,16 +160,6 @@ instance (a ~ B.ByteString) => IsString (Parser a) where -- currency sign in ISO-8859-1). Haskell 'Char' values above U+00FF -- are truncated, so e.g. U+1D6B7 is truncated to the byte @0xB7@. --- ASCII-specific but fast, oh yes. -toLower :: Word8 -> Word8 -toLower w | w >= 65 && w <= 90 = w + 32 - | otherwise = w - --- | Satisfy a literal string, ignoring case. -stringCI :: B.ByteString -> Parser B.ByteString -stringCI = I.stringTransform (B8.map toLower) -{-# INLINE stringCI #-} - -- | Consume input as long as the predicate returns 'True', and return -- the consumed input. -- @@ -228,7 +223,7 @@ isDigit c = c >= '0' && c <= '9' -- | A fast digit predicate. isDigit_w8 :: Word8 -> Bool -isDigit_w8 w = w >= 48 && w <= 57 +isDigit_w8 w = w - 48 <= 9 {-# INLINE isDigit_w8 #-} -- | Match any character. @@ -265,7 +260,7 @@ isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') -- | Fast 'Word8' predicate for matching ASCII space characters. isSpace_w8 :: Word8 -> Bool -isSpace_w8 w = (w == 32) || (9 <= w && w <= 13) +isSpace_w8 w = w == 32 || w - 9 <= 4 {-# INLINE isSpace_w8 #-} @@ -440,9 +435,8 @@ hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit -- | Parse and decode an unsigned decimal number. decimal :: Integral a => Parser a -decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDig - where isDig w = w >= 48 && w <= 57 - step a w = a * 10 + fromIntegral (w - 48) +decimal = B8.foldl' step 0 `fmap` I.takeWhile1 isDigit_w8 + where step a w = a * 10 + fromIntegral (w - 48) {-# SPECIALISE decimal :: Parser Int #-} {-# SPECIALISE decimal :: Parser Int8 #-} {-# SPECIALISE decimal :: Parser Int16 #-} @@ -467,3 +461,4 @@ signed :: Num a => Parser a -> Parser a signed p = (negate <$> (char8 '-' *> p)) <|> (char8 '+' *> p) <|> p + diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs index cb615167..d15854c4 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Data.Attoparsec.ByteString.FastSet --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs index f6ec3b32..4938ea87 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, + RecordWildCards #-} -- | -- Module : Data.Attoparsec.ByteString.Internal --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -46,7 +47,7 @@ module Data.Attoparsec.ByteString.Internal -- * Efficient string handling , skipWhile , string - , stringTransform + , stringCI , take , scan , runScanner @@ -65,7 +66,10 @@ module Data.Attoparsec.ByteString.Internal , atEnd ) where -import Control.Applicative ((<|>), (<$>)) +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif +import Control.Applicative ((<|>)) import Control.Monad (when) import Data.Attoparsec.ByteString.Buffer (Buffer, buffer) import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8) @@ -74,6 +78,7 @@ 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.List (intercalate) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (castPtr, minusPtr, plusPtr) @@ -136,22 +141,15 @@ storable = hack undefined hack :: Storable b => b -> Parser b hack dummy = do (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) - return . B.inlinePerformIO . withForeignPtr fp $ \p -> + return . inlinePerformIO . withForeignPtr fp $ \p -> peek (castPtr $ p `plusPtr` o) --- | Consume @n@ bytes of input, but succeed only if the predicate --- returns 'True'. -takeWith :: Int -> (ByteString -> Bool) -> Parser ByteString -takeWith n0 p = do - let n = max n0 0 - s <- ensure n - if p s - then advance n >> return s - else fail "takeWith" - -- | Consume exactly @n@ bytes of input. take :: Int -> Parser ByteString -take n = takeWith n (const True) +take n0 = do + let n = max n0 0 + s <- ensure n + advance n >> return s {-# INLINE take #-} -- | @string s@ parses a sequence of bytes that identically match @@ -170,13 +168,59 @@ take n = takeWith n (const True) -- before failing. In attoparsec, the above parser will /succeed/ on -- that input, because the failed first branch will consume nothing. string :: ByteString -> Parser ByteString -string s = takeWith (B.length s) (==s) +string s = string_ (stringSuspended id) id s {-# INLINE string #-} -stringTransform :: (ByteString -> ByteString) -> ByteString - -> Parser ByteString -stringTransform f s = takeWith (B.length s) ((==f s) . f) -{-# INLINE stringTransform #-} +-- ASCII-specific but fast, oh yes. +toLower :: Word8 -> Word8 +toLower w | w >= 65 && w <= 90 = w + 32 + | otherwise = w + +-- | Satisfy a literal string, ignoring case. +stringCI :: ByteString -> Parser ByteString +stringCI s = string_ (stringSuspended lower) lower s + where lower = B8.map toLower +{-# INLINE stringCI #-} + +string_ :: (forall r. ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r -> Success ByteString r -> Result r) + -> (ByteString -> ByteString) + -> ByteString -> Parser ByteString +string_ suspended f s0 = T.Parser $ \t pos more lose succ -> + let n = B.length s + s = f s0 + in if lengthAtLeast pos n t + then let t' = substring pos (Pos n) t + in if s == f t' + then succ t (pos + Pos n) more t' + else lose t pos more [] "string" + else let t' = Buf.unsafeDrop (fromPos pos) t + in if f t' `B.isPrefixOf` s + then suspended s (B.drop (B.length t') s) t pos more lose succ + else lose t pos more [] "string" +{-# INLINE string_ #-} + +stringSuspended :: (ByteString -> ByteString) + -> ByteString -> ByteString -> Buffer -> Pos -> More + -> Failure r + -> Success ByteString r + -> Result r +stringSuspended f s0 s t pos more lose succ = + runParser (demandInput_ >>= go) t pos more lose succ + where go s'0 = T.Parser $ \t' pos' more' lose' succ' -> + let m = B.length s + s' = f s'0 + n = B.length s' + in if n >= m + then if B.unsafeTake m s' == s + then let o = Pos (B.length s0) + in succ' t' (pos' + o) more' + (substring pos' o t') + else lose' t' pos' more' [] "string" + else if s' == B.unsafeTake n s + then stringSuspended f s0 (B.unsafeDrop n s) + t' pos' more' lose' succ' + else lose' t' pos' more' [] "string" -- | Skip past input for as long as the predicate returns 'True'. skipWhile :: (Word8 -> Bool) -> Parser () @@ -213,15 +257,24 @@ takeTill p = takeWhile (not . p) -- 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 [] +takeWhile p = do + s <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length s) + if continue + then takeWhileAcc p [s] + else return s +{-# INLINE takeWhile #-} + +takeWhileAcc :: (Word8 -> Bool) -> [ByteString] -> Parser ByteString +takeWhileAcc p = go where go acc = do s <- B8.takeWhile p <$> get continue <- inputSpansChunks (B.length s) if continue then go (s:acc) - else return (s:acc) -{-# INLINE takeWhile #-} + else return $ concatReverse (s:acc) +{-# INLINE takeWhileAcc #-} takeRest :: Parser [ByteString] takeRest = go [] @@ -285,16 +338,13 @@ scan_ f s0 p = go [] s0 -- 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 +scan = scan_ $ \_ chunks -> return $! concatReverse chunks {-# 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) +runScanner = scan_ $ \s xs -> let !sx = concatReverse xs in return (sx, s) {-# INLINE runScanner #-} -- | Consume input as long as the predicate returns 'True', and return @@ -314,8 +364,9 @@ takeWhile1 p = do advance len eoc <- endOfChunk if eoc - then (s<>) `fmap` takeWhile p + then takeWhileAcc p [s] else return s +{-# INLINE takeWhile1 #-} -- | Match any byte in a set. -- @@ -416,9 +467,10 @@ parse m s = T.runParser m (buffer s) (Pos 0) Incomplete failK successK -- @ 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!" + Fail _ [] err -> Left err + Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err) + Done _ a -> Right a + _ -> error "parseOnly: impossible error!" {-# INLINE parseOnly #-} get :: Parser ByteString @@ -465,7 +517,6 @@ ensure n = T.Parser $ \t pos more lose succ -> 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 diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs index 65788ce9..dde0c27a 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs @@ -1,7 +1,10 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE BangPatterns, CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} -- Imports internal modules +#endif -- | -- Module : Data.Attoparsec.Combinator --- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014 +-- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -33,15 +36,18 @@ module Data.Attoparsec.Combinator , satisfyElem , endOfInput , atEnd + , lookAhead ) where -import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2, - many, (<|>), (*>), (<$>)) +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative (Applicative(..), (<$>)) +import Data.Monoid (Monoid(mappend)) +#endif +import Control.Applicative (Alternative(..), empty, liftA2, many, (<|>)) import Control.Monad (MonadPlus(..)) import Data.Attoparsec.Internal.Types (Parser(..), IResult(..)) import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem) import Data.ByteString (ByteString) -import Data.Monoid (Monoid(mappend)) import Prelude hiding (succ) -- | Attempt a parse, and if it fails, rewind the input so that no @@ -120,7 +126,7 @@ many1' p = liftM2' (:) p (many' p) -- | @sepBy p sep@ applies /zero/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- --- > commaSep p = p `sepBy` (symbol ",") +-- > commaSep p = p `sepBy` (char ',') sepBy :: Alternative f => f a -> f s -> f [a] sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] {-# SPECIALIZE sepBy :: Parser ByteString a -> Parser ByteString s @@ -130,7 +136,7 @@ sepBy p s = liftA2 (:) p ((s *> sepBy1 p s) <|> pure []) <|> pure [] -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- --- > commaSep p = p `sepBy'` (symbol ",") +-- > commaSep p = p `sepBy'` (char ',') 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 []) @@ -140,7 +146,7 @@ sepBy' p s = scan `mplus` return [] -- | @sepBy1 p sep@ applies /one/ or more occurrences of @p@, separated -- by @sep@. Returns a list of the values returned by @p@. -- --- > commaSep p = p `sepBy1` (symbol ",") +-- > commaSep p = p `sepBy1` (char ',') sepBy1 :: Alternative f => f a -> f s -> f [a] sepBy1 p s = scan where scan = liftA2 (:) p ((s *> scan) <|> pure []) @@ -151,7 +157,7 @@ sepBy1 p s = scan -- by @sep@. Returns a list of the values returned by @p@. The value -- returned by @p@ is forced to WHNF. -- --- > commaSep p = p `sepBy1'` (symbol ",") +-- > commaSep p = p `sepBy1'` (char ',') sepBy1' :: (MonadPlus m) => m a -> m s -> m [a] sepBy1' p s = scan where scan = liftM2' (:) p ((s >> scan) `mplus` return []) @@ -214,7 +220,14 @@ eitherP a b = (Left <$> a) <|> (Right <$> b) -- | 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 (Fail t ctxs msg) d = Fail (mappend t d) ctxs msg feed (Partial k) d = k d feed (Done t r) d = Done (mappend t d) r {-# INLINE feed #-} + +-- | Apply a parser without consuming any input. +lookAhead :: Parser i a -> Parser i a +lookAhead p = Parser $ \t pos more lose succ -> + let succ' t' _pos' more' = succ t' pos more' + in runParser p t pos more lose succ' +{-# INLINE lookAhead #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs index 371770a9..ee758b26 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-} +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} -- | -- Module : Data.Attoparsec.Internal --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -15,17 +15,20 @@ module Data.Attoparsec.Internal ( compareResults , prompt , demandInput + , demandInput_ , wantInput , endOfInput , atEnd , satisfyElem + , concatReverse ) where +#if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) -#if __GLASGOW_HASKELL__ >= 700 -import Data.ByteString (ByteString) +import Data.Monoid (Monoid, mconcat) #endif import Data.Attoparsec.Internal.Types +import Data.ByteString (ByteString) import Prelude hiding (succ) -- | Compare two 'IResult' values for equality. @@ -41,8 +44,8 @@ compareResults (Done t0 r0) (Done t1 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. +-- | Ask for input. If we receive any, pass the augmented input to a +-- success continuation, otherwise to a failure continuation. prompt :: Chunk t => State t -> Pos -> More -> (State t -> Pos -> More -> IResult t r) @@ -52,14 +55,12 @@ 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. @@ -67,12 +68,22 @@ 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" + _ -> let lose' _ 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 + +-- | Immediately demand more input via a 'Partial' continuation +-- result. Return the new input. +demandInput_ :: Chunk t => Parser t t +demandInput_ = Parser $ \t pos more lose succ -> + case more of + Complete -> lose t pos more [] "not enough input" + _ -> Partial $ \s -> + if nullChunk s + then lose t pos Complete [] "not enough input" + else succ (pappendChunk t s) pos more s +{-# SPECIALIZE demandInput_ :: Parser ByteString ByteString #-} -- | This parser always succeeds. It returns 'True' if any input is -- available either immediately or on demand, and 'False' if the end @@ -97,9 +108,7 @@ endOfInput = Parser $ \t pos more lose succ -> 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. @@ -120,14 +129,12 @@ satisfySuspended p t pos more lose succ = 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 @@ -140,3 +147,11 @@ satisfyElem p = Parser $ \t pos more lose succ -> | otherwise -> lose t pos more [] "satisfyElem" Nothing -> satisfySuspended p t pos more lose succ {-# INLINE satisfyElem #-} + +-- | Concatenate a monoid after reversing its elements. Used to +-- glue together a series of textual chunks that have been accumulated +-- \"backwards\". +concatReverse :: Monoid m => [m] -> m +concatReverse [x] = x +concatReverse xs = mconcat (reverse xs) +{-# INLINE concatReverse #-} diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs index 0e00ed2c..0e00ed2c 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs index 9c7994e9..96bc319e 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs @@ -2,7 +2,7 @@ Rank2Types, RecordWildCards, TypeFamilies #-} -- | -- Module : Data.Attoparsec.Internal.Types --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com @@ -25,14 +25,17 @@ module Data.Attoparsec.Internal.Types , Chunk(..) ) where -import Control.Applicative (Alternative(..), Applicative(..), (<$>)) +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 Data.Monoid (Monoid(..)) import Prelude hiding (getChar, succ) import qualified Data.Attoparsec.ByteString.Buffer as B @@ -63,10 +66,13 @@ data IResult i r = -- 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] + 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 @@ -79,8 +85,8 @@ instance Functor (IResult i) where 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. +-- | The core parser type. This is parameterised over the type @i@ +-- of string being processed. -- -- This type is an instance of the following classes: -- @@ -116,17 +122,19 @@ type Success i t a r = t -> Pos -> More -> a -> IResult i r data More = Complete | Incomplete deriving (Eq, Show) -instance Monoid More where - mappend c@Complete _ = c - mappend _ m = m - mempty = Incomplete +instance Semigroup More where + c@Complete <> _ = c + _ <> m = m + +instance Mon.Monoid More where + mappend = (<>) + 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 + fail = Fail.fail {-# INLINE fail #-} - return = pure + return = App.pure {-# INLINE return #-} m >>= k = Parser $ \t !pos more lose succ -> @@ -134,6 +142,15 @@ instance Monad (Parser i) where 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 @@ -162,19 +179,19 @@ instance Applicative (Parser i) where {-# 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. m *> k = m >>= \_ -> k {-# INLINE (*>) #-} - x <* y = x >>= \a -> y >> return a + 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 = plus + mappend = (<>) {-# INLINE mappend #-} instance Alternative (Parser i) where @@ -186,7 +203,7 @@ instance Alternative (Parser i) where many v = many_v where many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v + some_v = (:) App.<$> v <*> many_v {-# INLINE many #-} some v = some_v @@ -195,10 +212,6 @@ instance Alternative (Parser i) where 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 diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs index 7438a912..d0970d90 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs @@ -1,7 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Attoparsec.Number --- Copyright : Bryan O'Sullivan 2007-2014 +-- Copyright : Bryan O'Sullivan 2007-2015 -- License : BSD3 -- -- Maintainer : bos@serpentine.com diff --git a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE index 97392a62..97392a62 100644 --- a/haddock-library/vendor/attoparsec-0.12.1.1/LICENSE +++ b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE |