diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for config-parser +## 1.1.0.1 -- 2018-1-20 + +* Fixed some unexpected parsing behavior w/r/t line-ends. +* Made bounded parser fail before consuming input so descriptive expectation is + shown in error message. + ## 1.1.0.0 -- 2018-1-19 * Made parsing errors significantly more informative. diff --git a/Text/ConfigParser/Parser.hs b/Text/ConfigParser/Parser.hs --- a/Text/ConfigParser/Parser.hs +++ b/Text/ConfigParser/Parser.hs @@ -40,9 +40,10 @@ -- | Parse a bounded integer. Fail to parse with a descriptive message if the -- value is out of bounds. boundedIntegral :: forall n. (Show n, Bounded n, Integral n) => Parser n -boundedIntegral = bound =<< integer - "integer between " ++ show intMin ++ " and " ++ show intMax +boundedIntegral = try bounded + "integer between " ++ show intMin ++ " and " ++ show intMax where + bounded = bound =<< integer intMin = minBound :: n intMax = maxBound :: n bound n | n > fromIntegral intMax = unexpected $ "integer above " ++ show intMax @@ -106,7 +107,7 @@ maybeP parser = Just <$> try parser <|> Nothing <$ try identifier optionParsers = choice $ try . keyActionP <$> options p dummyActionP = (Nothing,Nothing) <$ keyValue p identifier (try line) - configLineP = optionParsers <|> dummyActionP <|> parserFail "Parsing failed" + configLineP = (optionParsers <|> try dummyActionP) <* whitespace <* (void newline <|> eof) keyActionP o = (Just o,) <$> mbActionParser o actionParser ConfigOption {..} = keyValue p (P.string key) $ action <$> parser mbActionParser ConfigOption {..} = keyValue p (P.string key) . maybeP $ action <$> parser @@ -114,12 +115,12 @@ go' ks c = (ks,c) <$ eof -- End of document <|> newline *> go ks c -- Empty line <|> do -- Config line - (mbo,mbv) <- lookAhead configLineP + (mbo,mbv) <- lookAhead configLineP <|> parserFail "Parsing failed" case mbo of -- Key is bad Nothing -> do - k <- identifier - unexpected $ "key " ++ show k + k <- lookAhead identifier + unexpected $ "unknown key " ++ show k -- Key is good Just o@(ConfigOption {..}) -> do when (key `elem` ks) $ unexpected ("duplicate key " ++ show key) diff --git a/Text/ConfigParser/Types.hs b/Text/ConfigParser/Types.hs --- a/Text/ConfigParser/Types.hs +++ b/Text/ConfigParser/Types.hs @@ -32,9 +32,9 @@ -- ^ Strings to start a line comment, such as @#@, @--@, or @//@. All -- characters following this string up to the following newline or EOF -- will be removed. You can use the string without starting a comment by - -- escaping it with a backslash, e.g. @\#@ or @\--@. + -- escaping it with a backslash, e.g. @\\#@ or @\\--@. , defaults :: c - -- ^ Initial @c@ to fold each 'ConfigOption's action over. + -- ^ Initial @c@ to fold each 'ConfigOption' action over. , options :: [ConfigOption c] -- ^ List of key-value pairs to parse from the config file. Any key in the -- config file that doesn't appear here will result in parse error. diff --git a/config-parser.cabal b/config-parser.cabal --- a/config-parser.cabal +++ b/config-parser.cabal @@ -1,5 +1,5 @@ name: config-parser -version: 1.1.0.0 +version: 1.1.0.1 synopsis: Parse config files using parsec and generate parse errors on unhandled keys description: This is yet another entry in Haskell's enourmous collection @@ -43,9 +43,9 @@ other-extensions: ExistentialQuantification, RankNTypes, RecordWildCards - build-depends: base >=4.9 && <4.10, + build-depends: base >=4.9 && <4.11, parsec >=3.1 && <3.2, - text >=1.2 && <1.3 + text >=1.2 && <1.3 -- hs-source-dirs: default-language: Haskell2010 @@ -58,7 +58,7 @@ type: exitcode-stdio-1.0 main-is: tests/Parsing.hs default-language: Haskell2010 - build-depends: base >=4.9 && <4.10, + build-depends: base >=4.9 && <4.11, extra >=1.5 && <1.7, hspec >=2.4 && <2.5, lens >=4.15 && <4.16, diff --git a/tests/Parsing.hs b/tests/Parsing.hs --- a/tests/Parsing.hs +++ b/tests/Parsing.hs @@ -9,10 +9,10 @@ import Data.Int (Int8) import Data.List.Extra (isInfixOf) import Data.Text (unlines) -import Data.Word (Word8) +import Data.Word (Word8, Word16) import Test.Hspec -import Text.Parsec (ParseError) -import Text.Parsec (parse, errorPos, sourceLine, eof, getInput, spaces) +import Text.Parsec (ParseError, errorPos, sourceLine, sourceColumn) +import Text.Parsec (parse, eof, getInput, spaces) import Text.Parsec.Text (Parser) import qualified Text.Parsec as P (string) @@ -21,7 +21,7 @@ data C = C { _f1 :: String - , _f2 :: Integer + , _f2 :: Word16 , _f3 :: Bool , _f4 :: [String] , _f5 :: [Integer] @@ -55,7 +55,7 @@ { key = "f2" , required = False , action = set' f2 - , parser = integer + , parser = boundedIntegral } co3 = ConfigOption { key = "f3" @@ -658,13 +658,42 @@ `shouldSatisfy` \res -> case res of Right _ -> False Left e -> sourceLine (errorPos e) == 1 - && "non-unique keys in ConfigParser" `elem` lines (show e) + && "non-unique keys in ConfigParser" `isInfixOf` show e + it "errors appropriately when full value can't be parsed in middle of file" $ + parseFromText cp "test" (unlines + [ "f2 = 9001foo" + , "f3 = True" + ]) `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 10 + it "errors appropriately when full value can't be parsed at end of file" $ + parseFromText cp "test" (unlines + [ "f1 = \"blah\"" + , "f2 = 9001foo" + ]) `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 2 + && sourceColumn (errorPos e) == 10 + it "errors appropriately when options aren't separated by a newline" $ + parseFromText cp "test" "f1 = \"blah\"f2 = 9001" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 12 + it "errors with a pertinent message when bounded integer is out of bounds" $ + parseFromText reqcp "test" "f2 = 65536" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && "integer above 65535" `isInfixOf` show e + && "integer between 0 and 65535" `isInfixOf` show e it "errors with a pertinent message when required key is omitted" $ parseFromText reqcp "test" "f1 = \"foo\"" `shouldSatisfy` \res -> case res of Right _ -> False Left e -> sourceLine (errorPos e) == 1 - && "missing required keys: \"f8\"" `elem` lines (show e) + && "missing required keys: \"f8\"" `isInfixOf` show e it "errors on non-existent keys with a pertinent message" $ parseFromText cp "test" (unlines [ "f1 = \"foo\"" @@ -675,13 +704,15 @@ , "badkey = 9999" ]) `shouldSatisfy` \res -> case res of Right _ -> False - Left e -> sourceLine (errorPos e) == 6 - && "unexpected key \"badkey\"" `isInfixOf` show e + Left e -> sourceLine (errorPos e) == 6 + && sourceColumn (errorPos e) == 1 + && "unknown key \"badkey\"" `isInfixOf` show e it "errors on duplicate keys in config file with a pertinent message" $ parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f1 = \"bar\"" ]) `shouldSatisfy` \res -> case res of Right _ -> False - Left e -> sourceLine (errorPos e) == 2 + Left e -> sourceLine (errorPos e) == 2 + && sourceColumn (errorPos e) == 1 && "duplicate key \"f1\"" `isInfixOf` show e