diff options
Diffstat (limited to 'haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString')
3 files changed, 0 insertions, 1180 deletions
diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Char8.hs deleted file mode 100644 index 3bbe51f0..00000000 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Char8.hs +++ /dev/null @@ -1,549 +0,0 @@ -{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies, - TypeSynonymInstances, GADTs #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} - --- | --- Module : Data.Attoparsec.ByteString.Char8 --- Copyright : Bryan O'Sullivan 2007-2011 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient, character-oriented combinator parsing for --- 'B.ByteString' strings, loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Char8 - ( - -- * Character encodings - -- $encodings - - -- * Parser types - Parser - , A.Result - , A.IResult(..) - , I.compareResults - - -- * Running parsers - , A.parse - , A.feed - , A.parseOnly - , A.parseTest - , A.parseWith - - -- ** Result conversion - , A.maybeResult - , A.eitherResult - - -- * Combinators - , (I.<?>) - , I.try - , module Data.Attoparsec.Combinator - - -- * Parsing individual characters - , char - , char8 - , anyChar - , notChar - , peekChar - , satisfy - - -- ** Special character parsers - , digit - , letter_iso8859_15 - , letter_ascii - , space - - -- ** Fast predicates - , isDigit - , isDigit_w8 - , isAlpha_iso8859_15 - , isAlpha_ascii - , isSpace - , isSpace_w8 - - -- *** Character classes - , inClass - , notInClass - - -- * Efficient string handling - , I.string - , stringCI - , skipSpace - , skipWhile - , I.take - , scan - , takeWhile - , takeWhile1 - , takeTill - - -- ** String combinators - -- $specalt - , (.*>) - , (<*.) - - -- ** Consume all remaining input - , I.takeByteString - , I.takeLazyByteString - - -- * Text parsing - , I.endOfLine - , isEndOfLine - , isHorizontalSpace - - -- * Numeric parsers - , decimal - , hexadecimal - , signed - , double - , Number(..) - , number - , rational - - -- * State observation and manipulation functions - , I.endOfInput - , I.atEnd - ) where - -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.Ratio ((%)) -import Data.String (IsString(..)) -import Data.Word (Word8, Word16, Word32, Word64, Word) -import Prelude hiding (takeWhile) -import qualified Data.Attoparsec.ByteString as A -import qualified Data.Attoparsec.ByteString.Internal as I -import qualified Data.Attoparsec.Internal as I -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B - -instance (a ~ B.ByteString) => IsString (Parser a) where - fromString = I.string . B.pack - --- $encodings --- --- This module is intended for parsing text that is --- represented using an 8-bit character set, e.g. ASCII or --- ISO-8859-15. It /does not/ make any attempt to deal with character --- encodings, multibyte characters, or wide characters. In --- particular, all attempts to use characters above code point U+00FF --- will give wrong answers. --- --- Code points below U+0100 are simply translated to and from their --- numeric values, so e.g. the code point U+00A4 becomes the byte --- @0xA4@ (which is the Euro symbol in ISO-8859-15, but the generic --- 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. --- --- 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 :: (Char -> Bool) -> Parser B.ByteString -takeWhile1 p = I.takeWhile1 (p . w2c) -{-# INLINE takeWhile1 #-} - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > where isDigit c = c >= '0' && c <= '9' -satisfy :: (Char -> Bool) -> Parser Char -satisfy = I.satisfyWith w2c -{-# INLINE satisfy #-} - --- | Match a letter, in the ISO-8859-15 encoding. -letter_iso8859_15 :: Parser Char -letter_iso8859_15 = satisfy isAlpha_iso8859_15 <?> "letter_iso8859_15" -{-# INLINE letter_iso8859_15 #-} - --- | Match a letter, in the ASCII encoding. -letter_ascii :: Parser Char -letter_ascii = satisfy isAlpha_ascii <?> "letter_ascii" -{-# INLINE letter_ascii #-} - --- | A fast alphabetic predicate for the ISO-8859-15 encoding --- --- /Note/: For all character encodings other than ISO-8859-15, and --- almost all Unicode code points above U+00A3, this predicate gives --- /wrong answers/. -isAlpha_iso8859_15 :: Char -> Bool -isAlpha_iso8859_15 c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') || - (c >= '\166' && moby c) - where moby = notInClass "\167\169\171-\179\182\183\185\187\191\215\247" - {-# NOINLINE moby #-} -{-# INLINE isAlpha_iso8859_15 #-} - --- | A fast alphabetic predicate for the ASCII encoding --- --- /Note/: For all character encodings other than ASCII, and --- almost all Unicode code points above U+007F, this predicate gives --- /wrong answers/. -isAlpha_ascii :: Char -> Bool -isAlpha_ascii c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z') -{-# INLINE isAlpha_ascii #-} - --- | Parse a single digit. -digit :: Parser Char -digit = satisfy isDigit <?> "digit" -{-# INLINE digit #-} - --- | A fast digit predicate. -isDigit :: Char -> Bool -isDigit c = c >= '0' && c <= '9' -{-# INLINE isDigit #-} - --- | A fast digit predicate. -isDigit_w8 :: Word8 -> Bool -isDigit_w8 w = w >= 48 && w <= 57 -{-# INLINE isDigit_w8 #-} - --- | Match any character. -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. --- --- /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. -peekChar :: Parser (Maybe Char) -peekChar = (fmap w2c) `fmap` I.peekWord8 -{-# INLINE peekChar #-} - --- | Fast predicate for matching ASCII space characters. --- --- /Note/: This predicate only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. For a Unicode-aware and only slightly slower predicate, --- use 'Data.Char.isSpace' -isSpace :: Char -> Bool -isSpace c = (c == ' ') || ('\t' <= c && c <= '\r') -{-# INLINE isSpace #-} - --- | Fast 'Word8' predicate for matching ASCII space characters. -isSpace_w8 :: Word8 -> Bool -isSpace_w8 w = (w == 32) || (9 <= w && w <= 13) -{-# INLINE isSpace_w8 #-} - - --- | Parse a space character. --- --- /Note/: This parser only gives correct answers for the ASCII --- encoding. For instance, it does not recognise U+00A0 (non-breaking --- space) as a space character, even though it is a valid ISO-8859-15 --- byte. -space :: Parser Char -space = satisfy isSpace <?> "space" -{-# INLINE space #-} - --- | Match a specific character. -char :: Char -> Parser Char -char c = satisfy (== c) <?> [c] -{-# INLINE char #-} - --- | Match a specific character, but return its 'Word8' value. -char8 :: Char -> Parser Word8 -char8 c = I.satisfy (== c2w c) <?> [c] -{-# INLINE char8 #-} - --- | Match any character except the given one. -notChar :: Char -> Parser Char -notChar c = satisfy (/= c) <?> "not " ++ [c] -{-# INLINE notChar #-} - --- | Match any character in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal \'-\' to a set, place it at the beginning or end --- of the string. -inClass :: String -> Char -> Bool -inClass s = (`memberChar` mySet) - where mySet = charClass s -{-# INLINE inClass #-} - --- | Match any character not in a set. -notInClass :: String -> Char -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- 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 :: (Char -> Bool) -> Parser B.ByteString -takeWhile p = I.takeWhile (p . w2c) -{-# INLINE takeWhile #-} - --- | 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 -> Char -> Maybe s) -> Parser B.ByteString -scan s0 p = I.scan s0 (\s -> p s . w2c) -{-# INLINE scan #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- 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 :: (Char -> Bool) -> Parser B.ByteString -takeTill p = I.takeTill (p . w2c) -{-# INLINE takeTill #-} - --- | Skip past input for as long as the predicate returns 'True'. -skipWhile :: (Char -> Bool) -> Parser () -skipWhile p = I.skipWhile (p . w2c) -{-# INLINE skipWhile #-} - --- | Skip over white space. -skipSpace :: Parser () -skipSpace = I.skipWhile isSpace_w8 -{-# INLINE skipSpace #-} - --- $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. --- --- An example makes this easier to understand: --- --- @{-\# LANGUAGE OverloadedStrings #-} --- --- shoeSize = \"Shoe size: \" '.*>' 'decimal' --- @ --- --- 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. - --- | Type-specialized version of '*>' for 'B.ByteString'. -(.*>) :: B.ByteString -> Parser a -> Parser a -s .*> f = I.string s *> f - --- | Type-specialized version of '<*' for 'B.ByteString'. -(<*.) :: Parser a -> B.ByteString -> Parser a -f <*. s = f <* I.string s - --- | A predicate that matches either a carriage return @\'\\r\'@ or --- newline @\'\\n\'@ character. -isEndOfLine :: Word8 -> Bool -isEndOfLine w = w == 13 || w == 10 -{-# INLINE isEndOfLine #-} - --- | A predicate that matches either a space @\' \'@ or horizontal tab --- @\'\\t\'@ character. -isHorizontalSpace :: Word8 -> Bool -isHorizontalSpace w = w == 32 || w == 9 -{-# INLINE isHorizontalSpace #-} - --- | Parse and decode an unsigned hexadecimal number. The hex digits --- @\'a\'@ through @\'f\'@ may be upper or lower case. --- --- This parser does not accept a leading @\"0x\"@ string. -hexadecimal :: (Integral a, Bits a) => Parser a -hexadecimal = B8.foldl' step 0 `fmap` I.takeWhile1 isHexDigit - where - isHexDigit w = (w >= 48 && w <= 57) || - (w >= 97 && w <= 102) || - (w >= 65 && w <= 70) - step a w | w >= 48 && w <= 57 = (a `shiftL` 4) .|. fromIntegral (w - 48) - | w >= 97 = (a `shiftL` 4) .|. fromIntegral (w - 87) - | otherwise = (a `shiftL` 4) .|. fromIntegral (w - 55) -{-# SPECIALISE hexadecimal :: Parser Int #-} -{-# SPECIALISE hexadecimal :: Parser Int8 #-} -{-# SPECIALISE hexadecimal :: Parser Int16 #-} -{-# SPECIALISE hexadecimal :: Parser Int32 #-} -{-# SPECIALISE hexadecimal :: Parser Int64 #-} -{-# SPECIALISE hexadecimal :: Parser Integer #-} -{-# SPECIALISE hexadecimal :: Parser Word #-} -{-# SPECIALISE hexadecimal :: Parser Word8 #-} -{-# SPECIALISE hexadecimal :: Parser Word16 #-} -{-# SPECIALISE hexadecimal :: Parser Word32 #-} -{-# SPECIALISE hexadecimal :: Parser Word64 #-} - --- | 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) -{-# SPECIALISE decimal :: Parser Int #-} -{-# SPECIALISE decimal :: Parser Int8 #-} -{-# SPECIALISE decimal :: Parser Int16 #-} -{-# SPECIALISE decimal :: Parser Int32 #-} -{-# SPECIALISE decimal :: Parser Int64 #-} -{-# SPECIALISE decimal :: Parser Integer #-} -{-# SPECIALISE decimal :: Parser Word #-} -{-# SPECIALISE decimal :: Parser Word8 #-} -{-# SPECIALISE decimal :: Parser Word16 #-} -{-# SPECIALISE decimal :: Parser Word32 #-} -{-# SPECIALISE decimal :: Parser Word64 #-} - --- | Parse a number with an optional leading @\'+\'@ or @\'-\'@ sign --- character. -signed :: Num a => Parser a -> Parser a -{-# SPECIALISE signed :: Parser Int -> Parser Int #-} -{-# SPECIALISE signed :: Parser Int8 -> Parser Int8 #-} -{-# SPECIALISE signed :: Parser Int16 -> Parser Int16 #-} -{-# SPECIALISE signed :: Parser Int32 -> Parser Int32 #-} -{-# SPECIALISE signed :: Parser Int64 -> Parser Int64 #-} -{-# SPECIALISE signed :: Parser Integer -> Parser Integer #-} -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.10.4.0/Data/Attoparsec/ByteString/FastSet.hs deleted file mode 100644 index 73d02056..00000000 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/FastSet.hs +++ /dev/null @@ -1,115 +0,0 @@ -{-# LANGUAGE BangPatterns, MagicHash #-} - ------------------------------------------------------------------------------ --- | --- Module : Data.Attoparsec.ByteString.FastSet --- Copyright : Bryan O'Sullivan 2008 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Fast set membership tests for 'Word8' and 8-bit 'Char' values. The --- set representation is unboxed for efficiency. For small sets, we --- test for membership using a binary search. For larger sets, we use --- a lookup table. --- ------------------------------------------------------------------------------ -module Data.Attoparsec.ByteString.FastSet - ( - -- * Data type - FastSet - -- * Construction - , fromList - , set - -- * Lookup - , memberChar - , memberWord8 - -- * Debugging - , fromSet - -- * Handy interface - , charClass - ) where - -import Data.Bits ((.&.), (.|.)) -import Foreign.Storable (peekByteOff, pokeByteOff) -import GHC.Base (Int(I#), iShiftRA#, narrow8Word#, shiftL#) -import GHC.Word (Word8(W8#)) -import qualified Data.ByteString as B -import qualified Data.ByteString.Char8 as B8 -import qualified Data.ByteString.Internal as I -import qualified Data.ByteString.Unsafe as U - -data FastSet = Sorted { fromSet :: !B.ByteString } - | Table { fromSet :: !B.ByteString } - deriving (Eq, Ord) - -instance Show FastSet where - show (Sorted s) = "FastSet Sorted " ++ show (B8.unpack s) - show (Table _) = "FastSet Table" - --- | The lower bound on the size of a lookup table. We choose this to --- balance table density against performance. -tableCutoff :: Int -tableCutoff = 8 - --- | Create a set. -set :: B.ByteString -> FastSet -set s | B.length s < tableCutoff = Sorted . B.sort $ s - | otherwise = Table . mkTable $ s - -fromList :: [Word8] -> FastSet -fromList = set . B.pack - -data I = I {-# UNPACK #-} !Int {-# UNPACK #-} !Word8 - -shiftR :: Int -> Int -> Int -shiftR (I# x#) (I# i#) = I# (x# `iShiftRA#` i#) - -shiftL :: Word8 -> Int -> Word8 -shiftL (W8# x#) (I# i#) = W8# (narrow8Word# (x# `shiftL#` i#)) - -index :: Int -> I -index i = I (i `shiftR` 3) (1 `shiftL` (i .&. 7)) -{-# INLINE index #-} - --- | Check the set for membership. -memberWord8 :: Word8 -> FastSet -> Bool -memberWord8 w (Table t) = - let I byte bit = index (fromIntegral w) - in U.unsafeIndex t byte .&. bit /= 0 -memberWord8 w (Sorted s) = search 0 (B.length s - 1) - where search lo hi - | hi < lo = False - | otherwise = - let mid = (lo + hi) `div` 2 - in case compare w (U.unsafeIndex s mid) of - GT -> search (mid + 1) hi - LT -> search lo (mid - 1) - _ -> True - --- | Check the set for membership. Only works with 8-bit characters: --- characters above code point 255 will give wrong answers. -memberChar :: Char -> FastSet -> Bool -memberChar c = memberWord8 (I.c2w c) -{-# INLINE memberChar #-} - -mkTable :: B.ByteString -> B.ByteString -mkTable s = I.unsafeCreate 32 $ \t -> do - _ <- I.memset t 0 32 - U.unsafeUseAsCStringLen s $ \(p, l) -> - let loop n | n == l = return () - | otherwise = do - c <- peekByteOff p n :: IO Word8 - let I byte bit = index (fromIntegral c) - prev <- peekByteOff t byte :: IO Word8 - pokeByteOff t byte (prev .|. bit) - loop (n + 1) - in loop 0 - -charClass :: String -> FastSet -charClass = set . B8.pack . go - where go (a:'-':b:xs) = [a..b] ++ go xs - go (x:xs) = x : go xs - go _ = "" diff --git a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Internal.hs deleted file mode 100644 index b3699728..00000000 --- a/haddock-library/vendor/attoparsec-0.10.4.0/Data/Attoparsec/ByteString/Internal.hs +++ /dev/null @@ -1,516 +0,0 @@ -{-# LANGUAGE BangPatterns, CPP, Rank2Types, OverloadedStrings, - RecordWildCards, MagicHash, UnboxedTuples #-} --- | --- Module : Data.Attoparsec.ByteString.Internal --- Copyright : Bryan O'Sullivan 2007-2011 --- License : BSD3 --- --- Maintainer : bos@serpentine.com --- Stability : experimental --- Portability : unknown --- --- Simple, efficient parser combinators for 'B.ByteString' strings, --- loosely based on the Parsec library. - -module Data.Attoparsec.ByteString.Internal - ( - -- * Parser types - Parser - , Result - - -- * Running parsers - , parse - , parseOnly - - -- * Combinators - , (<?>) - , try - , module Data.Attoparsec.Combinator - - -- * Parsing individual bytes - , satisfy - , satisfyWith - , anyWord8 - , skip - , word8 - , notWord8 - , peekWord8 - - -- ** Byte classes - , inClass - , notInClass - - -- * Parsing more complicated structures - , storable - - -- * Efficient string handling - , skipWhile - , string - , stringTransform - , take - , scan - , takeWhile - , takeWhile1 - , takeTill - - -- ** Consume all remaining input - , takeByteString - , takeLazyByteString - - -- * State observation and manipulation functions - , endOfInput - , atEnd - - -- * Utilities - , endOfLine - ) where - -import Control.Applicative ((<|>), (<$>)) -import Control.Monad (when) -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.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 qualified Data.Attoparsec.Internal.Types as T -import qualified Data.ByteString as B8 -import qualified Data.ByteString.Char8 as B -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 #-} - --- | The parser @satisfy p@ succeeds for any byte for which the --- predicate @p@ returns 'True'. Returns the byte that is actually --- parsed. --- --- >digit = satisfy isDigit --- > 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 - else fail "satisfy" -{-# INLINE satisfy #-} - --- | The parser @skip p@ succeeds for any byte for which the predicate --- @p@ returns 'True'. --- --- >skipDigit = skip isDigit --- > 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) - else fail "skip" - --- | The parser @satisfyWith f p@ transforms a byte, and succeeds if --- the predicate @p@ returns 'True' on the transformed value. The --- 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 - if p c - then let !t = B.unsafeTail s - in put t >> return c - else fail "satisfyWith" -{-# INLINE satisfyWith #-} - -storable :: Storable a => Parser a -storable = hack undefined - where - hack :: Storable b => b -> Parser b - hack dummy = do - (fp,o,_) <- B.toForeignPtr `fmap` take (sizeOf dummy) - return . B.inlinePerformIO . withForeignPtr fp $ \p -> - peek (castPtr $ p `plusPtr` o) - --- | Consume @n@ bytes of input, but succeed only if the predicate --- returns 'True'. -takeWith :: Int -> (B.ByteString -> Bool) -> Parser B.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 - else fail "takeWith" - --- | Consume exactly @n@ bytes of input. -take :: Int -> Parser B.ByteString -take n = takeWith n (const True) -{-# INLINE take #-} - --- | @string s@ parses a sequence of bytes that identically match --- @s@. Returns the parsed string (i.e. @s@). This parser consumes no --- input if it fails (even if a partial match). --- --- /Note/: The behaviour of this parser is different to that of the --- similarly-named parser in Parsec, as this one is all-or-nothing. --- To illustrate the difference, the following parser will fail under --- Parsec given an input of @\"for\"@: --- --- >string "foo" <|> string "for" --- --- 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 --- that input, because the failed first branch will consume nothing. -string :: B.ByteString -> Parser B.ByteString -string s = takeWith (B.length s) (==s) -{-# INLINE string #-} - -stringTransform :: (B.ByteString -> B.ByteString) -> B.ByteString - -> Parser B.ByteString -stringTransform f s = takeWith (B.length s) ((==f s) . f) -{-# INLINE stringTransform #-} - --- | Skip past input for as long as the predicate returns 'True'. -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 -{-# INLINE skipWhile #-} - --- | Consume input as long as the predicate returns 'False' --- (i.e. until it returns 'True'), and return the consumed input. --- --- This parser does not fail. It will return an empty string if the --- 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 -takeTill p = takeWhile (not . p) -{-# INLINE takeTill #-} - --- | Consume input as long as the predicate returns 'True', and return --- the consumed input. --- --- This parser does not fail. It will return an empty string if the --- 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 -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) -{-# INLINE takeWhile #-} - -takeRest :: Parser [B.ByteString] -takeRest = go [] - where - go acc = do - input <- wantInput - if input - then do - s <- get - put B.empty - go (s:acc) - else return (reverse acc) - --- | Consume all remaining input and return it as a single string. -takeByteString :: Parser B.ByteString -takeByteString = B.concat `fmap` takeRest - --- | Consume all remaining input and return it as a single string. -takeLazyByteString :: Parser L.ByteString -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 - where - go acc s1 = do - let scanner (B.PS fp off len) = - withForeignPtr fp $ \ptr0 -> do - let start = ptr0 `plusPtr` off - end = start `plusPtr` len - inner ptr !s - | ptr < end = do - w <- peek ptr - case p s w of - Just s' -> inner (ptr `plusPtr` 1) s' - _ -> done (ptr `minusPtr` start) s - | otherwise = done (ptr `minusPtr` start) s - done !i !s = return (T i s) - inner start s1 - 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) -{-# INLINE scan #-} - --- | 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 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 - --- | Match any byte in a set. --- --- >vowel = inClass "aeiou" --- --- Range notation is supported. --- --- >halfAlphabet = inClass "a-nA-N" --- --- To add a literal @\'-\'@ to a set, place it at the beginning or end --- of the string. -inClass :: String -> Word8 -> Bool -inClass s = (`memberWord8` mySet) - where mySet = charClass s - {-# NOINLINE mySet #-} -{-# INLINE inClass #-} - --- | Match any byte not in a set. -notInClass :: String -> Word8 -> Bool -notInClass s = not . inClass s -{-# INLINE notInClass #-} - --- | Match any byte. -anyWord8 :: Parser Word8 -anyWord8 = satisfy $ const True -{-# INLINE anyWord8 #-} - --- | Match a specific byte. -word8 :: Word8 -> Parser Word8 -word8 c = satisfy (== c) <?> show c -{-# INLINE word8 #-} - --- | Match any byte except the given one. -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. --- --- /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. -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) -{-# 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 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 -{-# INLINE failK #-} - --- | Terminal success continuation. -successK :: Success a a -successK i0 _a0 _m0 a = Done (unI i0) 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 -{-# 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 - 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 #-} |