diff options
Diffstat (limited to 'haddock-library/vendor/attoparsec-0.13.1.0')
12 files changed, 2342 insertions, 0 deletions
diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs new file mode 100644 index 00000000..bd3c5592 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs @@ -0,0 +1,23 @@ +-- | +-- Module : Data.Attoparsec +-- Copyright : Bryan O'Sullivan 2007-2015 +-- 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.13.1.0/Data/Attoparsec/ByteString.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs new file mode 100644 index 00000000..84e567d9 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs @@ -0,0 +1,230 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 702 +{-# LANGUAGE Trustworthy #-} +#endif +-- | +-- Module : Data.Attoparsec.ByteString +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient combinator parsing for 'B.ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString + ( + -- * Differences from Parsec + -- $parsec + + -- * Incremental input + -- $incremental + + -- * Performance considerations + -- $performance + + -- * Parser types + I.Parser + , Result + , T.IResult(..) + , I.compareResults + + -- * Running parsers + , parse + , feed + , I.parseOnly + , parseWith + , parseTest + + -- ** Result conversion + , maybeResult + , eitherResult + + -- * Parsing individual bytes + , I.word8 + , I.anyWord8 + , I.notWord8 + , I.satisfy + , I.satisfyWith + , I.skip + + -- ** Lookahead + , I.peekWord8 + , I.peekWord8' + + -- ** Byte classes + , I.inClass + , I.notInClass + + -- * Efficient string handling + , I.string + , I.skipWhile + , I.take + , I.scan + , I.runScanner + , I.takeWhile + , I.takeWhile1 + , I.takeTill + + -- ** Consume all remaining input + , 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 + ) 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 +import Data.Attoparsec.ByteString.Internal (Result, parse) +import qualified Data.Attoparsec.Internal.Types as T + +-- $parsec +-- +-- 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. +-- 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 +-- 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 +-- monad transformer. +-- +-- * 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 +-- excellent substitute, with much more control over when input +-- 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 +-- the extra book-keeping in favour of higher performance. + +-- $incremental +-- +-- 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 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. +-- +-- Remember that some parsing combinators will not return a result +-- until they reach the end of input. They may thus cause 'T.Partial' +-- results to be returned. +-- +-- 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 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. +-- +-- Use the 'B.ByteString'-oriented parsers whenever possible, +-- e.g. 'I.takeWhile1' instead of 'many1' 'I.anyWord8'. There is +-- about a factor of 100 difference in performance between the two +-- kinds of parser. +-- +-- For very simple byte-testing predicates, write them by hand instead +-- of using 'I.inClass' or 'I.notInClass'. For instance, both of +-- these predicates test for an end-of-line byte, but the first is +-- much faster than the second: +-- +-- >endOfLine_fast w = w == 13 || w == 10 +-- >endOfLine_slow = inClass "\r\n" +-- +-- Make active use of benchmarking and profiling tools to measure, +-- find the problems with, and improve the performance of your parser. + +-- | 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) + +-- | Run a parser with an initial input string, and a monadic action +-- that can supply more input if needed. +parseWith :: Monad m => + (m B.ByteString) + -- ^ An action that will be executed to provide the parser + -- with more input, if necessary. The action must return an + -- 'B.empty' string when there is no more input available. + -> I.Parser a + -> B.ByteString + -- ^ Initial input for the parser. + -> m (Result a) +parseWith refill p s = step $ parse p s + where step (T.Partial k) = (step . k) =<< refill + step r = return r +{-# INLINE parseWith #-} + +-- | Convert a 'Result' value to a 'Maybe' value. A 'T.Partial' result +-- is treated as failure. +maybeResult :: Result r -> Maybe r +maybeResult (T.Done _ r) = Just r +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 (T.Fail _ ctxs msg) = Left (intercalate " > " ctxs ++ ": " ++ msg) +eitherResult _ = Left "Result: incomplete input" diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs new file mode 100644 index 00000000..ac94dfcc --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs @@ -0,0 +1,156 @@ +{-# LANGUAGE BangPatterns #-} +-- | +-- Module : Data.Attoparsec.ByteString.Buffer +-- Copyright : Bryan O'Sullivan 2007-2015 +-- 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 as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +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) + +-- If _cap is zero, this buffer is empty. +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 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 = (<>) + + mconcat [] = Mon.mempty + mconcat xs = foldl1' mappend xs + +pappend :: Buffer -> ByteString -> Buffer +pappend (Buf _ _ _ 0 _) bs = buffer bs +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.13.1.0/Data/Attoparsec/ByteString/Char8.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs new file mode 100644 index 00000000..7fafba40 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs @@ -0,0 +1,464 @@ +{-# 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-2015 +-- 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.parseWith + , A.parseTest + + -- ** Result conversion + , A.maybeResult + , A.eitherResult + + -- * Parsing individual characters + , char + , char8 + , anyChar + , notChar + , satisfy + + -- ** Lookahead + , peekChar + , peekChar' + + -- ** 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 + , I.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 + + -- * 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 + ) where + +#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.Bits (Bits, (.|.), shiftL) +import Data.ByteString.Internal (c2w, w2c) +import Data.Int (Int8, Int16, Int32, Int64) +import Data.String (IsString(..)) +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 +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@. + +-- | 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 <= 9 +{-# INLINE isDigit_w8 #-} + +-- | Match any character. +anyChar :: Parser Char +anyChar = satisfy $ const True +{-# INLINE anyChar #-} + +-- | 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 +-- failure occurs. Careless use will thus result in an infinite loop. +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 +-- 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 || w - 9 <= 4 +{-# 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 +-- +-- 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: +-- +-- @ +--'I.string' \"foo\" '*>' wibble +-- @ +-- +-- Using @OverloadedStrings@, you can omit the explicit use of +-- 'I.string', and write a more compact version: +-- +-- @ +-- \"foo\" '*>' wibble +-- @ +-- +-- (Note: the '.*>' and '<*.' combinators that were originally +-- provided for this purpose are obsolete and unnecessary, and will be +-- removed in the next major version.) + +-- | /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." #-} + +-- | /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. +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 isDigit_w8 + where 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 + diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs new file mode 100644 index 00000000..d15854c4 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs @@ -0,0 +1,115 @@ +{-# LANGUAGE BangPatterns, MagicHash #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Data.Attoparsec.ByteString.FastSet +-- Copyright : Bryan O'Sullivan 2007-2015 +-- 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) `quot` 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.13.1.0/Data/Attoparsec/ByteString/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs new file mode 100644 index 00000000..4938ea87 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs @@ -0,0 +1,536 @@ +{-# LANGUAGE BangPatterns, CPP, GADTs, OverloadedStrings, RankNTypes, + RecordWildCards #-} +-- | +-- Module : Data.Attoparsec.ByteString.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators for 'ByteString' strings, +-- loosely based on the Parsec library. + +module Data.Attoparsec.ByteString.Internal + ( + -- * Parser types + Parser + , Result + + -- * Running parsers + , parse + , parseOnly + + -- * Combinators + , module Data.Attoparsec.Combinator + + -- * Parsing individual bytes + , satisfy + , satisfyWith + , anyWord8 + , skip + , word8 + , notWord8 + + -- ** Lookahead + , peekWord8 + , peekWord8' + + -- ** Byte classes + , inClass + , notInClass + + -- * Parsing more complicated structures + , storable + + -- * Efficient string handling + , skipWhile + , string + , stringCI + , take + , scan + , runScanner + , takeWhile + , takeWhile1 + , takeTill + + -- ** Consume all remaining input + , takeByteString + , takeLazyByteString + + -- * Utilities + , endOfLine + , endOfInput + , match + , atEnd + ) where + +#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) +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.List (intercalate) +import Data.Word (Word8) +import Foreign.ForeignPtr (withForeignPtr) +import Foreign.Ptr (castPtr, minusPtr, plusPtr) +import Foreign.Storable (Storable(peek, sizeOf)) +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 +import qualified Data.ByteString.Internal as B +import qualified Data.ByteString.Lazy as L +import qualified Data.ByteString.Unsafe as B + +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 +-- parsed. +-- +-- >digit = satisfy isDigit +-- > where isDigit w = w >= 48 && w <= 57 +satisfy :: (Word8 -> Bool) -> Parser Word8 +satisfy p = do + h <- peekWord8' + if p h + then advance 1 >> return h + 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 + h <- peekWord8' + if p h + then advance 1 + 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 + h <- peekWord8' + let c = f h + if p c + then advance 1 >> 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 . inlinePerformIO . withForeignPtr fp $ \p -> + peek (castPtr $ p `plusPtr` o) + +-- | Consume exactly @n@ bytes of input. +take :: Int -> Parser ByteString +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 +-- @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 :: ByteString -> Parser ByteString +string s = string_ (stringSuspended id) id s +{-# INLINE string #-} + +-- 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 () +skipWhile p = go + where + go = do + t <- B8.takeWhile p <$> get + continue <- inputSpansChunks (B.length t) + when continue 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 '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 #-} + +-- | 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 '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 = 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 $ concatReverse (s:acc) +{-# INLINE takeWhileAcc #-} + +takeRest :: Parser [ByteString] +takeRest = go [] + where + go acc = do + input <- wantInput + if input + then do + s <- get + advance (B.length s) + go (s:acc) + else return (reverse acc) + +-- | Consume all remaining input and return it as a single string. +takeByteString :: Parser 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 + +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) = + 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 + 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 -> 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 -> let !sx = concatReverse xs in return (sx, 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 ByteString +takeWhile1 p = do + (`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 takeWhileAcc p [s] + else return s +{-# INLINE takeWhile1 #-} + +-- | 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, 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 '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 $ \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 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 ()) + +-- | Terminal failure continuation. +failK :: Failure a +failK t (Pos pos) _more stack msg = Fail (Buf.unsafeDrop pos t) stack msg +{-# INLINE failK #-} + +-- | Terminal success continuation. +successK :: Success a a +successK t (Pos pos) _more a = Done (Buf.unsafeDrop pos t) a +{-# INLINE successK #-} + +-- | Run a parser. +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. +-- +-- 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 + Fail _ ctxs err -> Left (intercalate " > " ctxs ++ ": " ++ err) + Done _ a -> Right a + _ -> error "parseOnly: impossible error!" +{-# INLINE parseOnly #-} + +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 +{-# 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.13.1.0/Data/Attoparsec/Combinator.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs new file mode 100644 index 00000000..dde0c27a --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs @@ -0,0 +1,233 @@ +{-# 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-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : portable +-- +-- Useful parser combinators, similar to those provided by Parsec. +module Data.Attoparsec.Combinator + ( + -- * Combinators + try + , (<?>) + , choice + , count + , option + , many' + , many1 + , many1' + , manyTill + , manyTill' + , sepBy + , sepBy' + , sepBy1 + , sepBy1' + , skipMany + , skipMany1 + , eitherP + , feed + , satisfyElem + , endOfInput + , atEnd + , lookAhead + ) where + +#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 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 +{-# 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 +-- returned by @p@. +-- +-- > priority = option 0 (digitToInt <$> digit) +option :: Alternative f => a -> f a -> f a +option x p = p <|> pure x +{-# SPECIALIZE option :: a -> Parser ByteString a -> Parser ByteString a #-} + +-- | A version of 'liftM2' that is strict in the result of its first +-- action. +liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c +liftM2' f a b = do + !x <- a + y <- b + return (f x y) +{-# INLINE liftM2' #-} + +-- | @many' p@ applies the action @p@ /zero/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many' letter +many' :: (MonadPlus m) => m a -> m [a] +many' p = many_p + where many_p = some_p `mplus` return [] + some_p = liftM2' (:) p many_p +{-# INLINE many' #-} + +-- | @many1 p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. +-- +-- > word = many1 letter +many1 :: Alternative f => f a -> f [a] +many1 p = liftA2 (:) p (many p) +{-# INLINE many1 #-} + +-- | @many1' p@ applies the action @p@ /one/ or more times. Returns a +-- list of the returned values of @p@. The value returned by @p@ is +-- forced to WHNF. +-- +-- > word = many1' letter +many1' :: (MonadPlus m) => m a -> m [a] +many1' p = liftM2' (:) p (many' p) +{-# INLINE many1' #-} + +-- | @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` (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 + -> Parser ByteString [a] #-} + +-- | @sepBy' p sep@ applies /zero/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > 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 []) +{-# SPECIALIZE sepBy' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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` (char ',') +sepBy1 :: Alternative f => f a -> f s -> f [a] +sepBy1 p s = scan + where scan = liftA2 (:) p ((s *> scan) <|> pure []) +{-# SPECIALIZE sepBy1 :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@, separated +-- by @sep@. Returns a list of the values returned by @p@. The value +-- returned by @p@ is forced to WHNF. +-- +-- > 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 []) +{-# SPECIALIZE sepBy1' :: Parser ByteString a -> Parser ByteString s + -> Parser ByteString [a] #-} + +-- | @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 (string "-->") +-- +-- (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 +{-# SPECIALIZE manyTill :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | @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 (string "-->") +-- +-- (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 +{-# SPECIALIZE manyTill' :: Parser ByteString a -> Parser ByteString b + -> Parser ByteString [a] #-} + +-- | Skip zero or more instances of an action. +skipMany :: Alternative f => f a -> f () +skipMany p = scan + where scan = (p *> scan) <|> pure () +{-# SPECIALIZE skipMany :: Parser ByteString a -> Parser ByteString () #-} + +-- | Skip one or more instances of an action. +skipMany1 :: Alternative f => f a -> f () +skipMany1 p = p *> skipMany p +{-# SPECIALIZE skipMany1 :: Parser ByteString a -> Parser ByteString () #-} + +-- | Apply the given action repeatedly, returning every result. +count :: Monad m => Int -> m a -> m [a] +count n p = sequence (replicate n p) +{-# INLINE count #-} + +-- | Combine two alternatives. +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 (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.13.1.0/Data/Attoparsec/Internal.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs new file mode 100644 index 00000000..ee758b26 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE BangPatterns, CPP, ScopedTypeVariables #-} +-- | +-- Module : Data.Attoparsec.Internal +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal + ( compareResults + , prompt + , demandInput + , demandInput_ + , wantInput + , endOfInput + , atEnd + , satisfyElem + , concatReverse + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +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. +-- +-- 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 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) + -> (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 +{-# SPECIALIZE prompt :: State ByteString -> Pos -> More + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> (State ByteString -> Pos -> More + -> IResult ByteString r) + -> IResult ByteString r #-} + +-- | 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' _ pos' more' = lose t pos' more' [] "not enough input" + succ' t' pos' more' = succ t' pos' more' () + in prompt t pos more lose' succ' +{-# SPECIALIZE demandInput :: Parser ByteString () #-} + +-- | 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 +-- 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' +{-# SPECIALIZE endOfInput :: Parser ByteString () #-} + +-- | 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' +{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool) + -> State ByteString -> Pos -> More + -> Failure ByteString (State ByteString) r + -> Success ByteString (State ByteString) + (ChunkElem ByteString) r + -> IResult ByteString r #-} + +-- | 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 #-} + +-- | 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.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs new file mode 100644 index 00000000..0e00ed2c --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE BangPatterns, Rank2Types, OverloadedStrings, + RecordWildCards, MagicHash, UnboxedTuples #-} + +module Data.Attoparsec.Internal.Fhthagn + ( + inlinePerformIO + ) where + +import GHC.Base (realWorld#) +import GHC.IO (IO(IO)) + +-- | Just like unsafePerformIO, but we inline it. Big performance gains as +-- it exposes lots of things to further inlining. /Very unsafe/. In +-- particular, you should do no memory allocation inside an +-- 'inlinePerformIO' block. On Hugs this is just @unsafePerformIO@. +inlinePerformIO :: IO a -> a +inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +{-# INLINE inlinePerformIO #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs new file mode 100644 index 00000000..96bc319e --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs @@ -0,0 +1,243 @@ +{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings, + Rank2Types, RecordWildCards, TypeFamilies #-} +-- | +-- Module : Data.Attoparsec.Internal.Types +-- Copyright : Bryan O'Sullivan 2007-2015 +-- License : BSD3 +-- +-- Maintainer : bos@serpentine.com +-- Stability : experimental +-- Portability : unknown +-- +-- Simple, efficient parser combinators, loosely based on the Parsec +-- library. + +module Data.Attoparsec.Internal.Types + ( + Parser(..) + , State + , Failure + , Success + , Pos(..) + , IResult(..) + , More(..) + , (<>) + , Chunk(..) + ) where + +import Control.Applicative as App (Applicative(..), (<$>)) +import Control.Applicative (Alternative(..)) +import Control.DeepSeq (NFData(rnf)) +import Control.Monad (MonadPlus(..)) +import qualified Control.Monad.Fail as Fail (MonadFail(..)) +import Data.Monoid as Mon (Monoid(..)) +import Data.Semigroup (Semigroup(..)) +import Data.Word (Word8) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.ByteString.Internal (w2c) +import Prelude hiding (getChar, succ) +import qualified Data.Attoparsec.ByteString.Buffer as B + +newtype Pos = Pos { fromPos :: Int } + deriving (Eq, Ord, Show, Num) + +-- | The result of a parse. This is parameterised over the type @i@ +-- of string that was processed. +-- +-- This type is an instance of 'Functor', where 'fmap' transforms the +-- value in a 'Done' result. +data IResult i r = + Fail i [String] String + -- ^ The parse failed. The @i@ parameter is the input that had + -- not yet been consumed when the failure occurred. The + -- @[@'String'@]@ is a list of contexts in which the error + -- occurred. The 'String' is the message describing the error, if + -- any. + | Partial (i -> IResult i r) + -- ^ Supply this continuation with more input so that the parser + -- can resume. To indicate that no more input is available, pass + -- an empty string to the continuation. + -- + -- __Note__: if you get a 'Partial' result, do not call its + -- continuation more than once. + | Done i r + -- ^ The parse succeeded. The @i@ parameter is the input that had + -- not yet been consumed (if any) when the parse succeeded. + +instance (Show i, Show r) => Show (IResult i r) where + showsPrec d ir = showParen (d > 10) $ + case ir of + (Fail t stk msg) -> showString "Fail" . f t . f stk . f msg + (Partial _) -> showString "Partial _" + (Done t r) -> showString "Done" . f t . f r + where f :: Show a => a -> ShowS + f x = showChar ' ' . showsPrec 11 x + +instance (NFData i, NFData r) => NFData (IResult i r) where + rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg + rnf (Partial _) = () + rnf (Done t r) = rnf t `seq` rnf r + {-# INLINE rnf #-} + +instance Functor (IResult i) where + fmap _ (Fail t stk msg) = Fail t stk msg + fmap f (Partial k) = Partial (fmap f . k) + fmap f (Done t r) = Done t (f r) + +-- | The core parser type. This is parameterised over the type @i@ +-- of string being processed. +-- +-- This type is an instance of the following classes: +-- +-- * 'Monad', where 'fail' throws an exception (i.e. fails) with an +-- error message. +-- +-- * 'Functor' and 'Applicative', which follow the usual definitions. +-- +-- * 'MonadPlus', where 'mzero' fails (with no error message) and +-- 'mplus' executes the right-hand parser if the left-hand one +-- fails. When the parser on the right executes, the input is reset +-- to the same state as the parser on the left started with. (In +-- other words, attoparsec is a backtracking parser that supports +-- arbitrary lookahead.) +-- +-- * 'Alternative', which follows 'MonadPlus'. +newtype Parser i a = Parser { + runParser :: forall r. + State i -> Pos -> More + -> Failure i (State i) r + -> Success i (State i) a r + -> IResult i r + } + +type family State i +type instance State ByteString = B.Buffer + +type Failure i t r = t -> Pos -> More -> [String] -> String + -> IResult i r +type Success i t a r = t -> Pos -> More -> a -> IResult i r + +-- | Have we read all available input? +data More = Complete | Incomplete + deriving (Eq, Show) + +instance Semigroup More where + c@Complete <> _ = c + _ <> m = m + +instance Mon.Monoid More where + mappend = (<>) + mempty = Incomplete + +instance Monad (Parser i) where + fail = Fail.fail + {-# INLINE fail #-} + + return = App.pure + {-# INLINE return #-} + + m >>= k = Parser $ \t !pos more lose succ -> + let succ' t' !pos' more' a = runParser (k a) t' pos' more' lose succ + in runParser m t pos more lose succ' + {-# INLINE (>>=) #-} + + (>>) = (*>) + {-# INLINE (>>) #-} + + +instance Fail.MonadFail (Parser i) where + fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg + where msg = "Failed reading: " ++ err + {-# INLINE fail #-} + +plus :: Parser i a -> Parser i a -> Parser i a +plus f g = Parser $ \t pos more lose succ -> + let lose' t' _pos' more' _ctx _msg = runParser g t' pos more' lose succ + in runParser f t pos more lose' succ + +instance MonadPlus (Parser i) where + mzero = fail "mzero" + {-# INLINE mzero #-} + mplus = plus + +instance Functor (Parser i) where + fmap f p = Parser $ \t pos more lose succ -> + let succ' t' pos' more' a = succ t' pos' more' (f a) + in runParser p t pos more lose succ' + {-# INLINE fmap #-} + +apP :: Parser i (a -> b) -> Parser i a -> Parser i b +apP d e = do + b <- d + a <- e + return (b a) +{-# INLINE apP #-} + +instance Applicative (Parser i) where + pure v = Parser $ \t pos more _lose succ -> succ t pos more v + {-# INLINE pure #-} + (<*>) = apP + {-# INLINE (<*>) #-} + m *> k = m >>= \_ -> k + {-# INLINE (*>) #-} + x <* y = x >>= \a -> y >> pure a + {-# INLINE (<*) #-} + +instance Semigroup (Parser i a) where + (<>) = plus + {-# INLINE (<>) #-} + +instance Monoid (Parser i a) where + mempty = fail "mempty" + {-# INLINE mempty #-} + mappend = (<>) + {-# INLINE mappend #-} + +instance Alternative (Parser i) where + empty = fail "empty" + {-# INLINE empty #-} + + (<|>) = plus + {-# INLINE (<|>) #-} + + many v = many_v + where many_v = some_v <|> pure [] + some_v = (:) App.<$> v <*> many_v + {-# INLINE many #-} + + some v = some_v + where + many_v = some_v <|> pure [] + some_v = (:) <$> v <*> many_v + {-# INLINE some #-} + +-- | A common interface for input chunks. +class Monoid c => Chunk c where + type ChunkElem c + -- | Test if the chunk is empty. + nullChunk :: c -> Bool + -- | Append chunk to a buffer. + pappendChunk :: State c -> c -> State c + -- | Position at the end of a buffer. The first argument is ignored. + atBufferEnd :: c -> State c -> Pos + -- | Return the buffer element at the given position along with its length. + bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int) + -- | Map an element to the corresponding character. + -- The first argument is ignored. + chunkElemToChar :: c -> ChunkElem c -> Char + +instance Chunk ByteString where + type ChunkElem ByteString = Word8 + nullChunk = BS.null + {-# INLINE nullChunk #-} + pappendChunk = B.pappend + {-# INLINE pappendChunk #-} + atBufferEnd _ = Pos . B.length + {-# INLINE atBufferEnd #-} + bufferElemAt _ (Pos i) buf + | i < B.length buf = Just (B.unsafeIndex buf i, 1) + | otherwise = Nothing + {-# INLINE bufferElemAt #-} + chunkElemToChar _ = w2c + {-# INLINE chunkElemToChar #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs new file mode 100644 index 00000000..d0970d90 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs @@ -0,0 +1,137 @@ +{-# LANGUAGE DeriveDataTypeable #-} +-- | +-- Module : Data.Attoparsec.Number +-- Copyright : Bryan O'Sullivan 2007-2015 +-- 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 + +import Control.DeepSeq (NFData(rnf)) +import Data.Data (Data) +import Data.Function (on) +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 + show (D a) = show a + +instance NFData Number where + rnf (I _) = () + rnf (D _) = () + {-# INLINE rnf #-} + +binop :: (Integer -> Integer -> a) -> (Double -> Double -> a) + -> Number -> Number -> a +binop _ d (D a) (D b) = d a b +binop i _ (I a) (I b) = i a b +binop _ d (D a) (I b) = d a (fromIntegral b) +binop _ d (I a) (D b) = d (fromIntegral a) b +{-# INLINE binop #-} + +instance Eq Number where + (==) = binop (==) (==) + {-# INLINE (==) #-} + + (/=) = binop (/=) (/=) + {-# INLINE (/=) #-} + +instance Ord Number where + (<) = binop (<) (<) + {-# INLINE (<) #-} + + (<=) = binop (<=) (<=) + {-# INLINE (<=) #-} + + (>) = binop (>) (>) + {-# INLINE (>) #-} + + (>=) = binop (>=) (>=) + {-# INLINE (>=) #-} + + compare = binop compare compare + {-# INLINE compare #-} + +instance Num Number where + (+) = binop (((I$!).) . (+)) (((D$!).) . (+)) + {-# INLINE (+) #-} + + (-) = binop (((I$!).) . (-)) (((D$!).) . (-)) + {-# INLINE (-) #-} + + (*) = binop (((I$!).) . (*)) (((D$!).) . (*)) + {-# INLINE (*) #-} + + abs (I a) = I $! abs a + abs (D a) = D $! abs a + {-# INLINE abs #-} + + negate (I a) = I $! negate a + negate (D a) = D $! negate a + {-# INLINE negate #-} + + signum (I a) = I $! signum a + signum (D a) = D $! signum a + {-# INLINE signum #-} + + fromInteger = (I$!) . fromInteger + {-# INLINE fromInteger #-} + +instance Real Number where + toRational (I a) = fromIntegral a + toRational (D a) = toRational a + {-# INLINE toRational #-} + +instance Fractional Number where + fromRational = (D$!) . fromRational + {-# INLINE fromRational #-} + + (/) = binop (((D$!).) . (/) `on` fromIntegral) + (((D$!).) . (/)) + {-# INLINE (/) #-} + + recip (I a) = D $! recip (fromIntegral a) + recip (D a) = D $! recip a + {-# INLINE recip #-} + +instance RealFrac Number where + properFraction (I a) = (fromIntegral a,0) + properFraction (D a) = case properFraction a of + (i,d) -> (i,D d) + {-# INLINE properFraction #-} + truncate (I a) = fromIntegral a + truncate (D a) = truncate a + {-# INLINE truncate #-} + round (I a) = fromIntegral a + round (D a) = round a + {-# INLINE round #-} + ceiling (I a) = fromIntegral a + ceiling (D a) = ceiling a + {-# INLINE ceiling #-} + floor (I a) = fromIntegral a + floor (D a) = floor a + {-# INLINE floor #-} diff --git a/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE b/haddock-library/vendor/attoparsec-0.13.1.0/LICENSE new file mode 100644 index 00000000..97392a62 --- /dev/null +++ b/haddock-library/vendor/attoparsec-0.13.1.0/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. |