@@ -40,14 +40,11 @@ module Data.ParserCombinators.ByteStringParser.Internal
4040
4141 -- * Things like in @Parsec.Char@
4242 , satisfy
43− , letter
44− , digit
4543 , anyChar
46− , space
4744 , char
4845 , notChar
4946 , string
50− , stringCI
47+ , stringTransform
5148
5249 -- * Parser converters.
5350 , eitherP
@@ -60,24 +57,19 @@ module Data.ParserCombinators.ByteStringParser.Internal
6057 , takeTill
6158 , takeAll
6259 , skipWhile
63− , skipSpace
6460 , notEmpty
6561 , match
66− , inClass
67− , notInClass
6862 ) where
6963
7064import Control.Applicative
7165 (Alternative(..), Applicative(..), (<$>), (<*), (*>))
7266import Control.Monad (MonadPlus(..), ap, liftM2)
7367import Control.Monad.Fix (MonadFix(..))
74−import qualified Data.ByteString.Char8 as SB
75−import qualified Data.ByteString.Lazy.Char8 as LB
68+import qualified Data.ByteString as SB
69+import qualified Data.ByteString.Lazy as LB
7670import qualified Data.ByteString.Lazy.Internal as LB
77−import Data.Char (isDigit, isLetter, isSpace, toLower)
7871import Data.Int (Int64)
79−import Data.ParserCombinators.ByteStringParser.FastSet
80− (FastSet, memberChar, set)
72+import Data.Word (Word8)
8173import Prelude hiding (takeWhile)
8274
8375type ParseError = String
@@ -177,7 +169,7 @@ getConsumed :: Parser Int64
177169getConsumed = Parser $ \s@(S _ _ n) -> Right (n, s)
178170
179171-- | Character parser.
180−satisfy :: (Char -> Bool) -> Parser Char
172+satisfy :: (Word8 -> Bool) -> Parser Word8
181173satisfy p =
182174 Parser $ \s@(S sb lb n) ->
183175 case SB.uncons sb of
@@ -186,47 +178,20 @@ satisfy p =
186178 Nothing -> unParser (nextChunk >> satisfy p) s
187179{-# INLINE satisfy #-}
188180
189−letter :: Parser Char
190−letter = satisfy isLetter <?> "letter"
191−{-# INLINE letter #-}
192−
193−digit :: Parser Char
194−digit = satisfy isDigit <?> "digit"
195−{-# INLINE digit #-}
196−
197−anyChar :: Parser Char
181+anyChar :: Parser Word8
198182anyChar = satisfy $ const True
199183{-# INLINE anyChar #-}
200184
201−space :: Parser Char
202−space = satisfy isSpace <?> "space"
203−{-# INLINE space #-}
204−
205185-- | Satisfy a specific character.
206−char :: Char -> Parser Char
207−char c = satisfy (== c) <?> [c]
186+char :: Word8 -> Parser Word8
187+char c = satisfy (== c) <?> show c
208188{-# INLINE char #-}
209189
210190-- | Satisfy a specific character.
211−notChar :: Char -> Parser Char
212−notChar c = satisfy (/= c) <?> "not " ++ [c]
191+notChar :: Word8 -> Parser Word8
192+notChar c = satisfy (/= c) <?> "not " ++ show c
213193{-# INLINE notChar #-}
214194
215−charClass :: String -> FastSet
216−charClass = set . SB.pack . go
217− where go (a:'-':b:xs) = [a..b] ++ go xs
218− go (x:xs) = x : go xs
219− go _ = ""
220−
221−inClass :: String -> Char -> Bool
222−inClass s = (`memberChar` myset)
223− where myset = charClass s
224−{-# INLINE inClass #-}
225−
226−notInClass :: String -> Char -> Bool
227−notInClass s = not . inClass s
228−{-# INLINE notInClass #-}
229−
230195sepBy :: Parser a -> Parser s -> Parser [a]
231196sepBy p s = liftM2 (:) p ((s >> sepBy1 p s) <|> return []) <|> return []
232197
@@ -244,17 +209,19 @@ string s = Parser $ \(S sb lb n) ->
244209 else Left (bs, [])
245210{-# INLINE string #-}
246211
247−-- | Satisfy a literal string, ignoring case.
248−stringCI :: LB.ByteString -> Parser LB.ByteString
249−stringCI s = Parser $ \(S sb lb n) ->
212+-- | Satisfy a literal string, after applying a transformation to both
213+-- it and the matching text.
214+stringTransform :: (LB.ByteString -> LB.ByteString) -> LB.ByteString
215+ -> Parser LB.ByteString
216+stringTransform f s = Parser $ \(S sb lb n) ->
250217 let bs = sb +: lb
251218 l = LB.length s
252219 (h, t) = LB.splitAt l bs
253− in if ls == LB.map toLower h
220+ in if fs == f h
254221 then Right (s, mkState t (n + l))
255222 else Left (bs, [])
256− where ls = LB.map toLower s
257−{-# INLINE stringCI #-}
223+ where fs = f s
224+{-# INLINE stringTransform #-}
258225
259226-- | Apply the given parser repeatedly, returning every parse result.
260227count :: Int -> Parser a -> Parser [a]
@@ -285,7 +252,7 @@ length64 :: SB.ByteString -> Int64
285252length64 = fromIntegral . SB.length
286253
287254-- | Consume characters while the predicate is true.
288−takeWhile :: (Char -> Bool) -> Parser LB.ByteString
255+takeWhile :: (Word8 -> Bool) -> Parser LB.ByteString
289256takeWhile p = Parser $ \s@(S sb lb n) ->
290257 let (h, t) = SB.span p sb
291258 in if SB.null t
@@ -293,11 +260,11 @@ takeWhile p = Parser $ \s@(S sb lb n) ->
293260 else Right (oneChunk h, S t lb (n + length64 h))
294261{-# INLINE takeWhile #-}
295262
296−takeTill :: (Char -> Bool) -> Parser LB.ByteString
263+takeTill :: (Word8 -> Bool) -> Parser LB.ByteString
297264takeTill p = takeWhile (not . p) <* satisfy p
298265{-# INLINE takeTill #-}
299266
300−takeWhile1 :: (Char -> Bool) -> Parser LB.ByteString
267+takeWhile1 :: (Word8 -> Bool) -> Parser LB.ByteString
301268takeWhile1 p = Parser $ \s@(S sb lb n) ->
302269 let (h, t) = SB.span p sb
303270 in if SB.null t
@@ -312,15 +279,10 @@ takeWhile1 p = Parser $ \s@(S sb lb n) ->
312279{-# INLINE takeWhile1 #-}
313280
314281-- | Skip over characters while the predicate is true.
315−skipWhile :: (Char -> Bool) -> Parser ()
282+skipWhile :: (Word8 -> Bool) -> Parser ()
316283skipWhile p = takeWhile p >> return ()
317284{-# INLINE skipWhile #-}
318285
319−-- | Skip over white space.
320−skipSpace :: Parser ()
321−skipSpace = takeWhile isSpace >> return ()
322−{-# INLINE skipSpace #-}
323−
324286manyTill :: Parser a -> Parser b -> Parser [a]
325287manyTill p end = scan
326288 where scan = (end >> return []) <|> liftM2 (:) p scan