|
@@ -11,9 +11,7 @@ module Data.Attoparsec.ByteString.Char8.Extras (
|
|
parseEnum,
|
|
parseEnum,
|
|
parseEnumCI,
|
|
parseEnumCI,
|
|
-- * Other parsing utilities
|
|
-- * Other parsing utilities
|
|
- failParser,
|
|
|
|
decodeBase64,
|
|
decodeBase64,
|
|
- parserList,
|
|
|
|
parserFold,
|
|
parserFold,
|
|
quotedString
|
|
quotedString
|
|
) where
|
|
) where
|
|
@@ -33,7 +31,7 @@ utf8bs = BS.pack . UTF8.encode
|
|
|
|
|
|
-- | A version of attoparsec's isHorizontalSpace that takes a Char as argument.
|
|
-- | A version of attoparsec's isHorizontalSpace that takes a Char as argument.
|
|
isCHorizontalSpace :: Char -> Bool
|
|
isCHorizontalSpace :: Char -> Bool
|
|
-isCHorizontalSpace c = A.isHorizontalSpace . asW8 $ c
|
|
|
|
|
|
+isCHorizontalSpace = A.isHorizontalSpace . asW8
|
|
|
|
|
|
-- | Skips through the characters that satisfy attoparsec's isHorizontalSpace.
|
|
-- | Skips through the characters that satisfy attoparsec's isHorizontalSpace.
|
|
-- Never fails.
|
|
-- Never fails.
|
|
@@ -44,17 +42,13 @@ skipHorizontalSpace = A.skipWhile (A.isHorizontalSpace . asW8)
|
|
asW8 :: Char -> Word8
|
|
asW8 :: Char -> Word8
|
|
asW8 = fromIntegral . C.ord
|
|
asW8 = fromIntegral . C.ord
|
|
|
|
|
|
--- | Makes a parser fail.
|
|
|
|
-failParser :: Parser a
|
|
|
|
-failParser = satisfy (\_ -> False) *> (return . error $ "Passed a parser that must always fail")
|
|
|
|
-
|
|
|
|
{- |
|
|
{- |
|
|
parserFold f x0
|
|
parserFold f x0
|
|
|
|
|
|
Acquires functions by parsing the data with f, and applies it to the result of the previous function,
|
|
Acquires functions by parsing the data with f, and applies it to the result of the previous function,
|
|
until f fails.
|
|
until f fails.
|
|
-}
|
|
-}
|
|
-parserFold :: (Parser (a -> a)) -> a -> Parser a
|
|
|
|
|
|
+parserFold :: Parser (a -> a) -> a -> Parser a
|
|
parserFold f a = (
|
|
parserFold f a = (
|
|
do
|
|
do
|
|
r <- f
|
|
r <- f
|
|
@@ -62,53 +56,33 @@ parserFold f a = (
|
|
parserFold f a'
|
|
parserFold f a'
|
|
) <|> return a
|
|
) <|> return a
|
|
|
|
|
|
-{- |
|
|
|
|
-parserList parsers x0
|
|
|
|
-
|
|
|
|
-Applies the parsers in order, taking as parameter the returned value of
|
|
|
|
-the previous parser, starting with x0.
|
|
|
|
-
|
|
|
|
-That is, for example:
|
|
|
|
-
|
|
|
|
-parserList [p0, p1, p2] x0
|
|
|
|
-
|
|
|
|
-Will do:
|
|
|
|
- x1 <- p0 x0
|
|
|
|
- x2 <- p1 x1
|
|
|
|
- x3 <- p2 x2
|
|
|
|
- return x3
|
|
|
|
--}
|
|
|
|
-parserList :: [(b -> Parser b)] -> b -> Parser b
|
|
|
|
-parserList [] e0 = return e0
|
|
|
|
-parserList (f:ff) e0 = do
|
|
|
|
- e1 <- f e0
|
|
|
|
- parserList ff e1
|
|
|
|
-
|
|
|
|
{- |
|
|
{- |
|
|
Given a list of options, returns the first one that is show like the input.
|
|
Given a list of options, returns the first one that is show like the input.
|
|
|
|
|
|
Does not consume input on the case of failure.
|
|
Does not consume input on the case of failure.
|
|
-}
|
|
-}
|
|
parseShow :: Show a => [a] -> Parser a
|
|
parseShow :: Show a => [a] -> Parser a
|
|
-parseShow [] = failParser
|
|
|
|
-parseShow (s:ss) = ((string . utf8bs . show $ s) *> return s) <|> parseShow ss
|
|
|
|
|
|
+parseShow = foldr
|
|
|
|
+ (\ s -> (<|>) ((string . utf8bs . show $ s) *> return s))
|
|
|
|
+ (fail "Invalid string")
|
|
|
|
|
|
-- | Like parseShow, but case insensitive.
|
|
-- | Like parseShow, but case insensitive.
|
|
parseShowCI :: Show a => [a] -> Parser a
|
|
parseShowCI :: Show a => [a] -> Parser a
|
|
-parseShowCI [] = failParser
|
|
|
|
-parseShowCI (s:ss) = ((A.stringCI . utf8bs . show $ s) *> return s) <|> parseShowCI ss
|
|
|
|
|
|
+parseShowCI = foldr
|
|
|
|
+ (\ s -> (<|>) ((A.stringCI . utf8bs . show $ s) *> return s))
|
|
|
|
+ (fail "Invalid string")
|
|
|
|
|
|
{- |
|
|
{- |
|
|
Given a list of options and a printing function, returns the first option that is
|
|
Given a list of options and a printing function, returns the first option that is
|
|
printed like the input.
|
|
printed like the input.
|
|
-}
|
|
-}
|
|
parsePrintable :: (a -> String) -> [a] -> Parser a
|
|
parsePrintable :: (a -> String) -> [a] -> Parser a
|
|
-parsePrintable _ [] = failParser
|
|
|
|
|
|
+parsePrintable _ [] = fail "Invalid string"
|
|
parsePrintable f (s:ss) = ((string . utf8bs . f $ s) *> return s) <|> parsePrintable f ss
|
|
parsePrintable f (s:ss) = ((string . utf8bs . f $ s) *> return s) <|> parsePrintable f ss
|
|
|
|
|
|
-- | Like parsePrintable, but case insensitive
|
|
-- | Like parsePrintable, but case insensitive
|
|
parsePrintableCI :: (a -> String) -> [a] -> Parser a
|
|
parsePrintableCI :: (a -> String) -> [a] -> Parser a
|
|
-parsePrintableCI _ [] = failParser
|
|
|
|
|
|
+parsePrintableCI _ [] = fail "Invalid string"
|
|
parsePrintableCI f (s:ss) = ((A.stringCI . utf8bs . f $ s) *> return s) <|> parsePrintableCI f ss
|
|
parsePrintableCI f (s:ss) = ((A.stringCI . utf8bs . f $ s) *> return s) <|> parsePrintableCI f ss
|
|
|
|
|
|
-- | Acts like parseShow, trying every possible value
|
|
-- | Acts like parseShow, trying every possible value
|
|
@@ -127,8 +101,8 @@ parseEnumCI = let
|
|
decodeBase64 :: Parser ByteString
|
|
decodeBase64 :: Parser ByteString
|
|
decodeBase64 = do
|
|
decodeBase64 = do
|
|
b64 <- A.takeWhile isBase64Char
|
|
b64 <- A.takeWhile isBase64Char
|
|
- case B64.decode $ b64 of
|
|
|
|
- Left _ -> failParser
|
|
|
|
|
|
+ case B64.decode b64 of
|
|
|
|
+ Left _ -> fail "Invalid base64 character sequence"
|
|
Right v -> return v
|
|
Right v -> return v
|
|
where
|
|
where
|
|
isBase64Char :: Char -> Bool
|
|
isBase64Char :: Char -> Bool
|
|
@@ -154,13 +128,13 @@ quotedString e fp fq = A.scan [] quoteScanner
|
|
where
|
|
where
|
|
quoteScanner :: [QuoteScannerState] -> Char -> Maybe [QuoteScannerState]
|
|
quoteScanner :: [QuoteScannerState] -> Char -> Maybe [QuoteScannerState]
|
|
quoteScanner [] c
|
|
quoteScanner [] c
|
|
- | elem c "'\"" = Just [Quote]
|
|
|
|
|
|
+ | c `elem` "'\"" = Just [Quote]
|
|
| c == e = Just [Escape]
|
|
| c == e = Just [Escape]
|
|
- | elem c fp = Nothing
|
|
|
|
|
|
+ | c `elem` fp = Nothing
|
|
| otherwise = Just []
|
|
| otherwise = Just []
|
|
quoteScanner fs@(Quote:ss) c
|
|
quoteScanner fs@(Quote:ss) c
|
|
- | elem c "'\"" = Just ss
|
|
|
|
|
|
+ | c `elem` "'\"" = Just ss
|
|
| c == e = Just (Escape:fs)
|
|
| c == e = Just (Escape:fs)
|
|
- | elem c fq = Nothing
|
|
|
|
|
|
+ | c `elem` fq = Nothing
|
|
| otherwise = Just fs
|
|
| otherwise = Just fs
|
|
quoteScanner (Escape:ss) _ = Just ss
|
|
quoteScanner (Escape:ss) _ = Just ss
|