ソースを参照

Linted and removed redundant functions

Marcos Dumay de Medeiros 8 年 前
コミット
c93f479408
1 ファイル変更16 行追加42 行削除
  1. 16 42
      src/Data/Attoparsec/ByteString/Char8/Extras.hs

+ 16 - 42
src/Data/Attoparsec/ByteString/Char8/Extras.hs

@@ -11,9 +11,7 @@ module Data.Attoparsec.ByteString.Char8.Extras (
   parseEnum,
   parseEnumCI,
   -- * Other parsing utilities
-  failParser,
   decodeBase64,
-  parserList,
   parserFold,
   quotedString
   ) where
@@ -33,7 +31,7 @@ utf8bs = BS.pack . UTF8.encode
 
 -- | A version of attoparsec's isHorizontalSpace that takes a Char as argument.
 isCHorizontalSpace :: Char -> Bool
-isCHorizontalSpace c = A.isHorizontalSpace . asW8 $ c
+isCHorizontalSpace = A.isHorizontalSpace . asW8
 
 -- | Skips through the characters that satisfy attoparsec's isHorizontalSpace.
 --   Never fails.
@@ -44,17 +42,13 @@ skipHorizontalSpace = A.skipWhile (A.isHorizontalSpace . asW8)
 asW8 :: Char -> Word8
 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
 
 Acquires functions by parsing the data with f, and applies it to the result of the previous function,
  until f fails.
 -}
-parserFold :: (Parser (a -> a)) -> a -> Parser a
+parserFold :: Parser (a -> a) -> a -> Parser a
 parserFold f a = (
   do
     r <- f
@@ -62,53 +56,33 @@ parserFold f a = (
     parserFold f 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.
 
 Does not consume input on the case of failure.
 -}
 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.
 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
 printed like the input.
 -}
 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
 
 -- | Like parsePrintable, but case insensitive
 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
 
 -- | Acts like parseShow, trying every possible value
@@ -127,8 +101,8 @@ parseEnumCI = let
 decodeBase64 :: Parser ByteString
 decodeBase64 = do
   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
   where
     isBase64Char :: Char -> Bool
@@ -154,13 +128,13 @@ quotedString e fp fq = A.scan [] quoteScanner
   where
     quoteScanner :: [QuoteScannerState] -> Char -> Maybe [QuoteScannerState]
     quoteScanner [] c
-      | elem c "'\"" = Just [Quote]
+      | c `elem` "'\"" = Just [Quote]
       | c == e = Just [Escape]
-      | elem c fp = Nothing
+      | c `elem` fp = Nothing
       | otherwise = Just []
     quoteScanner fs@(Quote:ss) c
-      | elem c "'\"" = Just ss
+      | c `elem` "'\"" = Just ss
       | c == e = Just (Escape:fs)
-      | elem c fq = Nothing
+      | c `elem` fq = Nothing
       | otherwise = Just fs
     quoteScanner (Escape:ss) _ = Just ss