packages feed

attoparsec 0.6 → 0.7.1

raw patch · 16 files changed

+1276/−748 lines, 16 filesdep ~basesetup-changed

Dependency ranges changed: base

Files

+ Data/Attoparsec.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec+-- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient parser combinators for lazy 'ByteString'+-- strings, loosely based on 'Text.ParserCombinators.Parsec'.+-- +-----------------------------------------------------------------------------+module Data.Attoparsec+    (+    -- * Parser types+      ParseError+    , Parser++    -- * Running parsers+    , parse+    , parseAt+    , parseTest++    -- * Combinators+    , (<?>)+    , try+    , module Data.Attoparsec.Combinator++    -- * Parsing individual bytes+    , anyWord8+    , notWord8+    , word8+    , satisfy++    -- * Efficient string handling+    , string+    , skipWhile+    , stringTransform+    , takeAll+    , takeTill+    , takeWhile+    , takeWhile1++    -- ** Combinators+    , match+    , notEmpty++    -- * State observation functions+    , endOfInput+    , getConsumed+    , getInput+    , lookAhead+    ) where++import Data.Attoparsec.Combinator+import Data.Attoparsec.Internal+import Prelude hiding (takeWhile)
+ Data/Attoparsec/Char8.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.Char8+-- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2009+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient, character-oriented parser combinators for lazy+-- 'LB.ByteString' strings, loosely based on the Parsec library.+-- +-- /Note/: 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/ deal with character encodings,+-- multibyte characters, or wide characters.  Any attempts to use+-- characters above code point 255 will give wrong answers.+-----------------------------------------------------------------------------+module Data.Attoparsec.Char8+    (+    -- * Parser types+      ParseError+    , Parser++    -- * Running parsers+    , parse+    , parseAt+    , parseTest++    -- * Combinators+    , (<?>)+    , try++    -- * Parsing individual characters+    , anyChar+    , char+    , digit+    , letter+    , notChar+    , space+    , satisfy++    -- ** Character classes+    , inClass+    , notInClass++    -- * Efficient string handling+    , string+    , stringCI+    , skipSpace+    , skipWhile+    , takeAll+    , takeCount+    , takeTill+    , takeWhile+    , takeWhile1++    -- ** Combinators+    , match+    , notEmpty++    -- * Text parsing+    , endOfLine++    -- * Numeric parsers+    , int+    , integer+    , double++    -- * State observation functions+    , endOfInput+    , getConsumed+    , getInput+    , lookAhead++    -- * Combinators+    , module Data.Attoparsec.Combinator+    ) where++import qualified Data.ByteString.Char8 as SB+import qualified Data.ByteString.Lazy.Char8 as LB+import Data.ByteString.Internal (w2c)+import Data.Char (isDigit, isLetter, isSpace, toLower)+import Data.Attoparsec.FastSet+    (FastSet, charClass, memberChar, set)+import qualified Data.Attoparsec.Internal as I+import Data.Attoparsec.Combinator+import Data.Attoparsec.Internal+    (Parser, ParseError, (<?>), parse, parseAt, parseTest, try, endOfInput,+     lookAhead, string,+     getInput, getConsumed, takeAll, takeCount, notEmpty, match,+     endOfLine, setInput)+import Data.ByteString.Lex.Lazy.Double (readDouble)+import Prelude hiding (takeWhile)++-- | Satisfy a literal string, ignoring case.+stringCI :: LB.ByteString -> Parser LB.ByteString+stringCI = I.stringTransform (LB.map toLower)+{-# INLINE stringCI #-}++takeWhile1 :: (Char -> Bool) -> Parser LB.ByteString+takeWhile1 p = I.takeWhile1 (p . w2c)+{-# INLINE takeWhile1 #-}++numeric :: String -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser a+numeric desc f = do+  s <- getInput+  case f s of+    Nothing -> fail desc+    Just (i,s') -> setInput s' >> return i+                   +-- | Parse an integer.  The position counter is not updated.+int :: Parser Int+int = numeric "Int" LB.readInt++-- | Parse an integer.  The position counter is not updated.+integer :: Parser Integer+integer = numeric "Integer" LB.readInteger++-- | Parse a Double.  The position counter is not updated.+double :: Parser Double+double = numeric "Double" readDouble++#define PARSER Parser+#include "Char8Boilerplate.h"
+ Data/Attoparsec/Char8Boilerplate.h view
@@ -0,0 +1,72 @@+-- -*- haskell -*-++-- | Character parser.+satisfy :: (Char -> Bool) -> PARSER Char+satisfy p = w2c <$> I.satisfy (p . w2c)+{-# INLINE satisfy #-}++letter :: PARSER Char+letter = satisfy isLetter <?> "letter"+{-# INLINE letter #-}++digit :: PARSER Char+digit = satisfy isDigit <?> "digit"+{-# INLINE digit #-}++anyChar :: PARSER Char+anyChar = satisfy $ const True+{-# INLINE anyChar #-}++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 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 characters while the predicate succeeds.+takeWhile :: (Char -> Bool) -> PARSER LB.ByteString+takeWhile p = I.takeWhile (p . w2c)+{-# INLINE takeWhile #-}++-- | Consume characters while the predicate fails.+takeTill :: (Char -> Bool) -> PARSER LB.ByteString+takeTill p = I.takeTill (p . w2c)+{-# INLINE takeTill #-}++-- | Skip over characters while the predicate succeeds.+skipWhile :: (Char -> Bool) -> PARSER ()+skipWhile p = I.skipWhile (p . w2c)+{-# INLINE skipWhile #-}++-- | Skip over white space.+skipSpace :: PARSER ()+skipSpace = takeWhile isSpace >> return ()+{-# INLINE skipSpace #-}
+ Data/Attoparsec/Combinator.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE BangPatterns, CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.Combinator+-- Copyright   :  Daan Leijen 1999-2001, Bryan O'Sullivan 2009+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Useful parser combinators, similar to those provided by Parsec.+-- +-----------------------------------------------------------------------------+module Data.Attoparsec.Combinator+    (+      choice+    , count+    , option+    , many1+    , manyTill+    , sepBy+    , sepBy1+    , skipMany+    , skipMany1+    , eitherP+    , module Control.Applicative+    ) where++import Control.Applicative++-- | @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++-- | @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++-- | @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)++-- | @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 []++-- | @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 `sepBy` (symbol ",")+sepBy1 :: Alternative f => f a -> f s -> f [a]+sepBy1 p s = scan+    where scan = liftA2 (:) p ((s *> scan) <|> pure [])++-- | @manyTill p end@ applies action @p@ /zero/ or more times until+-- action @end@ succeeds, and returns the list of values returned by+-- @p@.  This can be used to scan comments:+--+-- >  simpleComment   = string "<!--" *> manyTill anyChar (try (string "-->"))+--+-- Note the overlapping parsers @anyChar@ and @string \"<!--\"@, and+-- therefore the use of the 'try' combinator.+manyTill :: Alternative f => f a -> f b -> f [a]+manyTill p end = scan+    where scan = (end *> pure []) <|> liftA2 (:) p scan++-- | Skip zero or more instances of an action.+skipMany :: Alternative f => f a -> f ()+skipMany p = scan+    where scan = (p *> scan) <|> pure ()++-- | Skip one or more instances of an action.+skipMany1 :: Alternative f => f a -> f ()+skipMany1 p = p *> skipMany p++-- | 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 #-}
+ Data/Attoparsec/FastSet.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE BangPatterns #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.FastSet+-- Copyright   :  Bryan O'Sullivan 2008+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Fast set membership tests for 'Word8' and 8-bit 'Char' values.  The+-- set representation is unboxed for efficiency.  For sets of fewer+-- than 32 elements, we test for membership using a binary search.+-- For larger sets, we use a lookup table.+-- +-----------------------------------------------------------------------------+module Data.Attoparsec.FastSet+    (+    -- * Data type+      FastSet+    -- * Construction+    , fromList+    , set+    -- * Lookup+    , memberChar+    , memberWord8+    -- * Debugging+    , fromSet+    -- * Handy interface+    , charClass+    ) where++import Data.Bits ((.&.), (.|.), shiftL, shiftR)+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Unsafe as U+import Data.Word (Word8)+import Foreign.Storable (peekByteOff, pokeByteOff)++data FastSet = Sorted { fromSet :: {-# UNPACK #-} !B.ByteString }+             | Table  { fromSet :: {-# UNPACK #-} !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++index :: Int -> (Int, Word8)+index i = (i `shiftR` 3, 1 `shiftL` (i .&. 7))++-- | Check the set for membership.+memberWord8 :: Word8 -> FastSet -> Bool+memberWord8 w (Table t)  =+    let (byte,bit) = index (fromIntegral w)+    in U.unsafeIndex t byte .&. bit /= 0+memberWord8 w (Sorted s) = search 0 (B.length s - 1)+    where search lo hi+              | hi < lo = False+              | otherwise =+                  let mid = (lo + hi) `div` 2+                  in case compare w (U.unsafeIndex s mid) of+                       GT -> search (mid + 1) hi+                       LT -> search lo (mid - 1)+                       _ -> True++-- | Check the set for membership.  Only works with 8-bit characters:+-- characters above code point 255 will give wrong answers.+memberChar :: Char -> FastSet -> Bool+memberChar c = memberWord8 (I.c2w c)++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 (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 _ = ""
+ Data/Attoparsec/Incremental.hs view
@@ -0,0 +1,313 @@+{-# LANGUAGE BangPatterns, CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.Incremental+-- Copyright   :  Bryan O'Sullivan 2009+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient, and incremental parser combinators for lazy+-- 'L.ByteString' strings, loosely based on the Parsec library.+--+-- This module is heavily influenced by Adam Langley's incremental+-- parser in his @binary-strict@ package.+-- +-----------------------------------------------------------------------------+module Data.Attoparsec.Incremental+    (+    -- * Parser types+      Parser+    , Result(..)++    -- * Running parsers+    , parse+    , parseWith+    , parseTest++    -- * Combinators+    , (<?>)+    , try++    -- * Parsing individual bytes+    , word8+    , notWord8+    , anyWord8+    , satisfy++    -- * Efficient string handling+    , string+    , skipWhile+    , takeCount+    , takeTill+    , takeWhile++    -- * State observation and manipulation functions+    , endOfInput+    , pushBack+    , yield++    -- * Combinators+    , module Data.Attoparsec.Combinator+    ) where++import Data.Attoparsec.Combinator+import Control.Monad (MonadPlus(..), ap)+import Data.Attoparsec.Internal ((+:))+import Data.Word (Word8)+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Internal as L+import Prelude hiding (takeWhile)++data S = S {-# UNPACK #-} !S.ByteString -- first chunk of input+           L.ByteString                 -- rest of input+           [L.ByteString]               -- input acquired during backtracks+           !Bool                        -- have we hit EOF yet?+           {-# UNPACK #-} !Int          -- failure depth++-- | The result of a partial parse.+data Result a = Failed String+                -- ^ The parse failed, with the given error message.+              | Done L.ByteString a+                -- ^ The parse succeeded, producing the given+                -- result. The 'L.ByteString' contains any unconsumed+                -- input.+              | Partial (L.ByteString -> Result a)+                -- ^ The parse ran out of data before finishing. To+                -- resume the parse, pass more data to the given+                -- continuation.++instance (Show a) => Show (Result a) where+  show (Failed err)      = "Failed " ++ show err+  show (Done L.Empty rs) = "Done Empty " ++ show rs+  show (Done rest rs)    = "Done (" ++ show rest ++ ") " ++ show rs+  show (Partial _)       = "Partial"++-- | This is the internal version of the above. This is the type which+-- is actually used by the code, as it has the extra information+-- needed for backtracking. This is converted to a friendly 'Result'+-- type just before giving it to the outside world.+data IResult a = IFailed S String+               | IDone S a+               | IPartial (L.ByteString -> IResult a)++instance Show (IResult a) where+  show (IFailed _ err) = "IFailed " ++ show err+  show (IDone _ _)     = "IDone"+  show (IPartial _)    = "IPartial"++-- | The parser type.+newtype Parser r a = Parser {+      unParser :: S -> (a -> S -> IResult r) -> IResult r+    }++instance Monad (Parser r) where+  return a = Parser $ \s k -> k a s+  m >>= k = Parser $ \s cont -> unParser m s $ \a s' -> unParser (k a) s' cont+  fail err = Parser $ \s -> const $ IFailed s err++zero :: Parser r a+zero = fail ""++-- | I'm not sure if this is a huge bodge or not. It probably is.+--+-- When performing a choice (in @plus@), the failure depth in the+-- current state is incremented. If a failure is generated inside the+-- attempted path, the state carried in the IFailure will have this+-- incremented failure depth. However, we don't want to backtrack+-- after the attempted path has completed. Thus we insert this cut+-- continuation, which decrements the failure count of any failure+-- passing though, thus it would be caught in @plus@ and doesn't+-- trigger a backtrack.+cutContinuation :: (a -> S -> IResult r) -> a -> S -> IResult r+cutContinuation k v s =+  case k v s of+       IFailed (S lb i adds eof failDepth) err -> IFailed (S lb i adds eof (failDepth - 1)) err+       x -> x++appL :: L.ByteString -> L.ByteString -> L.ByteString+appL xs L.Empty = xs+appL L.Empty ys = ys+appL xs ys      = xs `L.append` ys++plus :: Parser r a -> Parser r a -> Parser r a+plus p1 p2 =+  Parser $ \(S sb lb adds eof failDepth) k ->+    let+      filt f@(IFailed (S _ _ adds' eof' failDepth') _)+        | failDepth' == failDepth + 1 =+            let lb' = lb `appL` L.concat (reverse adds')+            in  unParser p2 (S sb lb' (adds' ++ adds) eof' failDepth) k+        | otherwise = f+      filt (IPartial cont) = IPartial (filt . cont)+      filt v@(IDone _ _) = v+    in+      filt $ unParser p1 (S sb lb [] eof (failDepth + 1)) (cutContinuation k)++-- | This is a no-op combinator for compatibility.+try :: Parser r a -> Parser r a+try p = p++instance Functor (Parser r) where+    fmap f m = Parser $ \s cont -> unParser m s (cont . f)++infix 0 <?>++-- | Name the parser, in case failure occurs.+(<?>) :: Parser r a+      -> String                 -- ^ the name to use if parsing fails+      -> Parser r a+{-# INLINE (<?>) #-}+p <?> msg =+  Parser $ \st k ->+    case unParser p st k of+      IFailed st' _ -> IFailed st' msg+      ok -> ok++initState :: L.ByteString -> S+initState (L.Chunk sb lb) = S sb lb [] False 0+initState _               = S S.empty L.empty [] False 0++mkState :: L.ByteString -> [L.ByteString] -> Bool -> Int -> S+mkState bs adds eof failDepth =+    case bs of+      L.Empty -> S S.empty L.empty adds eof failDepth+      L.Chunk sb lb -> S sb lb adds eof failDepth++addX :: L.ByteString -> [L.ByteString] -> [L.ByteString]+addX s adds | L.null s = adds+            | otherwise = s : adds++-- | Resume our caller, handing back a 'Partial' result. This function+-- is probably not useful, but provided for completeness.+yield :: Parser r ()+yield = Parser $ \(S sb lb adds eof failDepth) k ->+  IPartial $ \s -> k () (S sb (lb `appL` s) (addX s adds) eof failDepth)++continue :: (S -> IResult r) -> Parser r a+         -> (a -> S -> IResult r) -> S -> IResult r+continue onEOF p k (S _sb _lb adds eof failDepth) =+    if eof+    then onEOF (S S.empty L.empty adds True failDepth)+    else IPartial $ \s -> let st = contState s adds failDepth+                          in unParser p st k++takeWith :: (L.ByteString -> (L.ByteString, L.ByteString))+         -> Parser r L.ByteString+takeWith splitf =+  Parser $ \st@(S sb lb adds eof failDepth) k ->+  let (left,rest) = splitf (sb +: lb)+  in if L.null rest+     then continue (k left) (takeWith splitf) (k . appL left) st+     else k left (mkState rest adds eof failDepth)+    +-- | Consume bytes while the predicate succeeds.+takeWhile :: (Word8 -> Bool) -> Parser r L.ByteString+takeWhile = takeWith . L.span++-- | Consume bytes while the predicate fails.  If the predicate never+-- succeeds, the entire input string is returned.+takeTill :: (Word8 -> Bool) -> Parser r L.ByteString+takeTill = takeWith . L.break++-- | Return exactly the given number of bytes.  If not enough are+-- available, fail.+takeCount :: Int -> Parser r L.ByteString+takeCount = tc . fromIntegral where+ tc n = Parser $ \st@(S sb lb adds eof failDepth) k ->+        let (h,t) = L.splitAt n (sb +: lb)+            l = L.length h+        in if L.length h == n+           then k h (mkState t adds eof failDepth)+           else continue (`IFailed` "takeCount: EOF")+                         (tc (n - l)) (k . appL h) st++-- | Match a literal string exactly.+string :: L.ByteString -> Parser r L.ByteString+string s =+  Parser $ \st@(S sb lb adds eof failDepth) k ->+    case L.splitAt (L.length s) (sb +: lb) of+      (h,t)+        | h == s -> k s (mkState t adds eof failDepth)+      (h,L.Empty)+        | h `L.isPrefixOf` s ->+            continue (`IFailed` "string: EOF")+                     (string (L.drop (L.length h) s))+                     (k . appL h)+                     st+      _ -> IFailed st "string failed to match"++contState :: L.ByteString -> [L.ByteString] -> Int -> S+contState s adds failDepth+    | L.null s  = S S.empty L.empty [] True failDepth+    | otherwise = mkState s (addX s adds) False failDepth++-- | Match a single byte based on the given predicate.+satisfy :: (Word8 -> Bool) -> Parser r Word8+satisfy p =+  Parser $ \st@(S sb lb adds eof failDepth) k ->+    case S.uncons sb of+      Just (w, sb') | p w -> k w (S sb' lb adds eof failDepth)+                    | otherwise -> IFailed st "failed to match"+      Nothing -> case L.uncons lb of+                   Just (w, lb') | p w -> k w (mkState lb' adds eof failDepth)+                                 | otherwise -> IFailed st "failed to match"+                   Nothing -> continue (`IFailed` "satisfy: EOF")+                                       (satisfy p) k st++-- | Force the given string to appear next in the input stream.+pushBack :: L.ByteString -> Parser r ()+pushBack bs =+    Parser $ \(S sb lb adds eof failDepth) k ->+        k () (mkState (bs `appL` (sb +: lb)) adds eof failDepth)++-- | Succeed if we have reached the end of the input string.+endOfInput :: Parser r ()+endOfInput = Parser $ \st@(S sb lb _adds _eof _failDepth) k ->+             if not (S.null sb) || not (L.null lb)+             then IFailed st "endOfInput: not EOF"+             else continue (k ()) endOfInput k st++toplevelTranslate :: IResult a -> Result a+toplevelTranslate (IFailed _ err) = Failed err+toplevelTranslate (IDone (S sb lb _ _ _) value) = Done (sb +: lb) value+toplevelTranslate (IPartial k) = Partial $ toplevelTranslate . k++terminalContinuation :: a -> S -> IResult a+terminalContinuation v s = IDone s v++-- | Run a parser.+parse :: Parser r r -> L.ByteString -> Result r+parse m input =+  toplevelTranslate $ unParser m (initState input) terminalContinuation++-- | Run a parser, using the given function to resupply it with input.+--+-- Here's an example that shows how to parse data from a socket, using+-- Johan Tibbell's @network-bytestring@ package.+--+-- >  import qualified Data.ByteString.Lazy as L+-- >  import Data.Attoparsec.Incremental (Parser, Result, parseWith)+-- >  import Network.Socket.ByteString.Lazy (recv_)+-- >  import Network.Socket (Socket)+-- >+-- >  netParse :: Parser r r -> Socket -> IO (Result r)+-- >  netParse p sock = parseWith (recv_ sock 65536) p L.empty+parseWith :: Applicative f => f L.ByteString -- ^ resupply parser with input+          -> Parser r r                      -- ^ parser to run+          -> L.ByteString                    -- ^ initial input+          -> f (Result r)+parseWith refill p s =+  case parse p s of+    Partial k -> k <$> refill+    ok        -> pure ok++-- | Try out a parser, and print its result.+parseTest :: (Show r) => Parser r r -> L.ByteString -> IO ()+parseTest p s = print (parse p s)++#define PARSER Parser r+#include "Word8Boilerplate.h"
+ Data/Attoparsec/Incremental/Char8.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.Incremental.Char8+-- Copyright   :  Bryan O'Sullivan 2009+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient, character-oriented, and incremental parser+-- combinators for lazy 'L.ByteString' strings, loosely based on the+-- Parsec library.+-- +-- /Note/: 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/ deal with character encodings,+-- multibyte characters, or wide characters.  Any attempts to use+-- characters above code point 255 will give wrong answers.+-----------------------------------------------------------------------------+module Data.Attoparsec.Incremental.Char8+    (+    -- * Parser types+      Parser+    , Result(..)++    -- * Running parsers+    , parse+    , parseWith+    , parseTest++    -- * Combinators+    , (<?>)+    , try++    -- * Parsing individual characters+    , satisfy+    , letter+    , digit+    , anyChar+    , space+    , char+    , notChar++    -- ** Character classes+    , inClass+    , notInClass++    -- * Efficient string handling+    , string+    , skipSpace+    , skipWhile+    , takeCount+    , takeTill+    , takeWhile++    -- * Text parsing+    , endOfLine++    -- * Numeric parsers+    , int+    , integer+    , double++    -- * State observation and manipulation functions+    , endOfInput+    , pushBack+    , yield++    -- * Combinators+    , module Data.Attoparsec.Combinator+    ) where++import qualified Data.ByteString.Lazy.Char8 as LB+import Data.ByteString.Internal (w2c)+import Data.Char (isDigit, isLetter, isSpace)+import Data.Attoparsec.FastSet (charClass, memberChar)+import qualified Data.Attoparsec.Incremental as I+import Data.Attoparsec.Incremental+    (Parser, Result(..), (<?>), endOfInput, parse, parseWith, parseTest,+     pushBack, string, takeCount, try, yield)+import Data.ByteString.Lex.Lazy.Double (readDouble)+import Prelude hiding (takeWhile)+import Data.Attoparsec.Combinator++numeric :: String -> (Char -> Bool)+         -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser r a+numeric desc p f = do+  s <- takeWhile p+  case f s of+    Nothing -> pushBack s >> fail desc+    Just (i,s') -> pushBack s' >> return i+                   +isIntegral :: Char -> Bool+isIntegral c = isDigit c || c == '-'++-- | Parse an 'Int'.+int :: Parser r Int+int = numeric "Int" isIntegral LB.readInt++-- | Parse an 'Integer'.+integer :: Parser r Integer+integer = numeric "Integer" isIntegral LB.readInteger++-- | Parse a 'Double'.+double :: Parser r Double+double = numeric "Double" isDouble readDouble+    where isDouble c = isIntegral c || c == 'e' || c == '+'++-- | Match the end of a line.  This may be any of a newline character,+-- a carriage return character, or a carriage return followed by a newline.+endOfLine :: Parser r ()+endOfLine = (char '\n' *> pure ()) <|> (string crlf *> pure ())+    where crlf = LB.pack "\r\n"++#define PARSER Parser r+#include "../Char8Boilerplate.h"
+ Data/Attoparsec/Internal.hs view
@@ -0,0 +1,337 @@+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Attoparsec.Internal+-- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008+-- License     :  BSD3+-- +-- Maintainer  :  bos@serpentine.com+-- Stability   :  experimental+-- Portability :  unknown+--+-- Simple, efficient parser combinators for lazy 'LB.ByteString'+-- strings, loosely based on 'Text.ParserCombinators.Parsec'.+-- +-----------------------------------------------------------------------------+module Data.Attoparsec.Internal+    (+    -- * Parser types+      ParseError+    , Parser++    -- * Running parsers+    , parse+    , parseAt+    , parseTest++    -- * Combinators+    , (<?>)+    , try++    -- * Parsing individual bytes+    , satisfy+    , anyWord8+    , word8+    , notWord8++    -- * Efficient string handling+    , match+    , notEmpty+    , skipWhile+    , string+    , stringTransform+    , takeAll+    , takeCount+    , takeTill+    , takeWhile+    , takeWhile1++    -- * State observation functions+    , endOfInput+    , getConsumed+    , getInput+    , lookAhead+    , setInput++    -- * Utilities+    , endOfLine+    , (+:)+    ) where++import Control.Applicative+    (Alternative(..), Applicative(..), (*>))+import Control.Monad (MonadPlus(..), ap)+import Control.Monad.Fix (MonadFix(..))+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Lazy.Char8 as L8+import qualified Data.ByteString.Unsafe as U+import qualified Data.ByteString.Internal as I+import qualified Data.ByteString.Lazy.Internal as LB+import Data.Int (Int64)+import Data.Word (Word8)+import Prelude hiding (takeWhile)++-- ^ A description of a parsing error.+type ParseError = String++-- State invariants:+-- * If both strict and lazy bytestrings are empty, the entire input+--   is considered to be empty.+data S = S {-# UNPACK #-} !SB.ByteString+           LB.ByteString+           {-# UNPACK #-} !Int64++-- ^ A parser that produces a result of type @a@.+newtype Parser a = Parser {+      unParser :: S -> Either (LB.ByteString, [String]) (a, S)+    }++instance Functor Parser where+    fmap f p =+        Parser $ \s ->+            case unParser p s of+              Right (a, s') -> Right (f a, s')+              Left err -> Left err++instance Monad Parser where+    return a = Parser $ \s -> Right (a, s)+    m >>= f = Parser $ \s ->+              case unParser m s of+                Right (a, s') -> unParser (f a) s'+                Left (s', msgs) -> Left (s', msgs)+    fail err = Parser $ \(S sb lb _) -> Left (sb +: lb, [err])++instance MonadFix Parser where+    mfix f = Parser $ \s ->+             let r = case r of+                       Right (a, _) -> unParser (f a) s+                       err -> err+             in r++zero :: Parser a+zero = Parser $ \(S sb lb _) -> Left (sb +: lb, [])+{-# INLINE zero #-}++plus :: Parser a -> Parser a -> Parser a+plus p1 p2 =+    Parser $ \s@(S sb lb _) ->+        case unParser p1 s of+          Left (_, msgs1) -> +              case unParser p2 s of+                Left (_, msgs2) -> Left (sb +: lb, (msgs1 ++ msgs2))+                ok -> ok+          ok -> ok+{-# INLINE plus #-}++mkState :: LB.ByteString -> Int64 -> S+mkState s = case s of+              LB.Empty -> S SB.empty s+              LB.Chunk x xs -> S x xs++-- | Turn our split representation back into a normal lazy ByteString.+(+:) :: SB.ByteString -> LB.ByteString -> LB.ByteString+sb +: lb | SB.null sb = lb+         | otherwise = LB.Chunk sb lb+{-# INLINE (+:) #-}++infix 0 <?>++-- | Name the parser, in case failure occurs.+(<?>) :: Parser a+      -> String                 -- ^ the name to use if parsing fails+      -> Parser a+p <?> msg =+    Parser $ \s@(S sb lb _) ->+        case unParser p s of+          (Left _) -> Left (sb +: lb, [msg])+          ok -> ok+{-# INLINE (<?>) #-}++nextChunk :: Parser ()+nextChunk = Parser $ \(S _ lb n) ->+            case lb of+              LB.Chunk sb' lb' -> Right ((), S sb' lb' n)+              LB.Empty -> Left (lb, [])++-- | Get remaining input.+getInput :: Parser LB.ByteString+getInput = Parser $ \s@(S sb lb _) -> Right (sb +: lb, s)++-- | Set the remaining input.+setInput :: LB.ByteString -> Parser ()+setInput bs = Parser $ \(S _ _ n) -> Right ((), mkState bs n)++-- | Get number of bytes consumed so far.+getConsumed :: Parser Int64+getConsumed = Parser $ \s@(S _ _ n) -> Right (n, s)++-- | Match a single byte based on the given predicate.+satisfy :: (Word8 -> Bool) -> Parser Word8+satisfy p =+    Parser $ \s@(S sb lb n) ->+           case SB.uncons sb of+             Just (c, sb') | p c -> Right (c, mkState (sb' +: lb) (n + 1))+                           | otherwise -> Left (sb +: lb, [])+             Nothing -> unParser (nextChunk >> satisfy p) s+{-# INLINE satisfy #-}++-- | Match a literal string exactly.+string :: LB.ByteString -> Parser LB.ByteString+string s = Parser $ \(S sb lb n) ->+           let bs = sb +: lb+               l = LB.length s+               (h,t) = LB.splitAt l bs+           in if s == h+              then Right (s, mkState t (n + l))+              else Left (bs, [])+{-# INLINE string #-}++-- | Match the end of a line.  This may be any of a newline character,+-- a carriage return character, or a carriage return followed by a newline.+endOfLine :: Parser ()+endOfLine = Parser $ \(S sb lb n) ->+            let bs = sb +: lb+            in if SB.null sb+               then Left (bs, ["EOL"])+               else case I.w2c (U.unsafeHead sb) of+                     '\n' -> Right ((), mkState (LB.tail bs) (n + 1))+                     '\r' -> let (h,t) = LB.splitAt 2 bs+                                 rn = L8.pack "\r\n"+                             in if h == rn+                                then Right ((), mkState t (n + 2))+                                else Right ((), mkState (LB.tail bs) (n + 1))+                     _ -> Left (bs, ["EOL"])++-- | Match a literal string, after applying a transformation to both+-- it and the matching text.  Useful for e.g. case insensitive string+-- comparison.+stringTransform :: (LB.ByteString -> LB.ByteString) -> LB.ByteString+                -> Parser LB.ByteString+stringTransform f s = Parser $ \(S sb lb n) ->+             let bs = sb +: lb+                 l = LB.length s+                 (h, t) = LB.splitAt l bs+             in if fs == f h+                then Right (s, mkState t (n + l))+                else Left (bs, [])+    where fs = f s+{-# INLINE stringTransform #-}++-- | Attempt a parse, but do not consume any input if the parse fails.+try :: Parser a -> Parser a+try p = Parser $ \s@(S sb lb _) ->+        case unParser p s of+          Left (_, msgs) -> Left (sb +: lb, msgs)+          ok -> ok++-- | Succeed if we have reached the end of the input string.+endOfInput :: Parser ()+endOfInput = Parser $ \s@(S sb lb _) -> if SB.null sb && LB.null lb+                                        then Right ((), s)+                                        else Left (sb +: lb, ["EOF"])++-- | Return all of the remaining input as a single string.+takeAll :: Parser LB.ByteString+takeAll = Parser $ \(S sb lb n) ->+          let bs = sb +: lb+          in Right (bs, mkState LB.empty (n + LB.length bs))++-- | Return exactly the given number of bytes.  If not enough are+-- available, fail.+takeCount :: Int -> Parser LB.ByteString+takeCount k =+  Parser $ \(S sb lb n) ->+      let bs = sb +: lb+          k' = fromIntegral k+          (h,t) = LB.splitAt k' bs+      in if LB.length h == k'+         then Right (h, mkState t (n + k'))+         else Left (bs, [show k ++ " bytes"])++-- | Consume bytes while the predicate succeeds.+takeWhile :: (Word8 -> Bool) -> Parser LB.ByteString+takeWhile p =+    Parser $ \(S sb lb n) ->+    let (h,t) = LB.span p (sb +: lb)+    in Right (h, mkState t (n + LB.length h))+{-# INLINE takeWhile #-}++-- | Consume bytes while the predicate fails.  If the predicate never+-- succeeds, the entire input string is returned.+takeTill :: (Word8 -> Bool) -> Parser LB.ByteString+takeTill p =+  Parser $ \(S sb lb n) ->+  let (h,t) = LB.break p (sb +: lb)+  in Right (h, mkState t (n + LB.length h))+{-# INLINE takeTill #-}++-- | Consume bytes while the predicate is true.  Fails if the+-- predicate fails on the first byte.+takeWhile1 :: (Word8 -> Bool) -> Parser LB.ByteString+takeWhile1 p =+    Parser $ \(S sb lb n) ->+    case LB.span p (sb +: lb) of+      (h,t) | LB.null h -> Left (t, [])+            | otherwise -> Right (h, mkState t (n + LB.length h))+{-# INLINE takeWhile1 #-}++-- | Test that a parser returned a non-null 'LB.ByteString'.+notEmpty :: Parser LB.ByteString -> Parser LB.ByteString +notEmpty p = Parser $ \s ->+             case unParser p s of+               o@(Right (a, _)) ->+                   if LB.null a+                   then Left (a, ["notEmpty"])+                   else o+               x -> x++-- | Parse some input with the given parser, and return the input it+-- consumed as a string.+match :: Parser a -> Parser LB.ByteString+match p = do bs <- getInput+             start <- getConsumed+             p+             end <- getConsumed+             return (LB.take (end - start) bs)++-- | Apply a parser without consuming any input.+lookAhead :: Parser a -> Parser a+lookAhead p = Parser $ \s ->+         case unParser p s of+           Right (m, _) -> Right (m, s)+           err -> err++-- | Run a parser. The 'Int64' value is used as a base to count the+-- number of bytes consumed.+parseAt :: Parser a             -- ^ parser to run+        -> LB.ByteString        -- ^ input to parse+        -> Int64                -- ^ offset to count input from+        -> (LB.ByteString, Either ParseError (a, Int64))+parseAt p bs n = +    case unParser p (mkState bs n) of+      Left (bs', msg) -> (bs', Left $ showError msg)+      Right (a, ~(S sb lb n')) -> (sb +: lb, Right (a, n'))+    where+      showError [""] = "Parser error\n"+      showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"+      showError [] = "Parser error\n"+      showError msgs = "Parser error, expected one of:\n" ++ unlines msgs++-- | Run a parser.+parse :: Parser a               -- ^ parser to run+      -> LB.ByteString          -- ^ input to parse+      -> (LB.ByteString, Either ParseError a)+parse p bs = case parseAt p bs 0 of+               (bs', Right (a, _)) -> (bs', Right a)+               (bs', Left err) -> (bs', Left err)++-- | Try out a parser, and print its result.+parseTest :: (Show a) => Parser a -> LB.ByteString -> IO ()+parseTest p s =+    case parse p s of+      (st, Left msg) -> putStrLn $ msg ++ "\nGot:\n" ++ show st+      (_, Right r) -> print r++#define PARSER Parser+#include "Word8Boilerplate.h"
+ Data/Attoparsec/Word8Boilerplate.h view
@@ -0,0 +1,34 @@+-- -*- haskell -*-+-- This file is intended to be #included by other source files.++instance MonadPlus (PARSER) where+    mzero = zero+    mplus = plus++instance Applicative (PARSER) where+    pure = return+    (<*>) = ap++instance Alternative (PARSER) where+    empty = zero+    (<|>) = plus++-- | Skip over bytes while the predicate is true.+skipWhile :: (Word8 -> Bool) -> PARSER ()+skipWhile p = takeWhile p *> pure ()+{-# INLINE skipWhile #-}++-- | 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 #-}
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
attoparsec.cabal view
@@ -1,16 +1,20 @@ name:            attoparsec-version:         0.6+version:         0.7.1 license:         BSD3 license-file:    LICENSE category:        Text, Parsing author:          Bryan O'Sullivan <bos@serpentine.com> maintainer:      Bryan O'Sullivan <bos@serpentine.com> stability:       experimental+tested-with:     GHC == 6.8.3, GHC == 6.10.1 synopsis:        Fast combinator parsing with Data.ByteString.Lazy description:     Fast combinator parsing with Data.ByteString.Lazy cabal-version:   >= 1.2 build-type:      Simple description:     Fast, flexible text-oriented parsing of lazy ByteStrings.+extra-source-files:+                 Data/Attoparsec/Char8Boilerplate.h+                 Data/Attoparsec/Word8Boilerplate.h  flag split-base flag applicative-in-base@@ -32,10 +36,12 @@   build-depends: bytestring-lexing >= 0.2    extensions:      CPP-  exposed-modules: Data.ParserCombinators.Attoparsec-                   Data.ParserCombinators.Attoparsec.Char8-                   Data.ParserCombinators.Attoparsec.FastSet-                   Data.ParserCombinators.Attoparsec.Internal-  hs-source-dirs:  src+  exposed-modules: Data.Attoparsec+                   Data.Attoparsec.Char8+                   Data.Attoparsec.Combinator+                   Data.Attoparsec.Incremental+                   Data.Attoparsec.Incremental.Char8+                   Data.Attoparsec.FastSet+  other-modules:   Data.Attoparsec.Internal   ghc-options:     -O2 -Wall -funbox-strict-fields                    -fliberate-case-threshold=1000
− src/Data/ParserCombinators/Attoparsec.hs
@@ -1,67 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.ParserCombinators.Attoparsec--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Simple, efficient parser combinators for lazy 'LB.ByteString'--- strings, loosely based on 'Text.ParserCombinators.Parsec'.--- -------------------------------------------------------------------------------module Data.ParserCombinators.Attoparsec-    (-    -- * Parser-      ParseError-    , Parser--    -- * Running parsers-    , parse-    , parseAt-    , parseTest--    -- * Combinators-    , (<?>)--    -- * Things vaguely like those in @Parsec.Combinator@ (and @Parsec.Prim@)-    , try-    , many-    , many1-    , manyTill-    , eof-    , skipMany-    , skipMany1-    , count-    , lookAhead-    , peek-    , sepBy-    , sepBy1--    -- * Things like in @Parsec.Char@-    , satisfy-    , anyWord8-    , word8-    , notWord8-    , string-    , stringTransform--    -- * Parser converters.-    , eitherP--    -- * Miscellaneous functions.-    , getInput-    , getConsumed-    , takeWhile-    , takeWhile1-    , takeTill-    , takeAll-    , skipWhile-    , notEmpty-    , match-    ) where--import Data.ParserCombinators.Attoparsec.Internal-import Prelude hiding (takeWhile)
− src/Data/ParserCombinators/Attoparsec/Char8.hs
@@ -1,186 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.ParserCombinators.Attoparsec.Char8--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Simple, efficient parser combinators for lazy 'LB.ByteString'--- strings, loosely based on 'Text.ParserCombinators.Parsec'.--- -------------------------------------------------------------------------------module Data.ParserCombinators.Attoparsec.Char8-    (-    -- * Parser-      ParseError-    , Parser--    -- * Running parsers-    , parse-    , parseAt-    , parseTest--    -- * Combinators-    , (<?>)--    -- * Things vaguely like those in @Parsec.Combinator@ (and @Parsec.Prim@)-    , try-    , many-    , many1-    , manyTill-    , eof-    , skipMany-    , skipMany1-    , count-    , lookAhead-    , peek-    , sepBy-    , sepBy1--    -- * Things like in @Parsec.Char@-    , satisfy-    , letter-    , digit-    , anyChar-    , space-    , char-    , notChar-    , string-    , stringCI--    -- * Parser converters.-    , eitherP--    -- * Numeric parsers.-    , int-    , integer-    , double--    -- * Miscellaneous functions.-    , getInput-    , getConsumed-    , takeWhile-    , takeWhile1-    , takeTill-    , takeAll-    , takeCount-    , skipWhile-    , skipSpace-    , notEmpty-    , match-    , inClass-    , notInClass-    , endOfLine-    ) where--import Control.Applicative ((<$>))-import qualified Data.ByteString.Char8 as SB-import qualified Data.ByteString.Lazy.Char8 as LB-import Data.ByteString.Internal (w2c)-import Data.Char (isDigit, isLetter, isSpace, toLower)-import Data.ParserCombinators.Attoparsec.FastSet-    (FastSet, memberChar, set)-import qualified Data.ParserCombinators.Attoparsec.Internal as I-import Data.ParserCombinators.Attoparsec.Internal-    (Parser, ParseError, (<?>), parse, parseAt, parseTest, try, manyTill, eof,-     skipMany, skipMany1, count, lookAhead, peek, sepBy, sepBy1, string,-     eitherP, getInput, getConsumed, takeAll, takeCount, notEmpty, match,-     endOfLine, setInput, many, many1)-import Data.ByteString.Lex.Lazy.Double (readDouble)-import Prelude hiding (takeWhile)---- | Character parser.-satisfy :: (Char -> Bool) -> Parser Char-satisfy p = w2c <$> I.satisfy (p . w2c)-{-# INLINE satisfy #-}--letter :: Parser Char-letter = satisfy isLetter <?> "letter"-{-# INLINE letter #-}--digit :: Parser Char-digit = satisfy isDigit <?> "digit"-{-# INLINE digit #-}--anyChar :: Parser Char-anyChar = satisfy $ const True-{-# INLINE anyChar #-}--space :: Parser Char-space = satisfy isSpace <?> "space"-{-# INLINE space #-}---- | Satisfy a specific character.-char :: Char -> Parser Char-char c = satisfy (== c) <?> [c]-{-# INLINE char #-}---- | Satisfy a specific character.-notChar :: Char -> Parser Char-notChar c = satisfy (/= c) <?> "not " ++ [c]-{-# INLINE notChar #-}--charClass :: String -> FastSet-charClass = set . SB.pack . go-    where go (a:'-':b:xs) = [a..b] ++ go xs-          go (x:xs) = x : go xs-          go _ = ""--inClass :: String -> Char -> Bool-inClass s = (`memberChar` myset)-    where myset = charClass s-{-# INLINE inClass #-}--notInClass :: String -> Char -> Bool-notInClass s = not . inClass s-{-# INLINE notInClass #-}---- | Satisfy a literal string, ignoring case.-stringCI :: LB.ByteString -> Parser LB.ByteString-stringCI = I.stringTransform (LB.map toLower)-{-# INLINE stringCI #-}---- | Consume characters while the predicate is true.-takeWhile :: (Char -> Bool) -> Parser LB.ByteString-takeWhile p = I.takeWhile (p . w2c)-{-# INLINE takeWhile #-}--takeTill :: (Char -> Bool) -> Parser LB.ByteString-takeTill p = I.takeTill (p . w2c)-{-# INLINE takeTill #-}--takeWhile1 :: (Char -> Bool) -> Parser LB.ByteString-takeWhile1 p = I.takeWhile1 (p . w2c)-{-# INLINE takeWhile1 #-}---- | Skip over characters while the predicate is true.-skipWhile :: (Char -> Bool) -> Parser ()-skipWhile p = I.skipWhile (p . w2c)-{-# INLINE skipWhile #-}---- | Skip over white space.-skipSpace :: Parser ()-skipSpace = takeWhile isSpace >> return ()-{-# INLINE skipSpace #-}--numeric :: String -> (LB.ByteString -> Maybe (a,LB.ByteString)) -> Parser a-numeric desc f = do-  s <- getInput-  case f s of-    Nothing -> fail desc-    Just (i,s') -> setInput s' >> return i-                   --- | Parse an integer.  The position counter is not updated.-int :: Parser Int-int = numeric "Int" LB.readInt---- | Parse an integer.  The position counter is not updated.-integer :: Parser Integer-integer = numeric "Integer" LB.readInteger---- | Parse a Double.  The position counter is not updated.-double :: Parser Double-double = numeric "Double" readDouble
− src/Data/ParserCombinators/Attoparsec/FastSet.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE BangPatterns #-}---------------------------------------------------------------------------------- |--- Module      :  Data.ParserCombinators.Attoparsec.FastSet--- Copyright   :  Bryan O'Sullivan 2008--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Fast set membership tests for 'Word8' and 8-bit 'Char' values.  The--- set representation is unboxed for efficiency.  For sets of fewer--- than 32 elements, we test for membership using a binary search.--- For larger sets, we use a lookup table.--- -------------------------------------------------------------------------------module Data.ParserCombinators.Attoparsec.FastSet-    (-    -- * Data type-      FastSet-    -- * Construction-    , fromList-    , set-    -- * Lookup-    , memberChar-    , memberWord8-    -- * Debugging-    , fromSet-    ) where--import Data.Bits ((.&.), (.|.), shiftL, shiftR)-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString as B-import qualified Data.ByteString.Internal as I-import qualified Data.ByteString.Unsafe as U-import Data.Word (Word8)-import Foreign.Storable (peekByteOff, pokeByteOff)--data FastSet = Sorted { fromSet :: {-# UNPACK #-} !B.ByteString }-             | Table  { fromSet :: {-# UNPACK #-} !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--index :: Int -> (Int, Word8)-index i = (i `shiftR` 3, 1 `shiftL` (i .&. 7))---- | Check the set for membership.-memberWord8 :: Word8 -> FastSet -> Bool-memberWord8 w (Table t)  =-    let (byte,bit) = index (fromIntegral w)-    in U.unsafeIndex t byte .&. bit /= 0-memberWord8 w (Sorted s) = search 0 (B.length s - 1)-    where search lo hi-              | hi < lo = False-              | otherwise =-                  let mid = (lo + hi) `div` 2-                  in case compare w (U.unsafeIndex s mid) of-                       GT -> search (mid + 1) hi-                       LT -> search lo (mid - 1)-                       _ -> True---- | Check the set for membership.  Only works with 8-bit characters:--- characters above code point 255 will give wrong answers.-memberChar :: Char -> FastSet -> Bool-memberChar c = memberWord8 (I.c2w c)--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 (byte,bit) = index (fromIntegral c)-                    prev <- peekByteOff t byte :: IO Word8-                    pokeByteOff t byte (prev .|. bit)-                    loop (n + 1)-              in loop 0
− src/Data/ParserCombinators/Attoparsec/Internal.hs
@@ -1,391 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Data.ParserCombinators.Attoparsec.Internal--- Copyright   :  Daan Leijen 1999-2001, Jeremy Shaw 2006, Bryan O'Sullivan 2007-2008--- License     :  BSD3--- --- Maintainer  :  bos@serpentine.com--- Stability   :  experimental--- Portability :  unknown------ Simple, efficient parser combinators for lazy 'LB.ByteString'--- strings, loosely based on 'Text.ParserCombinators.Parsec'.--- -------------------------------------------------------------------------------module Data.ParserCombinators.Attoparsec.Internal-    (-    -- * Parser-      ParseError-    , Parser--    -- * Running parsers-    , parse-    , parseAt-    , parseTest--    -- * Combinators-    , (<?>)--    -- * Things vaguely like those in @Parsec.Combinator@ (and @Parsec.Prim@)-    , try-    , many-    , many1-    , manyTill-    , eof-    , skipMany-    , skipMany1-    , count-    , lookAhead-    , peek-    , sepBy-    , sepBy1--    -- * Things like in @Parsec.Char@-    , satisfy-    , anyWord8-    , word8-    , notWord8-    , string-    , stringTransform--    -- * Parser converters.-    , eitherP--    -- * Miscellaneous functions.-    , getInput-    , getConsumed-    , setInput-    , takeWhile-    , takeWhile1-    , takeTill-    , takeAll-    , takeCount-    , skipWhile-    , notEmpty-    , match-    , endOfLine-    ) where--import Control.Applicative (Alternative(..), Applicative(..), (<$>))-import Control.Monad (MonadPlus(..), ap, liftM2)-import Control.Monad.Fix (MonadFix(..))-import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import qualified Data.ByteString.Lazy.Char8 as L8-import qualified Data.ByteString.Unsafe as U-import qualified Data.ByteString.Internal as I-import qualified Data.ByteString.Lazy.Internal as LB-import Data.Int (Int64)-import Data.Word (Word8)-import Prelude hiding (takeWhile)--type ParseError = String---- State invariants:--- * If both strict and lazy bytestrings are empty, the entire input---   is considered to be empty.-data S = S {-# UNPACK #-} !SB.ByteString-           LB.ByteString-           {-# UNPACK #-} !Int64--newtype Parser a = Parser {-      unParser :: S -> Either (LB.ByteString, [String]) (a, S)-    }--instance Functor Parser where-    fmap f p =-        Parser $ \s ->-            case unParser p s of-              Right (a, s') -> Right (f a, s')-              Left err -> Left err--instance Monad Parser where-    return a = Parser $ \s -> Right (a, s)-    m >>= f = Parser $ \s ->-              case unParser m s of-                Right (a, s') -> unParser (f a) s'-                Left (s', msgs) -> Left (s', msgs)-    fail err = Parser $ \(S sb lb _) -> Left (sb +: lb, [err])--instance MonadFix Parser where-    mfix f = Parser $ \s ->-             let r = case r of-                       Right (a, _) -> unParser (f a) s-                       err -> err-             in r--zero :: Parser a-zero = Parser $ \(S sb lb _) -> Left (sb +: lb, [])-{-# INLINE zero #-}--plus :: Parser a -> Parser a -> Parser a-plus p1 p2 =-    Parser $ \s@(S sb lb _) ->-        case unParser p1 s of-          Left (_, msgs1) -> -              case unParser p2 s of-                Left (_, msgs2) -> Left (sb +: lb, (msgs1 ++ msgs2))-                ok -> ok-          ok -> ok-{-# INLINE plus #-}--instance MonadPlus Parser where-    mzero = zero-    mplus = plus--instance Applicative Parser where-    pure = return-    (<*>) = ap--instance Alternative Parser where-    empty = zero-    (<|>) = plus--mkState :: LB.ByteString -> Int64 -> S-mkState s = case s of-              LB.Empty -> S SB.empty s-              LB.Chunk x xs -> S x xs---- | Turn our chunked representation back into a normal lazy--- ByteString.-(+:) :: SB.ByteString -> LB.ByteString -> LB.ByteString-sb +: lb | SB.null sb = lb-         | otherwise = LB.Chunk sb lb-{-# INLINE (+:) #-}--infix 0 <?>---- | Name the parser.-(<?>) :: Parser a -> String -> Parser a-p <?> msg =-    Parser $ \s@(S sb lb _) ->-        case unParser p s of-          (Left _) -> Left (sb +: lb, [msg])-          ok -> ok-{-# INLINE (<?>) #-}--nextChunk :: Parser ()-nextChunk = Parser $ \(S _ lb n) ->-            case lb of-              LB.Chunk sb' lb' -> Right ((), S sb' lb' n)-              LB.Empty -> Left (lb, [])---- | Get remaining input.-getInput :: Parser LB.ByteString-getInput = Parser $ \s@(S sb lb _) -> Right (sb +: lb, s)---- | Set the remaining input.-setInput :: LB.ByteString -> Parser ()-setInput bs = Parser $ \(S _ _ n) -> Right ((), mkState bs n)---- | Get number of bytes consumed so far.-getConsumed :: Parser Int64-getConsumed = Parser $ \s@(S _ _ n) -> Right (n, s)---- | Character parser.-satisfy :: (Word8 -> Bool) -> Parser Word8-satisfy p =-    Parser $ \s@(S sb lb n) ->-           case SB.uncons sb of-             Just (c, sb') | p c -> Right (c, mkState (sb' +: lb) (n + 1))-                           | otherwise -> Left (sb +: lb, [])-             Nothing -> unParser (nextChunk >> satisfy p) s-{-# INLINE satisfy #-}--anyWord8 :: Parser Word8-anyWord8 = satisfy $ const True-{-# INLINE anyWord8 #-}---- | Satisfy a specific character.-word8 :: Word8 -> Parser Word8-word8 c = satisfy (== c) <?> show c-{-# INLINE word8 #-}---- | Satisfy a specific character.-notWord8 :: Word8 -> Parser Word8-notWord8 c = satisfy (/= c) <?> "not " ++ show c-{-# INLINE notWord8 #-}--sepBy :: Parser a -> Parser s -> Parser [a]-sepBy p s = liftM2 (:) p ((s >> sepBy1 p s) <|> return []) <|> return []--sepBy1 :: Parser a -> Parser s -> Parser [a]-sepBy1 p s = liftM2 (:) p ((s >> sepBy1 p s) <|> return [])---- | Satisfy a literal string.-string :: LB.ByteString -> Parser LB.ByteString-string s = Parser $ \(S sb lb n) ->-           let bs = sb +: lb-               l = LB.length s-               (h,t) = LB.splitAt l bs-           in if s == h-              then Right (s, mkState t (n + l))-              else Left (bs, [])-{-# INLINE string #-}--endOfLine :: Parser ()-endOfLine = Parser $ \(S sb lb n) ->-            let bs = sb +: lb-            in if SB.null sb-               then Left (bs, ["EOL"])-               else case I.w2c (U.unsafeHead sb) of-                     '\n' -> Right ((), mkState (LB.tail bs) (n + 1))-                     '\r' -> let (h,t) = LB.splitAt 2 bs-                                 rn = L8.pack "\r\n"-                             in if h == rn-                                then Right ((), mkState t (n + 2))-                                else Right ((), mkState (LB.tail bs) (n + 1))-                     _ -> Left (bs, ["EOL"])---- | Satisfy a literal string, after applying a transformation to both--- it and the matching text.-stringTransform :: (LB.ByteString -> LB.ByteString) -> LB.ByteString-                -> Parser LB.ByteString-stringTransform f s = Parser $ \(S sb lb n) ->-             let bs = sb +: lb-                 l = LB.length s-                 (h, t) = LB.splitAt l bs-             in if fs == f h-                then Right (s, mkState t (n + l))-                else Left (bs, [])-    where fs = f s-{-# INLINE stringTransform #-}---- | Apply the given parser repeatedly, returning every parse result.-count :: Int -> Parser a -> Parser [a]-count n p = sequence (replicate n p)-{-# INLINE count #-}--try :: Parser a -> Parser a-try p = Parser $ \s@(S sb lb _) ->-        case unParser p s of-          Left (_, msgs) -> Left (sb +: lb, msgs)-          ok -> ok---- | Detect 'end of file'.-eof :: Parser ()-eof = Parser $ \s@(S sb lb _) -> if SB.null sb && LB.null lb-                                 then Right ((), s)-                                 else Left (sb +: lb, ["EOF"])--takeAll :: Parser LB.ByteString-takeAll = Parser $ \(S sb lb n) ->-          let bs = sb +: lb-          in Right (bs, mkState LB.empty (n + LB.length bs))--takeCount :: Int64 -> Parser LB.ByteString-takeCount k =-  Parser $ \(S sb lb n) ->-      let bs = sb +: lb-          (h,t) = LB.splitAt k bs-      in if LB.length h == k-         then Right (h, mkState t (n + k))-         else Left (bs, [show k ++ " bytes"])---- | Consume characters while the predicate is true.-takeWhile :: (Word8 -> Bool) -> Parser LB.ByteString-takeWhile p =-    Parser $ \(S sb lb n) ->-    case LB.span p (sb +: lb) of-      (h,t) -> Right (h, mkState t (n + LB.length h))-{-# INLINE takeWhile #-}--takeTill :: (Word8 -> Bool) -> Parser LB.ByteString-takeTill p =-  Parser $ \(S sb lb n) ->-  case LB.break p (sb +: lb) of-    (h,t) | LB.null t -> Left (h, [])-          | otherwise -> Right (h, mkState t (n + LB.length h))-{-# INLINE takeTill #-}--takeWhile1 :: (Word8 -> Bool) -> Parser LB.ByteString-takeWhile1 p =-    Parser $ \(S sb lb n) ->-    case LB.span p (sb +: lb) of-      (h,t) | LB.null h -> Left (t, [])-            | otherwise -> Right (h, mkState t (n + LB.length h))-{-# INLINE takeWhile1 #-}---- | Skip over characters while the predicate is true.-skipWhile :: (Word8 -> Bool) -> Parser ()-skipWhile p = takeWhile p >> return ()-{-# INLINE skipWhile #-}--manyTill :: Parser a -> Parser b -> Parser [a]-manyTill p end = scan-    where scan = (end >> return []) <|> liftM2 (:) p scan--many :: Parser a -> Parser [a]-many p = ((:) <$> p <*> many p) <|> return []--many1 :: Parser a -> Parser [a]-many1 p = (:) <$> p <*> many p---- |'skipMany' - skip zero or many instances of the parser-skipMany :: Parser a -> Parser ()-skipMany p = scan-    where scan = (p >> scan) <|> return ()---- |'skipMany1' - skip one or many instances of the parser       -skipMany1 :: Parser  a -> Parser ()-skipMany1 p = p >> skipMany p---- | Test that a parser returned a non-null ByteString.-notEmpty :: Parser LB.ByteString -> Parser LB.ByteString -notEmpty p = Parser $ \s ->-             case unParser p s of-               o@(Right (a, _)) ->-                   if LB.null a-                   then Left (a, ["notEmpty"])-                   else o-               x -> x---- | Parse some input with the given parser and return that input--- without copying it.-match :: Parser a -> Parser LB.ByteString-match p = do bs <- getInput-             start <- getConsumed-             p-             end <- getConsumed-             return (LB.take (end - start) bs)--eitherP :: Parser a -> Parser b -> Parser (Either a b)-eitherP a b = (Left <$> a) <|> (Right <$> b)-{-# INLINE eitherP #-}--peek :: Parser a -> Parser (Maybe a)-peek p = Parser $ \s ->-         case unParser p s of-           Right (m, _) -> Right (Just m, s)-           _ -> Right (Nothing, s)--lookAhead :: Parser a -> Parser a-lookAhead p = Parser $ \s ->-         case unParser p s of-           Right (m, _) -> Right (m, s)-           Left (e, bs) -> Left (e, bs)--parseAt :: Parser a -> LB.ByteString -> Int64-        -> (LB.ByteString, Either ParseError (a, Int64))-parseAt p bs n = -    case unParser p (mkState bs n) of-      Left (bs', msg) -> (bs', Left $ showError msg)-      Right (a, ~(S sb lb n')) -> (sb +: lb, Right (a, n'))-    where-      showError [""] = "Parser error\n"-      showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"-      showError [] = "Parser error\n"-      showError msgs = "Parser error, expected one of:\n" ++ unlines msgs---- | Run a parser.-parse :: Parser a -> LB.ByteString-      -> (LB.ByteString, Either ParseError a)-parse p bs = case parseAt p bs 0 of-               (bs', Right (a, _)) -> (bs', Right a)-               (bs', Left err) -> (bs', Left err)--parseTest :: (Show a) => Parser a -> LB.ByteString -> IO ()-parseTest p s =-    case parse p s of-      (st, Left msg) -> putStrLn $ msg ++ "\nGot:\n" ++ show st-      (_, Right r) -> print r