@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
21-----------------------------------------------------------------------------
32-- |
43-- Module : Text.ParserCombinators.ByteStringParser
@@ -9,7 +8,8 @@
98-- Stability : experimental
109-- Portability : unknown
1110--
12−-- Primitive parser combinators for ByteStrings loosely based on Parsec.
11+-- Simple, efficient parser combinators for lazy 'C.ByteString'
12+-- values, loosely based on 'Text.ParserCombinators.Parsec'.
1313--
1414-----------------------------------------------------------------------------
1515module Text.ParserCombinators.ByteStringParser
@@ -20,6 +20,7 @@ module Text.ParserCombinators.ByteStringParser
2020
2121 -- * Running parsers
2222 , parse
23+ , parseAt
2324 , parseTest
2425
2526 -- * Combinators
@@ -35,6 +36,10 @@ module Text.ParserCombinators.ByteStringParser
3536 , eof
3637 , skipMany
3738 , skipMany1
39+ , count
40+ , lookAhead
41+ , sepBy
42+ , sepBy1
3843
3944 -- * Things like in @Parsec.Char@
4045 , satisfy
@@ -44,22 +49,30 @@ module Text.ParserCombinators.ByteStringParser
4449 , space
4550 , char
4651 , string
52+ , stringCI
53+ , byteString
54+ , byteStringCI
4755
4856 -- * Miscellaneous functions.
4957 , getInput
5058 , getConsumed
5159 , takeWhile
60+ , takeWhile1
61+ , takeAll
5262 , skipWhile
63+ , skipSpace
64+ , notEmpty
65+ , match
66+ , inClass
67+ , notInClass
5368 ) where
5469
55−#ifdef APPLICATIVE_IN_BASE
5670import Control.Applicative (Applicative(..))
57−#endif
58−
59−import Control.Monad (MonadPlus(..), ap)
71+import Control.Monad (MonadPlus(..), ap, liftM2)
6072import qualified Data.ByteString.Lazy.Char8 as C
61−import Data.Char (isDigit, isLetter, isSpace)
73+import Data.Char (isDigit, isLetter, isSpace, toLower)
6274import Data.Int (Int64)
75+import qualified Data.Set as S
6376import Prelude hiding (takeWhile)
6477
6578type ParseError = (C.ByteString, String)
@@ -114,6 +127,7 @@ infixr 1 <|>
114127-- | Choice.
115128(<|>) :: Parser a -> Parser a -> Parser a
116129(<|>) = mplus
130+{-# INLINE (<|>) #-}
117131
118132-- | Name the parser.
119133(<?>) :: Parser a -> String -> Parser a
@@ -122,35 +136,31 @@ p <?> msg =
122136 case unParser p s of
123137 (Left _) -> Left (bs, [msg])
124138 ok -> ok
139+{-# INLINE (<?>) #-}
125140
126141-- | Get remaining input.
127142getInput :: Parser C.ByteString
128143getInput = Parser $ \s@(S bs _) -> Right (bs, s)
129144
130−-- | Get remaining input.
145+-- | Get number of bytes consumed so far.
131146getConsumed :: Parser Int64
132147getConsumed = Parser $ \s@(S _ n) -> Right (n, s)
133148
134−
135149-- | Character parser.
136150satisfy :: (Char -> Bool) -> Parser Char
137151satisfy f =
138152 Parser $ \(S bs n) ->
139− if C.null bs
140− then Left (bs, [])
141− else let Just (s, bs') = C.uncons bs in
142− if f s
143− then Right (s, S bs' (n + 1))
144− else Left (bs, [])
153+ case C.uncons bs of
154+ Just (s, bs') | f s -> Right (s, S bs' (n + 1))
155+ _ -> Left (bs, [])
145156{-# INLINE satisfy #-}
146157
147−
148158letter :: Parser Char
149−letter = satisfy isLetter
159+letter = satisfy isLetter <?> "letter"
150160{-# INLINE letter #-}
151161
152162digit :: Parser Char
153−digit = satisfy isDigit
163+digit = satisfy isDigit <?> "digit"
154164{-# INLINE digit #-}
155165
156166anyChar :: Parser Char
@@ -158,19 +168,64 @@ anyChar = satisfy $ const True
158168{-# INLINE anyChar #-}
159169
160170space :: Parser Char
161−space = satisfy isSpace
171+space = satisfy isSpace <?> "space"
162172{-# INLINE space #-}
163173
164174-- | Satisfy a specific character.
165−
166175char :: Char -> Parser Char
167176char c = satisfy (== c) <?> [c]
168177{-# INLINE char #-}
169178
179+charClass :: String -> S.Set Char
180+charClass s = S.fromList (go s)
181+ where go (a:'-':b:xs) = [a..b] ++ go xs
182+ go (x:xs) = x : go xs
183+ go _ = ""
184+
185+inClass :: String -> Char -> Bool
186+inClass s = (`S.member` set)
187+ where set = charClass s
188+
189+notInClass :: String -> Char -> Bool
190+notInClass s = (`S.notMember` set)
191+ where set = charClass s
192+
193+sepBy :: Parser a -> Parser s -> Parser [a]
194+sepBy p s = liftM2 (:) p ((s >> sepBy1 p s) <|> return []) <|> return []
195+
196+sepBy1 :: Parser a -> Parser s -> Parser [a]
197+sepBy1 p s = liftM2 (:) p ((s >> sepBy1 p s) <|> return [])
198+
199+-- | Satisfy a literal string.
200+byteString :: C.ByteString -> Parser C.ByteString
201+byteString s = Parser $ \(S bs n) ->
202+ let l = C.length s
203+ (h, t) = C.splitAt l bs
204+ in if s == h
205+ then Right (s, S t (n + l))
206+ else Left (bs, [])
207+{-# INLINE byteString #-}
208+
209+-- | Satisfy a literal string.
210+byteStringCI :: C.ByteString -> Parser C.ByteString
211+byteStringCI s = Parser $ \(S bs n) ->
212+ let l = C.length s
213+ (h, t) = C.splitAt l bs
214+ in if ls == C.map toLower h
215+ then Right (s, S t (n + l))
216+ else Left (bs, [])
217+ where ls = C.map toLower s
218+{-# INLINE byteStringCI #-}
219+
170220string :: String -> Parser String
171−string s = mapM char s <?> show s
221+string s = byteString (C.pack s) >> return s
172222{-# INLINE string #-}
173223
224+stringCI :: String -> Parser String
225+stringCI s = byteStringCI (C.pack s) >> return s
226+{-# INLINE stringCI #-}
227+
228+-- | Apply the given parser repeatedly, returning every parse result.
174229count :: Int -> Parser a -> Parser [a]
175230count n p = sequence (replicate n p)
176231{-# INLINE count #-}
@@ -187,15 +242,33 @@ eof = Parser $ \s@(S bs _) -> if C.null bs
187242 then Right ((), s)
188243 else Left (bs, ["EOF"])
189244
245+takeAll :: Parser C.ByteString
246+takeAll = Parser $ \(S bs n) -> Right (bs, S C.empty (n + C.length bs))
247+
190248-- | Consume characters while the predicate is true.
191249takeWhile :: (Char -> Bool) -> Parser C.ByteString
192250takeWhile f = Parser $ \(S bs n) ->
193251 let (h, bs') = C.span f bs
194252 in Right (h, S bs' (n + C.length h))
253+{-# INLINE takeWhile #-}
254+
255+takeWhile1 :: (Char -> Bool) -> Parser C.ByteString
256+takeWhile1 f = Parser $ \(S bs n) ->
257+ let (h, bs') = C.span f bs
258+ in if C.null h
259+ then Left (bs, [])
260+ else Right (h, S bs' (n + C.length h))
261+{-# INLINE takeWhile1 #-}
195262
196263-- | Skip over characters while the predicate is true.
197264skipWhile :: (Char -> Bool) -> Parser ()
198265skipWhile p = takeWhile p >> return ()
266+{-# INLINE skipWhile #-}
267+
268+-- | Skip over white space.
269+skipSpace :: Parser ()
270+skipSpace = takeWhile isSpace >> return ()
271+{-# INLINE skipSpace #-}
199272
200273-- | Take zero or more instances of the parser.
201274many :: Parser a -> Parser [a]
@@ -206,24 +279,16 @@ many p = scan id
206279
207280-- | Take one or more instances of the parser.
208281many1 :: Parser a -> Parser [a]
209−many1 p =
210− do x <- p
211− xs <- many p
212− return (x:xs)
282+many1 p = liftM2 (:) p (many p)
213283
214284manyTill :: Parser a -> Parser b -> Parser [a]
215285manyTill p end = scan
216− where scan = do end; return []
217− <|>
218− do x <- p
219− xs <- scan
220− return (x:xs)
286+ where scan = (end >> return []) <|> liftM2 (:) p scan
221287
222288-- |'skipMany' - skip zero or many instances of the parser
223289skipMany :: Parser a -> Parser ()
224290skipMany p = scan
225− where
226− scan = (p >> scan) <|> return ()
291+ where scan = (p >> scan) <|> return ()
227292
228293-- |'skipMany1' - skip one or many instances of the parser
229294skipMany1 :: Parser a -> Parser ()
@@ -248,24 +313,27 @@ match p = do bs <- getInput
248313 end <- getConsumed
249314 return (C.take (end - start) bs)
250315
251−lookAhead :: Parser a -> Parser a
252−
253−lookAhead p = Parser $ \s@(S bs _) ->
316+lookAhead :: Parser a -> Parser (Maybe a)
317+lookAhead p = Parser $ \s ->
254318 case unParser p s of
255− Left (_, msgs) -> Left (bs, msgs)
256− Right (m, _) -> Right (m, s)
319+ Right (m, _) -> Right (Just m, s)
320+ _ -> Right (Nothing, s)
257321
258−-- | Run a parser.
259−parse :: Parser a -> C.ByteString
260− -> Either ParseError (a, C.ByteString)
261−parse p bs =
262− case unParser p (S bs 0) of
322+parseAt :: Parser a -> C.ByteString -> Int64
323+ -> Either ParseError (a, C.ByteString)
324+parseAt p bs n =
325+ case unParser p (S bs n) of
263326 Left (bs', msg) -> Left (bs', showError msg)
264327 Right (a, S bs' _) -> Right (a, bs')
265328 where
266329 showError [msg] = "Parser error, expected:\n" ++ msg ++ "\n"
267330 showError msgs = "Parser error, expected one of:\n" ++ unlines msgs
268331
332+-- | Run a parser.
333+parse :: Parser a -> C.ByteString
334+ -> Either ParseError (a, C.ByteString)
335+parse p bs = parseAt p bs 0
336+
269337parseTest :: (Show a) => Parser a -> C.ByteString -> IO ()
270338parseTest p s =
271339 case parse p s of