haddock-library 1.4.3 → 1.4.4
raw patch · 27 files changed
+2394/−2242 lines, 27 filesdep +faildep +haddock-librarydep +semigroupsdep ~QuickCheckdep ~base-compatdep ~hspecPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: fail, haddock-library, semigroups
Dependency ranges changed: QuickCheck, base-compat, hspec, transformers
API changes (from Hackage documentation)
+ Documentation.Haddock.Utf8: decodeUtf8 :: ByteString -> String
+ Documentation.Haddock.Utf8: encodeUtf8 :: String -> ByteString
- Documentation.Haddock.Parser.Monad: eitherP :: (Alternative f) => f a -> f b -> f (Either a b)
+ Documentation.Haddock.Parser.Monad: eitherP :: Alternative f => f a -> f b -> f Either a b
- Documentation.Haddock.Parser.Monad: many' :: (MonadPlus m) => m a -> m [a]
+ Documentation.Haddock.Parser.Monad: many' :: MonadPlus m => m a -> m [a]
- Documentation.Haddock.Parser.Monad: many1' :: (MonadPlus m) => m a -> m [a]
+ Documentation.Haddock.Parser.Monad: many1' :: MonadPlus m => m a -> m [a]
- Documentation.Haddock.Parser.Monad: manyTill' :: (MonadPlus m) => m a -> m b -> m [a]
+ Documentation.Haddock.Parser.Monad: manyTill' :: MonadPlus m => m a -> m b -> m [a]
- Documentation.Haddock.Parser.Monad: sepBy' :: (MonadPlus m) => m a -> m s -> m [a]
+ Documentation.Haddock.Parser.Monad: sepBy' :: MonadPlus m => m a -> m s -> m [a]
- Documentation.Haddock.Parser.Monad: sepBy1' :: (MonadPlus m) => m a -> m s -> m [a]
+ Documentation.Haddock.Parser.Monad: sepBy1' :: MonadPlus m => m a -> m s -> m [a]
Files
- haddock-library.cabal +59/−15
- src/Documentation/Haddock/Parser.hs +13/−8
- src/Documentation/Haddock/Parser/Util.hs +6/−3
- src/Documentation/Haddock/Types.hs +3/−1
- test/Documentation/Haddock/ParserSpec.hs +1/−2
- vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs +0/−23
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs +0/−223
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs +0/−151
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs +0/−469
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs +0/−115
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs +0/−485
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs +0/−220
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs +0/−142
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs +0/−18
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs +0/−230
- vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs +0/−137
- vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs +23/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs +230/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs +156/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs +464/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs +115/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs +536/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs +233/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs +157/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs +18/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs +243/−0
- vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs +137/−0
haddock-library.cabal view
@@ -1,5 +1,5 @@ name: haddock-library-version: 1.4.3+version: 1.4.4 synopsis: Library exposing some functionality of Haddock. description: Haddock is a documentation-generation tool for Haskell libraries. These modules expose some functionality of it@@ -14,8 +14,7 @@ bug-reports: https://github.com/haskell/haddock/issues category: Documentation build-type: Simple-cabal-version: >= 1.10-stability: experimental+cabal-version: >= 2.0 library default-language: Haskell2010@@ -24,9 +23,11 @@ base >= 4.5 && < 4.11 , bytestring >= 0.9.2.1 && < 0.11 , transformers >= 0.3.0 && < 0.6- , deepseq >= 1.3 && < 1.5 - hs-source-dirs: src, vendor/attoparsec-0.12.1.1+ -- internal sub-lib+ build-depends: attoparsec++ hs-source-dirs: src ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2 exposed-modules:@@ -34,12 +35,34 @@ Documentation.Haddock.Parser.Monad Documentation.Haddock.Types Documentation.Haddock.Doc+ Documentation.Haddock.Utf8 other-modules:- Data.Attoparsec+ Documentation.Haddock.Parser.Util++ ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances++library attoparsec+ default-language: Haskell2010++ build-depends:+ base >= 4.5 && < 4.11+ , bytestring >= 0.9.2.1 && < 0.11+ , deepseq >= 1.3 && < 1.5++ hs-source-dirs: vendor/attoparsec-0.13.1.0++ -- NB: haddock-library needs only small part of lib:attoparsec+ -- internally, so we only bundle that subset here+ exposed-modules: Data.Attoparsec.ByteString- Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.Char8++ other-modules:+ Data.Attoparsec+ Data.Attoparsec.ByteString.Buffer Data.Attoparsec.ByteString.FastSet Data.Attoparsec.ByteString.Internal Data.Attoparsec.Combinator@@ -47,9 +70,16 @@ Data.Attoparsec.Internal.Fhthagn Data.Attoparsec.Internal.Types Data.Attoparsec.Number- Documentation.Haddock.Parser.Util- Documentation.Haddock.Utf8 + ghc-options: -funbox-strict-fields -Wall -fwarn-tabs -O2++ ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+ else+ build-depends: semigroups ^>= 0.18.3, fail ^>= 4.9.0.0++ test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010@@ -57,26 +87,40 @@ hs-source-dirs: test , src- , vendor/attoparsec-0.12.1.1 ghc-options: -Wall cpp-options: -DTEST other-modules:+ Documentation.Haddock.Doc+ Documentation.Haddock.Parser+ Documentation.Haddock.Parser.Monad+ Documentation.Haddock.Parser.Util+ Documentation.Haddock.Parser.UtilSpec Documentation.Haddock.ParserSpec+ Documentation.Haddock.Types+ Documentation.Haddock.Utf8 Documentation.Haddock.Utf8Spec- Documentation.Haddock.Parser.UtilSpec build-depends:+ base-compat ^>= 0.9.3+ , transformers >= 0.3.0 && < 0.6+ , hspec ^>= 2.4.4+ , QuickCheck ^>= 2.10++ -- internal sub-lib+ build-depends: attoparsec++ -- Versions for the dependencies below are transitively pinned by+ -- dependency on haddock-library:lib:attoparsec+ build-depends: base , bytestring- , transformers , deepseq - , base-compat- , hspec- , QuickCheck == 2.*+ build-tool-depends:+ hspec-discover:hspec-discover ^>= 2.4.4 source-repository head type: git
src/Documentation/Haddock/Parser.hs view
@@ -143,7 +143,7 @@ -- to ensure that we have already given a chance to more meaningful parsers -- before capturing their characers. string' :: Parser (DocH mod a)-string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (`notElem` specialChar)+string' = DocString . unescape . decodeUtf8 <$> takeWhile1_ (notInClass specialChar) where unescape "" = "" unescape ('\\':x:xs) = x : unescape xs@@ -153,7 +153,7 @@ -- This is done to skip over any special characters belonging to other -- elements but which were not deemed meaningful at their positions. skipSpecialChar :: Parser (DocH mod a)-skipSpecialChar = DocString . return <$> satisfy (`elem` specialChar)+skipSpecialChar = DocString . return <$> satisfy (inClass specialChar) -- | Emphasis parser. --@@ -215,7 +215,7 @@ -- accept {small | large | digit | ' } here. But as we can't -- match on unicode characters, this is currently not possible. -- Note that we allow ‘#’ to suport anchors.- <*> (decodeUtf8 <$> takeWhile (`notElem` (" .&[{}(=*)+]!|@/;,^?\"\n"::String)))+ <*> (decodeUtf8 <$> takeWhile (notInClass " .&[{}(=*)+]!|@/;,^?\"\n")) -- | Picture parser, surrounded by \<\< and \>\>. It's possible to specify -- a title for the picture.@@ -338,7 +338,7 @@ definitionList indent = DocDefList <$> p where p = do- label <- "[" *> (parseStringBS <$> takeWhile1 (`notElem` ("]\n" :: String))) <* ("]" <* optional ":")+ label <- "[" *> (parseStringBS <$> takeWhile1 (notInClass "]\n")) <* ("]" <* optional ":") c <- takeLine (cs, items) <- more indent p let contents = parseString . dropNLs . unlines $ c : cs@@ -561,7 +561,7 @@ url = mappend <$> ("http://" <|> "https://" <|> "ftp://") <*> takeWhile1 (not . isSpace) mkLink :: BS.ByteString -> DocH mod a mkLink s = case unsnoc s of- Just (xs, x) | x `elem` (",.!?" :: String) -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x]+ Just (xs, x) | inClass ",.!?" x -> DocHyperlink (Hyperlink (decodeUtf8 xs) Nothing) `docAppend` DocString [x] _ -> DocHyperlink (Hyperlink (decodeUtf8 s) Nothing) -- | Parses strings between identifier delimiters. Consumes all input that it@@ -570,8 +570,13 @@ parseValid :: Parser String parseValid = p some where- idChar = satisfy (`elem` ("_.!#$%&*+/<=>?@\\|-~:^"::String))- <|> digit <|> letter_ascii+ idChar =+ satisfy (\c -> isAlpha_ascii c+ || isDigit c+ -- N.B. '-' is placed first otherwise attoparsec thinks+ -- it belongs to a character class+ || inClass "-_.!#$%&*+/<=>?@\\|~:^" c)+ p p' = do vs' <- p' $ utf8String "⋆" <|> return <$> idChar let vs = concat vs'@@ -594,4 +599,4 @@ e <- idDelim return $ DocIdentifier (o, vid, e) where- idDelim = char '\'' <|> char '`'+ idDelim = satisfy (\c -> c == '\'' || c == '`')
src/Documentation/Haddock/Parser/Util.hs view
@@ -22,7 +22,7 @@ import Control.Applicative import Control.Monad (mfilter)-import Documentation.Haddock.Parser.Monad+import Documentation.Haddock.Parser.Monad hiding (isHorizontalSpace) import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as BS import Prelude hiding (takeWhile)@@ -40,11 +40,14 @@ strip :: String -> String strip = (\f -> f . f) $ dropWhile isSpace . reverse +isHorizontalSpace :: Char -> Bool+isHorizontalSpace = inClass " \t\f\v\r"+ skipHorizontalSpace :: Parser ()-skipHorizontalSpace = skipWhile (`elem` " \t\f\v\r")+skipHorizontalSpace = skipWhile isHorizontalSpace takeHorizontalSpace :: Parser BS.ByteString-takeHorizontalSpace = takeWhile (`elem` " \t\f\v\r")+takeHorizontalSpace = takeWhile isHorizontalSpace makeLabeled :: (String -> Maybe String -> a) -> String -> a makeLabeled f input = case break isSpace $ removeEscapes $ strip input of
src/Documentation/Haddock/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}+{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-} -- | -- Module : Documentation.Haddock.Types@@ -14,8 +14,10 @@ -- Exposes documentation data types used for (some) of Haddock. module Documentation.Haddock.Types where +#if !MIN_VERSION_base(4,8,0) import Data.Foldable import Data.Traversable+#endif -- | With the advent of 'Version', we may want to start attaching more -- meta-data to comments. We make a structure for this ahead of time
test/Documentation/Haddock/ParserSpec.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings, FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Documentation.Haddock.ParserSpec (main, spec) where@@ -57,7 +56,7 @@ "e" `shouldParseTo` "e" it "allows to backslash-escape characters except \\r" $ do- property $ \case+ property $ \y -> case y of '\r' -> "\\\r" `shouldParseTo` DocString "\\" x -> ['\\', x] `shouldParseTo` DocString [x]
− vendor/attoparsec-0.12.1.1/Data/Attoparsec.hs
@@ -1,23 +0,0 @@--- |--- Module : Data.Attoparsec--- Copyright : Bryan O'Sullivan 2007-2014--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : unknown------ Simple, efficient combinator parsing for--- 'Data.ByteString.ByteString' strings, loosely based on the Parsec--- library.------ This module is deprecated. Use "Data.Attoparsec.ByteString"--- instead.--module Data.Attoparsec- {-# DEPRECATED "This module will be removed in the next major release." #-}- (- module Data.Attoparsec.ByteString- ) where--import Data.Attoparsec.ByteString
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString.hs
@@ -1,223 +0,0 @@--- |--- Module : Data.Attoparsec.ByteString--- Copyright : Bryan O'Sullivan 2007-2014--- 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.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 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 _ = Left "Result: incomplete input"
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Buffer.hs
@@ -1,151 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module : Data.Attoparsec.ByteString.Buffer--- Copyright : Bryan O'Sullivan 2007-2014--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : GHC------ An "immutable" buffer that supports cheap appends.------ A Buffer is divided into an immutable read-only zone, followed by a--- mutable area that we've preallocated, but not yet written to.------ We overallocate at the end of a Buffer so that we can cheaply--- append. Since a user of an existing Buffer cannot see past the end--- of its immutable zone into the data that will change during an--- append, this is safe.------ Once we run out of space at the end of a Buffer, we do the usual--- doubling of the buffer size.------ The fact of having a mutable buffer really helps with performance,--- but it does have a consequence: if someone misuses the Partial API--- that attoparsec uses by calling the same continuation repeatedly--- (which never makes sense in practice), they could overwrite data.------ Since the API *looks* pure, it should *act* pure, too, so we use--- two generation counters (one mutable, one immutable) to track the--- number of appends to a mutable buffer. If the counters ever get out--- of sync, someone is appending twice to a mutable buffer, so we--- duplicate the entire buffer in order to preserve the immutability--- of its older self.------ While we could go a step further and gain protection against API--- abuse on a multicore system, by use of an atomic increment--- instruction to bump the mutable generation counter, that would be--- very expensive, and feels like it would also be in the realm of the--- ridiculous. Clients should never call a continuation more than--- once; we lack a linear type system that could enforce this; and--- there's only so far we should go to accommodate broken uses.--module Data.Attoparsec.ByteString.Buffer- (- Buffer- , buffer- , unbuffer- , pappend- , length- , unsafeIndex- , substring- , unsafeDrop- ) where--import Control.Exception (assert)-import Data.ByteString.Internal (ByteString(..), memcpy, nullForeignPtr)-import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)-import Data.List (foldl1')-import Data.Monoid (Monoid(..))-import Data.Word (Word8)-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)-import Foreign.Ptr (castPtr, plusPtr)-import Foreign.Storable (peek, peekByteOff, poke, sizeOf)-import GHC.ForeignPtr (mallocPlainForeignPtrBytes)-import Prelude hiding (length)--data Buffer = Buf {- _fp :: {-# UNPACK #-} !(ForeignPtr Word8)- , _off :: {-# UNPACK #-} !Int- , _len :: {-# UNPACK #-} !Int- , _cap :: {-# UNPACK #-} !Int- , _gen :: {-# UNPACK #-} !Int- }--instance Show Buffer where- showsPrec p = showsPrec p . unbuffer---- | The initial 'Buffer' has no mutable zone, so we can avoid all--- copies in the (hopefully) common case of no further input being fed--- to us.-buffer :: ByteString -> Buffer-buffer (PS fp off len) = Buf fp off len len 0--unbuffer :: Buffer -> ByteString-unbuffer (Buf fp off len _ _) = PS fp off len--instance Monoid Buffer where- mempty = Buf nullForeignPtr 0 0 0 0-- mappend (Buf _ _ _ 0 _) b = b- mappend a (Buf _ _ _ 0 _) = a- mappend buf (Buf fp off len _ _) = append buf fp off len-- mconcat [] = mempty- mconcat xs = foldl1' mappend xs--pappend :: Buffer -> ByteString -> Buffer-pappend (Buf _ _ _ 0 _) (PS fp off len) = Buf fp off len 0 0-pappend buf (PS fp off len) = append buf fp off len--append :: Buffer -> ForeignPtr a -> Int -> Int -> Buffer-append (Buf fp0 off0 len0 cap0 gen0) !fp1 !off1 !len1 =- inlinePerformIO . withForeignPtr fp0 $ \ptr0 ->- withForeignPtr fp1 $ \ptr1 -> do- let genSize = sizeOf (0::Int)- newlen = len0 + len1- gen <- if gen0 == 0- then return 0- else peek (castPtr ptr0)- if gen == gen0 && newlen <= cap0- then do- let newgen = gen + 1- poke (castPtr ptr0) newgen- memcpy (ptr0 `plusPtr` (off0+len0))- (ptr1 `plusPtr` off1)- (fromIntegral len1)- return (Buf fp0 off0 newlen cap0 newgen)- else do- let newcap = newlen * 2- fp <- mallocPlainForeignPtrBytes (newcap + genSize)- withForeignPtr fp $ \ptr_ -> do- let ptr = ptr_ `plusPtr` genSize- newgen = 1- poke (castPtr ptr_) newgen- memcpy ptr (ptr0 `plusPtr` off0) (fromIntegral len0)- memcpy (ptr `plusPtr` len0) (ptr1 `plusPtr` off1)- (fromIntegral len1)- return (Buf fp genSize newlen newcap newgen)--length :: Buffer -> Int-length (Buf _ _ len _ _) = len-{-# INLINE length #-}--unsafeIndex :: Buffer -> Int -> Word8-unsafeIndex (Buf fp off len _ _) i = assert (i >= 0 && i < len) .- inlinePerformIO . withForeignPtr fp $ flip peekByteOff (off+i)-{-# INLINE unsafeIndex #-}--substring :: Int -> Int -> Buffer -> ByteString-substring s l (Buf fp off len _ _) =- assert (s >= 0 && s <= len) .- assert (l >= 0 && l <= len-s) $- PS fp (off+s) l-{-# INLINE substring #-}--unsafeDrop :: Int -> Buffer -> ByteString-unsafeDrop s (Buf fp off len _ _) =- assert (s >= 0 && s <= len) $- PS fp (off+s) (len-s)-{-# INLINE unsafeDrop #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Char8.hs
@@ -1,469 +0,0 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, TypeFamilies,- TypeSynonymInstances, GADTs #-}-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-warnings-deprecations #-}---- |--- Module : Data.Attoparsec.ByteString.Char8--- Copyright : Bryan O'Sullivan 2007-2014--- 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- , 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- , Number(..)-- -- * 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 Control.Applicative ((*>), (<*), (<$>), (<|>))-import Data.Attoparsec.ByteString.FastSet (charClass, memberChar)-import Data.Attoparsec.ByteString.Internal (Parser)-import Data.Attoparsec.Combinator-import Data.Attoparsec.Number (Number(..))-import Data.Bits (Bits, (.|.), shiftL)-import Data.ByteString.Internal (c2w, w2c)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.String (IsString(..))-import Data.Word-import 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, 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) || (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------ 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 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
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/FastSet.hs
@@ -1,115 +0,0 @@-{-# LANGUAGE BangPatterns, MagicHash #-}---------------------------------------------------------------------------------- |--- Module : Data.Attoparsec.ByteString.FastSet--- Copyright : Bryan O'Sullivan 2007-2014--- 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 _ = ""
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/ByteString/Internal.hs
@@ -1,485 +0,0 @@-{-# LANGUAGE BangPatterns, GADTs, OverloadedStrings, RecordWildCards #-}--- |--- Module : Data.Attoparsec.ByteString.Internal--- Copyright : Bryan O'Sullivan 2007-2014--- 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- , stringTransform- , take- , scan- , runScanner- , takeWhile- , takeWhile1- , takeTill-- -- ** Consume all remaining input- , takeByteString- , takeLazyByteString-- -- * Utilities- , endOfLine- , endOfInput- , match- , atEnd- ) where--import Control.Applicative ((<|>), (<$>))-import Control.Monad (when)-import Data.Attoparsec.ByteString.Buffer (Buffer, buffer)-import Data.Attoparsec.ByteString.FastSet (charClass, memberWord8)-import Data.Attoparsec.Combinator ((<?>))-import Data.Attoparsec.Internal-import Data.Attoparsec.Internal.Fhthagn (inlinePerformIO)-import Data.Attoparsec.Internal.Types hiding (Parser, Failure, Success)-import Data.ByteString (ByteString)-import Data.Word (Word8)-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (castPtr, minusPtr, plusPtr)-import Foreign.Storable (Storable(peek, sizeOf))-import Prelude hiding (getChar, 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 . 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 -> (ByteString -> Bool) -> Parser ByteString-takeWith n0 p = do- let n = max n0 0- s <- ensure n- if p s- then advance n >> return s- else fail "takeWith"---- | Consume exactly @n@ bytes of input.-take :: Int -> Parser ByteString-take n = takeWith n (const True)-{-# 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 = takeWith (B.length s) (==s)-{-# INLINE string #-}--stringTransform :: (ByteString -> ByteString) -> ByteString- -> Parser 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.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 = (B.concat . reverse) `fmap` go []- where- go acc = do- s <- B8.takeWhile p <$> get- continue <- inputSpansChunks (B.length s)- if continue- then go (s:acc)- else return (s:acc)-{-# INLINE takeWhile #-}--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 ->- case chunks of- [x] -> return x- xs -> return $! B.concat $ reverse xs-{-# INLINE scan #-}---- | Like 'scan', but generalized to return the final state of the--- scanner.-runScanner :: s -> (s -> Word8 -> Maybe s) -> Parser (ByteString, s)-runScanner = scan_ $ \s xs -> return (B.concat (reverse xs), s)-{-# INLINE runScanner #-}---- | Consume input as long as the predicate returns 'True', and return--- the consumed input.------ This parser requires the predicate to succeed on at least one byte--- of input: it will fail if the predicate never returns 'True' or if--- there is no input left.-takeWhile1 :: (Word8 -> Bool) -> Parser 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 (s<>) `fmap` takeWhile p- else return s---- | 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- 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--- Non-recursive so the bounds check can be inlined:-{-# INLINE ensure #-}---- | Return both the result of a parse and the portion of the input--- that was consumed while it was being parsed.-match :: Parser a -> Parser (ByteString, a)-match p = T.Parser $ \t pos more lose succ ->- let succ' t' pos' more' a =- succ t' pos' more' (substring pos (pos'-pos) t', a)- in runParser p t pos more lose succ'--lengthAtLeast :: Pos -> Int -> Buffer -> Bool-lengthAtLeast (Pos pos) n bs = Buf.length bs >= pos + n-{-# INLINE lengthAtLeast #-}--substring :: Pos -> Pos -> Buffer -> ByteString-substring (Pos pos) (Pos n) = Buf.substring pos n-{-# INLINE substring #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/Combinator.hs
@@ -1,220 +0,0 @@-{-# LANGUAGE BangPatterns #-}--- |--- Module : Data.Attoparsec.Combinator--- Copyright : Daan Leijen 1999-2001, Bryan O'Sullivan 2007-2014--- 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- ) where--import Control.Applicative (Alternative(..), Applicative(..), empty, liftA2,- many, (<|>), (*>), (<$>))-import Control.Monad (MonadPlus(..))-import Data.Attoparsec.Internal.Types (Parser(..), IResult(..))-import Data.Attoparsec.Internal (endOfInput, atEnd, satisfyElem)-import Data.ByteString (ByteString)-import Data.Monoid (Monoid(mappend))-import Prelude hiding (succ)---- | Attempt a parse, and if it fails, rewind the input so that no--- 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` (symbol ",")-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'` (symbol ",")-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` (symbol ",")-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'` (symbol ",")-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 f@(Fail _ _ _) _ = f-feed (Partial k) d = k d-feed (Done t r) d = Done (mappend t d) r-{-# INLINE feed #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal.hs
@@ -1,142 +0,0 @@-{-# LANGUAGE CPP, BangPatterns, ScopedTypeVariables #-}--- |--- Module : Data.Attoparsec.Internal--- Copyright : Bryan O'Sullivan 2007-2014--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : unknown------ Simple, efficient parser combinators, loosely based on the Parsec--- library.--module Data.Attoparsec.Internal- ( compareResults- , prompt- , demandInput- , wantInput- , endOfInput- , atEnd- , satisfyElem- ) where--import Control.Applicative ((<$>))-#if __GLASGOW_HASKELL__ >= 700-import Data.ByteString (ByteString)-#endif-import Data.Attoparsec.Internal.Types-import Prelude hiding (succ)---- | Compare two 'IResult' values for equality.------ If both 'IResult's are 'Partial', the result will be 'Nothing', as--- they are incomplete and hence their equality cannot be known.--- (This is why there is no 'Eq' instance for 'IResult'.)-compareResults :: (Eq i, Eq r) => IResult i r -> IResult i r -> Maybe Bool-compareResults (Fail t0 ctxs0 msg0) (Fail t1 ctxs1 msg1) =- Just (t0 == t1 && ctxs0 == ctxs1 && msg0 == msg1)-compareResults (Done t0 r0) (Done t1 r1) =- Just (t0 == t1 && r0 == r1)-compareResults (Partial _) (Partial _) = Nothing-compareResults _ _ = Just False---- | Ask for input. If we receive any, pass it to a success--- continuation, otherwise to a failure continuation.-prompt :: Chunk t- => State t -> Pos -> More- -> (State t -> Pos -> More -> IResult t r)- -> (State t -> Pos -> More -> IResult t r)- -> IResult t r-prompt t pos _more lose succ = Partial $ \s ->- if nullChunk s- then lose t pos Complete- else succ (pappendChunk t s) pos Incomplete-#if __GLASGOW_HASKELL__ >= 700-{-# SPECIALIZE prompt :: State ByteString -> Pos -> More- -> (State ByteString -> Pos -> More- -> IResult ByteString r)- -> (State ByteString -> Pos -> More- -> IResult ByteString r)- -> IResult ByteString r #-}-#endif---- | Immediately demand more input via a 'Partial' continuation--- result.-demandInput :: Chunk t => Parser t ()-demandInput = Parser $ \t pos more lose succ ->- case more of- Complete -> lose t pos more [] "not enough input"- _ -> let lose' t' pos' more' = lose t' pos' more' [] "not enough input"- succ' t' pos' more' = succ t' pos' more' ()- in prompt t pos more lose' succ'-#if __GLASGOW_HASKELL__ >= 700-{-# SPECIALIZE demandInput :: Parser ByteString () #-}-#endif---- | This parser always succeeds. It returns 'True' if any input is--- available either immediately or on demand, and 'False' if the end--- of all input has been reached.-wantInput :: forall t . Chunk t => Parser t Bool-wantInput = Parser $ \t pos more _lose succ ->- case () of- _ | pos < atBufferEnd (undefined :: t) t -> succ t pos more True- | more == Complete -> succ t pos more False- | otherwise -> let lose' t' pos' more' = succ t' pos' more' False- succ' t' pos' more' = succ t' pos' more' True- in prompt t pos more lose' succ'-{-# INLINE wantInput #-}---- | Match only if all input has been consumed.-endOfInput :: forall t . Chunk t => Parser t ()-endOfInput = Parser $ \t pos more lose succ ->- case () of- _| pos < atBufferEnd (undefined :: t) t -> lose t pos more [] "endOfInput"- | more == Complete -> succ t pos more ()- | otherwise ->- let lose' t' pos' more' _ctx _msg = succ t' pos' more' ()- succ' t' pos' more' _a = lose t' pos' more' [] "endOfInput"- in runParser demandInput t pos more lose' succ'-#if __GLASGOW_HASKELL__ >= 700-{-# SPECIALIZE endOfInput :: Parser ByteString () #-}-#endif---- | Return an indication of whether the end of input has been--- reached.-atEnd :: Chunk t => Parser t Bool-atEnd = not <$> wantInput-{-# INLINE atEnd #-}--satisfySuspended :: forall t r . Chunk t- => (ChunkElem t -> Bool)- -> State t -> Pos -> More- -> Failure t (State t) r- -> Success t (State t) (ChunkElem t) r- -> IResult t r-satisfySuspended p t pos more lose succ =- runParser (demandInput >> go) t pos more lose succ- where go = Parser $ \t' pos' more' lose' succ' ->- case bufferElemAt (undefined :: t) pos' t' of- Just (e, l) | p e -> succ' t' (pos' + Pos l) more' e- | otherwise -> lose' t' pos' more' [] "satisfyElem"- Nothing -> runParser (demandInput >> go) t' pos' more' lose' succ'-#if __GLASGOW_HASKELL__ >= 700-{-# SPECIALIZE satisfySuspended :: (ChunkElem ByteString -> Bool)- -> State ByteString -> Pos -> More- -> Failure ByteString (State ByteString) r- -> Success ByteString (State ByteString)- (ChunkElem ByteString) r- -> IResult ByteString r #-}-#endif---- | The parser @satisfyElem p@ succeeds for any chunk element for which the--- predicate @p@ returns 'True'. Returns the element that is--- actually parsed.-satisfyElem :: forall t . Chunk t- => (ChunkElem t -> Bool) -> Parser t (ChunkElem t)-satisfyElem p = Parser $ \t pos more lose succ ->- case bufferElemAt (undefined :: t) pos t of- Just (e, l) | p e -> succ t (pos + Pos l) more e- | otherwise -> lose t pos more [] "satisfyElem"- Nothing -> satisfySuspended p t pos more lose succ-{-# INLINE satisfyElem #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Fhthagn.hs
@@ -1,18 +0,0 @@-{-# 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 #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/Internal/Types.hs
@@ -1,230 +0,0 @@-{-# LANGUAGE BangPatterns, GeneralizedNewtypeDeriving, OverloadedStrings,- Rank2Types, RecordWildCards, TypeFamilies #-}--- |--- Module : Data.Attoparsec.Internal.Types--- Copyright : Bryan O'Sullivan 2007-2014--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : unknown------ Simple, efficient parser combinators, loosely based on the Parsec--- library.--module Data.Attoparsec.Internal.Types- (- Parser(..)- , State- , Failure- , Success- , Pos(..)- , IResult(..)- , More(..)- , (<>)- , Chunk(..)- ) where--import Control.Applicative (Alternative(..), Applicative(..), (<$>))-import Control.DeepSeq (NFData(rnf))-import Control.Monad (MonadPlus(..))-import Data.Word (Word8)-import Data.ByteString (ByteString)-import qualified Data.ByteString as BS-import Data.ByteString.Internal (w2c)-import Data.Monoid (Monoid(..))-import Prelude hiding (getChar, succ)-import qualified Data.Attoparsec.ByteString.Buffer as B--newtype Pos = Pos { fromPos :: Int }- deriving (Eq, Ord, Show, Num)---- | The result of a parse. This is parameterised over the type @i@--- of string that was processed.------ This type is an instance of 'Functor', where 'fmap' transforms the--- value in a 'Done' result.-data IResult i r =- Fail i [String] String- -- ^ The parse failed. The @i@ parameter is the input that had- -- not yet been consumed when the failure occurred. The- -- @[@'String'@]@ is a list of contexts in which the error- -- occurred. The 'String' is the message describing the error, if- -- any.- | Partial (i -> IResult i r)- -- ^ Supply this continuation with more input so that the parser- -- can resume. To indicate that no more input is available, pass- -- an empty string to the continuation.- --- -- __Note__: if you get a 'Partial' result, do not call its- -- continuation more than once.- | Done i r- -- ^ The parse succeeded. The @i@ parameter is the input that had- -- not yet been consumed (if any) when the parse succeeded.--instance (Show i, Show r) => Show (IResult i r) where- show (Fail t stk msg) =- unwords [ "Fail", show t, show stk, show msg]- show (Partial _) = "Partial _"- show (Done t r) = unwords ["Done", show t, show r]--instance (NFData i, NFData r) => NFData (IResult i r) where- rnf (Fail t stk msg) = rnf t `seq` rnf stk `seq` rnf msg- rnf (Partial _) = ()- rnf (Done t r) = rnf t `seq` rnf r- {-# INLINE rnf #-}--instance Functor (IResult i) where- fmap _ (Fail t stk msg) = Fail t stk msg- fmap f (Partial k) = Partial (fmap f . k)- fmap f (Done t r) = Done t (f r)---- | The core parser type. This is parameterised over the types @i@--- of string being processed and @t@ of internal state representation.------ This type is an instance of the following classes:------ * 'Monad', where 'fail' throws an exception (i.e. fails) with an--- error message.------ * 'Functor' and 'Applicative', which follow the usual definitions.------ * 'MonadPlus', where 'mzero' fails (with no error message) and--- 'mplus' executes the right-hand parser if the left-hand one--- fails. When the parser on the right executes, the input is reset--- to the same state as the parser on the left started with. (In--- other words, attoparsec is a backtracking parser that supports--- arbitrary lookahead.)------ * 'Alternative', which follows 'MonadPlus'.-newtype Parser i a = Parser {- runParser :: forall r.- State i -> Pos -> More- -> Failure i (State i) r- -> Success i (State i) a r- -> IResult i r- }--type family State i-type instance State ByteString = B.Buffer--type Failure i t r = t -> Pos -> More -> [String] -> String- -> IResult i r-type Success i t a r = t -> Pos -> More -> a -> IResult i r---- | Have we read all available input?-data More = Complete | Incomplete- deriving (Eq, Show)--instance Monoid More where- mappend c@Complete _ = c- mappend _ m = m- mempty = Incomplete--instance Monad (Parser i) where- fail err = Parser $ \t pos more lose _succ -> lose t pos more [] msg- where msg = "Failed reading: " ++ err- {-# INLINE fail #-}-- return = 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 (>>=) #-}--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 (<*>) #-}-- -- These definitions are equal to the defaults, but this- -- way the optimizer doesn't have to work so hard to figure- -- that out.- m *> k = m >>= \_ -> k- {-# INLINE (*>) #-}- x <* y = x >>= \a -> y >> return a- {-# INLINE (<*) #-}--instance Monoid (Parser i a) where- mempty = fail "mempty"- {-# INLINE mempty #-}- mappend = plus- {-# INLINE mappend #-}--instance Alternative (Parser i) where- empty = fail "empty"- {-# INLINE empty #-}-- (<|>) = plus- {-# INLINE (<|>) #-}-- many v = many_v- where many_v = some_v <|> pure []- some_v = (:) <$> v <*> many_v- {-# INLINE many #-}-- some v = some_v- where- many_v = some_v <|> pure []- some_v = (:) <$> v <*> many_v- {-# INLINE some #-}--(<>) :: (Monoid m) => m -> m -> m-(<>) = mappend-{-# INLINE (<>) #-}---- | A common interface for input chunks.-class Monoid c => Chunk c where- type ChunkElem c- -- | Test if the chunk is empty.- nullChunk :: c -> Bool- -- | Append chunk to a buffer.- pappendChunk :: State c -> c -> State c- -- | Position at the end of a buffer. The first argument is ignored.- atBufferEnd :: c -> State c -> Pos- -- | Return the buffer element at the given position along with its length.- bufferElemAt :: c -> Pos -> State c -> Maybe (ChunkElem c, Int)- -- | Map an element to the corresponding character.- -- The first argument is ignored.- chunkElemToChar :: c -> ChunkElem c -> Char--instance Chunk ByteString where- type ChunkElem ByteString = Word8- nullChunk = BS.null- {-# INLINE nullChunk #-}- pappendChunk = B.pappend- {-# INLINE pappendChunk #-}- atBufferEnd _ = Pos . B.length- {-# INLINE atBufferEnd #-}- bufferElemAt _ (Pos i) buf- | i < B.length buf = Just (B.unsafeIndex buf i, 1)- | otherwise = Nothing- {-# INLINE bufferElemAt #-}- chunkElemToChar _ = w2c- {-# INLINE chunkElemToChar #-}
− vendor/attoparsec-0.12.1.1/Data/Attoparsec/Number.hs
@@ -1,137 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--- |--- Module : Data.Attoparsec.Number--- Copyright : Bryan O'Sullivan 2007-2014--- License : BSD3------ Maintainer : bos@serpentine.com--- Stability : experimental--- Portability : unknown------ This module is deprecated, and both the module and 'Number' type--- will be removed in the next major release. Use the--- <http://hackage.haskell.org/package/scientific scientific> package--- and the 'Data.Scientific.Scientific' type instead.------ A simple number type, useful for parsing both exact and inexact--- quantities without losing much precision.-module Data.Attoparsec.Number- {-# DEPRECATED "This module will be removed in the next major release." #-}- (- Number(..)- ) where--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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec.hs view
@@ -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
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString.hs view
@@ -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"
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Buffer.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Char8.hs view
@@ -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+
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/FastSet.hs view
@@ -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 _ = ""
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/ByteString/Internal.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/Combinator.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Fhthagn.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/Internal/Types.hs view
@@ -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 #-}
+ vendor/attoparsec-0.13.1.0/Data/Attoparsec/Number.hs view
@@ -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 #-}