Bryan O'Sullivan avatar Bryan O'Sullivan committed 204a007

Snapshot.

Comments (0)

Files changed (3)

+Copyright (c) Lennart Kolmodin
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions
+are met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+
+3. Neither the name of the author nor the names of his contributors
+   may be used to endorse or promote products derived from this software
+   without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS
+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.

bytestringparser.cabal

 synopsis:        Combinator parsing with Data.ByteString.Lazy
 cabal-version:   >= 1.2
 
-flag bytestring-in-base
+flag split-base
 flag applicative-in-base
 
 library
-  if flag(bytestring-in-base)
+  if flag(split-base)
     -- bytestring was in base-2.0 and 2.1.1
     build-depends: base >= 2.0 && < 2.2
   else
     -- in base 1.0 and 3.0 bytestring is a separate package
-    build-depends: base < 2.0 || >= 3, bytestring >= 0.9
+    build-depends: base < 2.0 || >= 3, bytestring >= 0.9, containers >= 0.1.0.1
 
   if flag(applicative-in-base)
     build-depends: base >= 2.0
   else
     build-depends: base < 2.0
 
+  extensions:      CPP
   exposed-modules: Text.ParserCombinators.ByteStringParser
   hs-source-dirs:  src
   ghc-options:     -O2 -Wall -Werror

src/Text/ParserCombinators/ByteStringParser.hs

-{-# LANGUAGE CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Text.ParserCombinators.ByteStringParser
 -- Stability   :  experimental
 -- Portability :  unknown
 --
--- Primitive parser combinators for ByteStrings loosely based on Parsec.
+-- Simple, efficient parser combinators for lazy 'C.ByteString'
+-- values, loosely based on 'Text.ParserCombinators.Parsec'.
 -- 
 -----------------------------------------------------------------------------
 module Text.ParserCombinators.ByteStringParser
 
     -- * Running parsers
     , parse
+    , parseAt
     , parseTest
 
     -- * Combinators
     , eof
     , skipMany
     , skipMany1
+    , count
+    , lookAhead
+    , sepBy
+    , sepBy1
 
     -- * Things like in @Parsec.Char@
     , satisfy
     , space
     , char
     , string
+    , stringCI
+    , byteString
+    , byteStringCI
 
     -- * Miscellaneous functions.
     , getInput
     , getConsumed
     , takeWhile
+    , takeWhile1
+    , takeAll
     , skipWhile
+    , skipSpace
+    , notEmpty
+    , match
+    , inClass
+    , notInClass
     ) where
 
-#ifdef APPLICATIVE_IN_BASE
 import Control.Applicative (Applicative(..))
-#endif
-
-import Control.Monad (MonadPlus(..), ap)
+import Control.Monad (MonadPlus(..), ap, liftM2)
 import qualified Data.ByteString.Lazy.Char8 as C
-import Data.Char (isDigit, isLetter, isSpace)
+import Data.Char (isDigit, isLetter, isSpace, toLower)
 import Data.Int (Int64)
+import qualified Data.Set as S
 import Prelude hiding (takeWhile)
 
 type ParseError = (C.ByteString, String)
 -- | Choice.
 (<|>) :: Parser a -> Parser a -> Parser a
 (<|>) = mplus
+{-# INLINE (<|>) #-}
 
 -- | Name the parser.
 (<?>) :: Parser a -> String -> Parser a
         case unParser p s of
           (Left _) -> Left (bs, [msg])
           ok -> ok
+{-# INLINE (<?>) #-}
 
 -- | Get remaining input.
 getInput :: Parser C.ByteString
 getInput = Parser $ \s@(S bs _) -> Right (bs, s)
 
--- | Get remaining input.
+-- | Get number of bytes consumed so far.
 getConsumed :: Parser Int64
 getConsumed = Parser $ \s@(S _ n) -> Right (n, s)
 
-
 -- | Character parser.
 satisfy :: (Char -> Bool) -> Parser Char
 satisfy f =
     Parser $ \(S bs n) ->
-        if C.null bs
-        then Left (bs, [])
-        else let Just (s, bs') = C.uncons bs in
-             if f s
-                then Right (s, S bs' (n + 1))
-                else Left (bs, [])
+           case C.uncons bs of
+             Just (s, bs') | f s -> Right (s, S bs' (n + 1))
+             _                   -> Left (bs, [])
 {-# INLINE satisfy #-}
 
-
 letter :: Parser Char
-letter = satisfy isLetter
+letter = satisfy isLetter <?> "letter"
 {-# INLINE letter #-}
 
 digit :: Parser Char
-digit = satisfy isDigit
+digit = satisfy isDigit <?> "digit"
 {-# INLINE digit #-}
 
 anyChar :: Parser Char
 {-# INLINE anyChar #-}
 
 space :: Parser Char
-space = satisfy isSpace
+space = satisfy isSpace <?> "space"
 {-# INLINE space #-}
 
 -- | Satisfy a specific character.
-
 char :: Char -> Parser Char
 char c = satisfy (== c) <?> [c]
 {-# INLINE char #-}
 
+charClass :: String -> S.Set Char
+charClass s = S.fromList (go s)
+    where go (a:'-':b:xs) = [a..b] ++ go xs
+          go (x:xs) = x : go xs
+          go _ = ""
+
+inClass :: String -> Char -> Bool
+inClass s = (`S.member` set)
+    where set = charClass s
+
+notInClass :: String -> Char -> Bool
+notInClass s = (`S.notMember` set)
+    where set = charClass s
+
+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.
+byteString :: C.ByteString -> Parser C.ByteString
+byteString s = Parser $ \(S bs n) ->
+               let l = C.length s
+                   (h, t) = C.splitAt l bs
+               in if s == h
+                  then Right (s, S t (n + l))
+                  else Left (bs, [])
+{-# INLINE byteString #-}
+
+-- | Satisfy a literal string.
+byteStringCI :: C.ByteString -> Parser C.ByteString
+byteStringCI s = Parser $ \(S bs n) ->
+               let l = C.length s
+                   (h, t) = C.splitAt l bs
+               in if ls == C.map toLower h
+                  then Right (s, S t (n + l))
+                  else Left (bs, [])
+    where ls = C.map toLower s
+{-# INLINE byteStringCI #-}
+
 string :: String -> Parser String
-string s = mapM char s <?> show s
+string s = byteString (C.pack s) >> return s
 {-# INLINE string #-}
 
+stringCI :: String -> Parser String
+stringCI s = byteStringCI (C.pack s) >> return s
+{-# INLINE stringCI #-}
+
+-- | Apply the given parser repeatedly, returning every parse result.
 count :: Int -> Parser a -> Parser [a]
 count n p = sequence (replicate n p)
 {-# INLINE count #-}
                               then Right ((), s)
                               else Left (bs, ["EOF"])
 
+takeAll :: Parser C.ByteString
+takeAll = Parser $ \(S bs n) -> Right (bs, S C.empty (n + C.length bs))
+
 -- | Consume characters while the predicate is true.
 takeWhile :: (Char -> Bool) -> Parser C.ByteString
 takeWhile f = Parser $ \(S bs n) ->
               let (h, bs') = C.span f bs
               in Right (h, S bs' (n + C.length h))
+{-# INLINE takeWhile #-}
+
+takeWhile1 :: (Char -> Bool) -> Parser C.ByteString
+takeWhile1 f = Parser $ \(S bs n) ->
+              let (h, bs') = C.span f bs
+              in if C.null h
+                 then Left (bs, [])
+                 else Right (h, S bs' (n + C.length h))
+{-# INLINE takeWhile1 #-}
 
 -- | Skip over characters while the predicate is true.
 skipWhile :: (Char -> Bool) -> Parser ()
 skipWhile p = takeWhile p >> return ()
+{-# INLINE skipWhile #-}
+
+-- | Skip over white space.
+skipSpace :: Parser ()
+skipSpace = takeWhile isSpace >> return ()
+{-# INLINE skipSpace #-}
 
 -- | Take zero or more instances of the parser.
 many ::  Parser a -> Parser [a]
 
 -- | Take one or more instances of the parser.
 many1 :: Parser a -> Parser [a]
-many1 p =
-    do x <- p
-       xs <- many p
-       return (x:xs)
+many1 p = liftM2 (:) p (many p)
 
 manyTill :: Parser a -> Parser b -> Parser [a]
 manyTill p end = scan
-    where scan = do end; return []
-               <|>
-                 do x <- p
-                    xs <- scan
-                    return (x:xs)
+    where scan = (end >> return []) <|> liftM2 (:) p scan
 
 -- |'skipMany' - skip zero or many instances of the parser
 skipMany :: Parser a -> Parser ()
 skipMany p = scan
-    where
-      scan = (p >> scan) <|> return ()
+    where scan = (p >> scan) <|> return ()
 
 -- |'skipMany1' - skip one or many instances of the parser       
 skipMany1 :: Parser  a -> Parser ()
              end <- getConsumed
              return (C.take (end - start) bs)
 
-lookAhead :: Parser a -> Parser a
+lookAhead :: Parser a -> Parser (Maybe a)
+lookAhead p = Parser $ \s ->
+              case unParser p s of
+                Right (m, _) -> Right (Just m, s)
+                _ -> Right (Nothing, s)
 
-lookAhead p = Parser $ \s@(S bs _) ->
-              case unParser p s of
-                Left (_, msgs) -> Left (bs, msgs)
-                Right (m, _) -> Right (m, s)
-
--- | Run a parser.
-parse :: Parser a -> C.ByteString
-      -> Either ParseError (a, C.ByteString)
-parse p bs = 
-    case unParser p (S bs 0) of
+parseAt :: Parser a -> C.ByteString -> Int64
+        -> Either ParseError (a, C.ByteString)
+parseAt p bs n = 
+    case unParser p (S bs n) of
       Left (bs', msg) -> Left (bs', showError msg)
       Right (a, S bs' _) -> Right (a, bs')
     where
       showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"
       showError msgs = "Parser error, expected one of:\n" ++ unlines msgs
 
+-- | Run a parser.
+parse :: Parser a -> C.ByteString
+      -> Either ParseError (a, C.ByteString)
+parse p bs = parseAt p bs 0
+
 parseTest :: (Show a) => Parser a -> C.ByteString -> IO ()
 parseTest p s =
     case parse p s of
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.