diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for config-parser +## 1.2.0.0 -- 2018-1-20 + +* Fixed incorrect parsing error when invalid key appeared at beginning of file. +* Added `keyIdentifier` field to `ConfigParser` to facilitate more accurate + invalid-key messages. + ## 1.1.0.1 -- 2018-1-20 * Fixed some unexpected parsing behavior w/r/t line-ends. diff --git a/Text/ConfigParser/Parser.hs b/Text/ConfigParser/Parser.hs --- a/Text/ConfigParser/Parser.hs +++ b/Text/ConfigParser/Parser.hs @@ -101,12 +101,11 @@ where whitespace = void . many $ oneOf " \t\v\r" :: Parser () line = many $ noneOf "\n\r" :: Parser String - identifier = many1 $ noneOf "\n\r\t\v =" :: Parser String requiredKeys = fmap key . filter required $ options p optionKeysUniq = length (nub $ key <$> options p) == length (options p) - maybeP parser = Just <$> try parser <|> Nothing <$ try identifier + maybeP parser = Just <$> try parser <|> Nothing <$ try line optionParsers = choice $ try . keyActionP <$> options p - dummyActionP = (Nothing,Nothing) <$ keyValue p identifier (try line) + dummyActionP = (Nothing,Nothing) <$ keyValue p (keyIdentifier p) (try line) configLineP = (optionParsers <|> try dummyActionP) <* whitespace <* (void newline <|> eof) keyActionP o = (Just o,) <$> mbActionParser o actionParser ConfigOption {..} = keyValue p (P.string key) $ action <$> parser @@ -119,7 +118,7 @@ case mbo of -- Key is bad Nothing -> do - k <- lookAhead identifier + k <- keyIdentifier p unexpected $ "unknown key " ++ show k -- Key is good Just o@(ConfigOption {..}) -> do diff --git a/Text/ConfigParser/Types.hs b/Text/ConfigParser/Types.hs --- a/Text/ConfigParser/Types.hs +++ b/Text/ConfigParser/Types.hs @@ -3,7 +3,8 @@ {-# OPTIONS_HADDOCK hide #-} module Text.ConfigParser.Types where -import Text.Parsec (spaces, char) +import Text.Parsec (spaces, char, many1) +import Text.Parsec.Char (noneOf) import Text.Parsec.Text (Parser) type Key = String @@ -27,12 +28,20 @@ data ConfigParser c = ConfigParser { keyValue :: forall a. Parser Key -> Parser a -> Parser a -- ^ Specifies how a key and a value parser should be represented in the - -- config file, e.g., @key = value@, or @key: value@. + -- config file, e.g., @key = value@, or @key: value@. The first parameter + -- will be either be @Text.Parsec.string (key (co::ConfigOption c))@ or + -- @keyIdentifier@. The second parameter will be + -- @parser (co::ConfigOption c)@. , lineCommentInit :: [String] -- ^ 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 @\\--@. + , keyIdentifier :: Parser Key + -- ^ This is the general form of an identifier to be passed as the first + -- parameter of @keyValue@. Having a general form allows us to correctly + -- detect invalid (e.g., typoed) keys. For example, the @keyIdentifier@ + -- corresponding to @defaultKeyValue@ is @many1 (noneOf "\\r\\v\\n\\t =")@. , defaults :: c -- ^ Initial @c@ to fold each 'ConfigOption' action over. , options :: [ConfigOption c] @@ -43,7 +52,12 @@ -- | Smart constructor for a 'ConfigParser' that uses a default syntax like -- @key = value@ and line comments starting with @#@. configParser :: c -> [ConfigOption c] -> ConfigParser c -configParser = ConfigParser defaultKeyValue defaultLineCommentInit +configParser = + ConfigParser defaultKeyValue defaultLineCommentInit defaultKeyIdentifier + +-- | The @keyIdentifier@ corresponding to @defaultKeyValue@. +defaultKeyIdentifier :: Parser Key +defaultKeyIdentifier = many1 $ noneOf "\n\t\r\v =" -- | Default syntax like @key = value@. defaultKeyValue :: Parser Key -> Parser a -> Parser a 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.1 +version: 1.2.0.0 synopsis: Parse config files using parsec and generate parse errors on unhandled keys description: This is yet another entry in Haskell's enourmous collection diff --git a/tests/Parsing.hs b/tests/Parsing.hs --- a/tests/Parsing.hs +++ b/tests/Parsing.hs @@ -5,14 +5,15 @@ import Prelude hiding (unlines) -import Control.Lens +import Control.Lens hiding (noneOf) import Data.Int (Int8) import Data.List.Extra (isInfixOf) import Data.Text (unlines) import Data.Word (Word8, Word16) import Test.Hspec import Text.Parsec (ParseError, errorPos, sourceLine, sourceColumn) -import Text.Parsec (parse, eof, getInput, spaces) +import Text.Parsec (parse, eof, getInput, spaces, many1) +import Text.Parsec.Char (noneOf) import Text.Parsec.Text (Parser) import qualified Text.Parsec as P (string) @@ -98,10 +99,11 @@ reqcp = configParser defC [co1,co2,co3,co4,co5,co6,co7,co8] badcp = configParser defC [co1,co2,co2,co4,co5,co6,co7] cp = configParser defC [co1,co2,co3,co4,co5,co6,co7] -cp' = ConfigParser lp lcs defC [co1,co2,co3,co4,co5,co6,co7] +cp' = ConfigParser lp lcs kid defC [co1,co2,co3,co4,co5,co6,co7] where lp :: Parser Key -> Parser a -> Parser a lp k q = q <* spaces <* P.string "->" <* spaces <* k + kid = many1 (noneOf "\n\r") lcs = ["--","//"] shouldFailOnLine :: Show a => Either ParseError a -> Int -> Expectation @@ -638,7 +640,7 @@ , _f4 = ["foo","bar"] , _f5 = [1,2,3,4,5] } - it "parses an multiple comment syntaxes" $ + it "parses multiple comment syntaxes" $ parseFromText cp' "test" (unlines [ "\"foo\" -> f1" , "9001 -> f2" @@ -659,6 +661,26 @@ Right _ -> False Left e -> sourceLine (errorPos e) == 1 && "non-unique keys in ConfigParser" `isInfixOf` show e + it "errors appropriately when delimiter is missing in middle of file" $ + parseFromText cp "test" "f1 \nf2 = 9001" `shouldSatisfy` \res -> case res of + Right _ -> False + Left _ -> True + it "errors appropriately when delimiter is missing at end of file" $ + parseFromText cp "test" "f1 " `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 4 + && "\"=\"" `isInfixOf` show e + it "errors appropriately when value is missing in middle of file" $ + parseFromText cp "test" "f1 = \nf2 = 9001" `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> "string in quotes" `isInfixOf` show e + it "errors appropriately when value is missing at end of file" $ + parseFromText cp "test" "f1 = " `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 6 + && "string in quotes" `isInfixOf` show e it "errors appropriately when full value can't be parsed in middle of file" $ parseFromText cp "test" (unlines [ "f2 = 9001foo" @@ -694,18 +716,64 @@ Right _ -> False Left e -> sourceLine (errorPos e) == 1 && "missing required keys: \"f8\"" `isInfixOf` show e - it "errors on non-existent keys with a pertinent message" $ + it "errors on non-existent key alone with a pertinent message" $ + parseFromText cp "test" "badkey = 9999" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 7 + && "unknown key \"badkey\"" `isInfixOf` show e + it "errors on non-existent key with initial spaces with a pertinent message" $ + parseFromText cp "test" " \r\t\vbadkey = 9999" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && "unknown key \"badkey\"" `isInfixOf` show e + it "errors on non-existent key with final spaces with a pertinent message" $ + parseFromText cp "test" "badkey = 9999 \r\t\v" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 7 + && "unknown key \"badkey\"" `isInfixOf` show e + it "errors on non-existent keys at start of input with a pertinent message" $ parseFromText cp "test" (unlines + [ "badkey = 9999" + , "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True " + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && sourceColumn (errorPos e) == 7 + && "unknown key \"badkey\"" `isInfixOf` show e + it "errors on non-existent keys in middle of input with a pertinent message" $ + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True " + , "badkey = 9999" , "f4 = [\"foo\",\"bar\"]" , "f5 = [1,2,3,4,5]" + ]) `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 4 + && sourceColumn (errorPos e) == 7 + && "unknown key \"badkey\"" `isInfixOf` show e + it "errors on non-existent keys at end of input with a pertinent message" $ + parseFromText cp "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True " + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" , "badkey = 9999" ]) `shouldSatisfy` \res -> case res of Right _ -> False Left e -> sourceLine (errorPos e) == 6 - && sourceColumn (errorPos e) == 1 + && sourceColumn (errorPos e) == 7 && "unknown key \"badkey\"" `isInfixOf` show e it "errors on duplicate keys in config file with a pertinent message" $ parseFromText cp "test" (unlines