config-parser 1.0.0.0 → 1.1.0.0
raw patch · 6 files changed
+85/−174 lines, 6 filesdep +extra
Dependencies added: extra
Files
- ChangeLog.md +7/−0
- Text/ConfigParser.hs +5/−11
- Text/ConfigParser/Parser.hs +49/−53
- Text/ConfigParser/Types.hs +9/−9
- config-parser.cabal +2/−1
- tests/Parsing.hs +13/−100
ChangeLog.md view
@@ -1,5 +1,12 @@ # Revision history for config-parser +## 1.1.0.0 -- 2018-1-19++* Made parsing errors significantly more informative.+* The `keyValue` parser in `ConfigParser` now takes a `Parser Key`, rather than+ a `Key`, to facilitate easier detection of bad keys.+* Fixed some broken haddocks.+ ## 1.0.0.0 -- 2017-12-04 * Removed 'ConfigParser' constructor with janky call to 'error'. Non-unique keys
Text/ConfigParser.hs view
@@ -61,13 +61,7 @@ > main :: IO () > main = parseFromFile cp "./config.txt" >>= print -}-{-# OPTIONS_HADDOCK ignore_exports #-} module Text.ConfigParser- ( module Types- , module Parser- ) where--import Text.ConfigParser.Types as Types ( Key , ConfigOption(..) , ConfigParser(..)@@ -76,10 +70,7 @@ , configParser , defaultKeyValue , defaultLineCommentInit- )--import Text.ConfigParser.Parser as Parser- ( config+ , config , string , integer , boundedIntegral@@ -87,4 +78,7 @@ , list , parseFromText , parseFromFile- )+ ) where++import Text.ConfigParser.Types as Types+import Text.ConfigParser.Parser as Parser
Text/ConfigParser/Parser.hs view
@@ -1,15 +1,19 @@+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_HADDOCK hide #-} module Text.ConfigParser.Parser where import Control.Monad (void, unless, when) import Data.List (nub, (\\), intercalate) import Data.String (IsString(..))-import Text.Parsec (SourceName, ParseError, State(..), parserFail, alphaNum)-import Text.Parsec (getParserState, setParserState, unexpected, newline, unexpected)-import Text.Parsec (manyTill, char, choice, digit, sepBy, many, many1, try)-import Text.Parsec (spaces, eof, parse, (<|>), (<?>))+import Text.Parsec (ParseError, unexpected, parserFail)+import Text.Parsec (newline, manyTill, char, choice, digit, sepBy, many, many1)+import Text.Parsec (try, spaces, eof, parse, (<|>), (<?>), lookAhead) import Text.Parsec.Char (noneOf, oneOf, anyChar)+import Text.Parsec.Pos (SourceName, initialPos, sourceName)+import Text.Parsec.Prim (setInput, getPosition, setPosition) import Text.Parsec.Text (Parser) import qualified Data.Text as T (Text) import qualified Data.Text.IO as T (readFile)@@ -63,23 +67,15 @@ separator = try $ spaces *> char ',' <* spaces terminator = try $ spaces *> char ']' --- | Ignore zero or more spaces, tabs, or vertical tabs.-whitespace :: Parser ()-whitespace = () <$ many (oneOf " \t\v\r") <?> "whitespace"---- | Extract a parser for a transformation on @c@s from a 'ConfigOption'.-actionParser :: ConfigParser c -> ConfigOption c -> Parser (c -> c)-actionParser c ConfigOption {..} =- whitespace *> keyValue c key (action <$> parser)---- Parse a string and replace the input of the parser with the result.+-- | Parse a string and replace the input of the parser with the result. replaceParserInput :: Parser String -> Parser ()-replaceParserInput p = do- s <- getParserState- i <- p- void $ setParserState s {stateInput = fromString i}+replaceParserInput parser = void $ do+ input <- parser+ source <- sourceName <$> getPosition+ setInput $ fromString input+ setPosition $ initialPos source --- Replace each line comment with a single newline.+-- | Replace each line comment with a single newline. removeLineComments :: ConfigParser c -> Parser () removeLineComments ConfigParser {..} = replaceParserInput $ mconcat <$> many (escapedComment <|> comment <|> content)@@ -90,50 +86,50 @@ escapedComment = try $ char '\\' *> startComment content = (:[]) <$> anyChar --- Remove spaces from the start and end of each line, at the start of the--- input, and at the end of the input.-removeExtraSpaces :: Parser ()-removeExtraSpaces = replaceParserInput $- whitespace *> contentChar `manyTill` try (whitespace *> eof)- where- contentChar = try strippedNL <|> anyChar- strippedNL = whitespace *> newline <* whitespace---- Replace sequences of multiple newlines with a single newline.-removeExtraLines :: Parser ()-removeExtraLines = replaceParserInput $- optionalNLs *> contentChar `manyTill` try (optionalNLs *> eof)- where- contentChar = combinedNLs <|> anyChar- optionalNLs = () <$ many newline- combinedNLs = '\n' <$ many1 newline---- Parse a config file as specified by a 'ConfigParser'.+-- | Parse a config file as specified by a 'ConfigParser'. config :: ConfigParser c -> Parser c config p = do unless optionKeysUniq $ parserFail "non-unique keys in ConfigParser" removeLineComments p- removeExtraSpaces- removeExtraLines- (ks,c) <- go [] (defaults p)+ (ks,c) <- go ([]::[Key]) (defaults p) let missingKeys = requiredKeys \\ ks unless (null missingKeys) $ parserFail ("missing required keys: " ++ intercalate ", " (fmap show missingKeys)) return c where- actionParser' o = (,) (key o) <$> actionParser p o- optionParser = choice $ try . actionParser' <$> options p- requiredKeys = fmap key . filter required $ options p- optionKeysUniq = length (nub $ key <$> options p) == length (options p)- go ks c = (ks,c) <$ eof <|> do- (k,f) <- optionParser <|> do- k <- many1 alphaNum- unexpected $ "key: \"" ++ k ++ "\""- when (k `elem` (ks::[Key])) $- unexpected ("duplicate key: \"" ++ k ++ "\"")- let c' = f c- newline *> go (k:ks) c' <|> (k:ks,c') <$ eof+ 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+ optionParsers = choice $ try . keyActionP <$> options p+ dummyActionP = (Nothing,Nothing) <$ keyValue p identifier (try line)+ configLineP = optionParsers <|> dummyActionP <|> parserFail "Parsing failed"+ 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+ go ks c = whitespace *> go' ks c <* whitespace+ go' ks c = (ks,c) <$ eof -- End of document+ <|> newline *> go ks c -- Empty line+ <|> do -- Config line+ (mbo,mbv) <- lookAhead configLineP+ case mbo of+ -- Key is bad+ Nothing -> do + k <- identifier+ unexpected $ "key " ++ show k+ -- Key is good+ Just o@(ConfigOption {..}) -> do+ when (key `elem` ks) $ unexpected ("duplicate key " ++ show key)+ case mbv of+ -- Value is bad+ Nothing -> do+ _ <- actionParser o -- This should error out, but...+ parserFail $ "Couldn't parse value for key " ++ show key+ -- Value is good+ Just f -> actionParser o >> go (key:ks) (f c) -- Parse a config file from 'Text'. parseFromText :: ConfigParser c -> SourceName -> T.Text -> Either ParseError c
Text/ConfigParser/Types.hs view
@@ -1,13 +1,14 @@ {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RankNTypes #-}+{-# OPTIONS_HADDOCK hide #-} module Text.ConfigParser.Types where -import Text.Parsec (string, spaces, char, (<?>))+import Text.Parsec (spaces, char) import Text.Parsec.Text (Parser) type Key = String --- Key-value pair to parse from a config file.+-- ^ Key-value pair to parse from a config file. data ConfigOption c = forall a. ConfigOption { key :: Key -- ^ Key name.@@ -24,18 +25,18 @@ -- the 'ConfigParser' constructor if you want to specify your own 'lineParser' -- or 'commentStart'. Otherwise, use the 'configParser' smart constructor. data ConfigParser c = ConfigParser- { keyValue :: forall a. Key -> Parser a -> Parser a+ { 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@. , lineCommentInit :: [String]- -- Strings to start a line comment, such as @#@, @--@, or @//@. All+ -- ^ 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 @\--@. , defaults :: c- -- Initial @c@ to fold each 'ConfigOption's action over.+ -- ^ Initial @c@ to fold each 'ConfigOption's action over. , options :: [ConfigOption c]- -- List of key-value pairs to parse from the config file. Any key in the+ -- ^ 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. } @@ -45,10 +46,9 @@ configParser = ConfigParser defaultKeyValue defaultLineCommentInit -- | Default syntax like @key = value@.-defaultKeyValue :: Key -> Parser a -> Parser a-defaultKeyValue k p = keyParser *> separator *> p+defaultKeyValue :: Parser Key -> Parser a -> Parser a+defaultKeyValue k p = k *> separator *> p where- keyParser = string k <?> "key \"" ++ k ++ "\"" separator = spaces *> char '=' <* spaces -- | Default line comment like @# comment text@.
config-parser.cabal view
@@ -1,5 +1,5 @@ name: config-parser-version: 1.0.0.0+version: 1.1.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@@ -59,6 +59,7 @@ main-is: tests/Parsing.hs default-language: Haskell2010 build-depends: base >=4.9 && <4.10,+ extra >=1.5 && <1.7, hspec >=2.4 && <2.5, lens >=4.15 && <4.16, parsec >=3.1 && <3.2,
tests/Parsing.hs view
@@ -6,8 +6,8 @@ import Prelude hiding (unlines) import Control.Lens-import Control.Monad (void) import Data.Int (Int8)+import Data.List.Extra (isInfixOf) import Data.Text (unlines) import Data.Word (Word8) import Test.Hspec@@ -17,8 +17,7 @@ import qualified Text.Parsec as P (string) import Text.ConfigParser-import Text.ConfigParser.Parser (whitespace, actionParser, removeLineComments)-import Text.ConfigParser.Parser (removeExtraSpaces, removeExtraLines)+import Text.ConfigParser.Parser (removeLineComments) data C = C { _f1 :: String@@ -101,8 +100,8 @@ cp = configParser defC [co1,co2,co3,co4,co5,co6,co7] cp' = ConfigParser lp lcs defC [co1,co2,co3,co4,co5,co6,co7] where- lp :: Key -> Parser a -> Parser a- lp k q = q <* spaces <* P.string "->" <* spaces <* P.string k+ lp :: Parser Key -> Parser a -> Parser a+ lp k q = q <* spaces <* P.string "->" <* spaces <* k lcs = ["--","//"] shouldFailOnLine :: Show a => Either ParseError a -> Int -> Expectation@@ -118,10 +117,7 @@ , testBool , testList , testDefaultKeyValue- , testActionParser , testRemoveLineComments- , testRemoveExtraSpaces- , testRemoveExtraLines , testConfig ] @@ -252,52 +248,30 @@ it "fails on an unterminated list after a comma" $ parse (list integer) "test" "[42," `shouldFailOnLine` 1 -testWhitespace :: Spec-testWhitespace = describe "whitespace" $ do- it "parses spaces" $- parse whitespace "test" " " `shouldBe` Right ()- it "parses tabs" $- parse whitespace "test" "\t\t\t\t" `shouldBe` Right ()- it "parses a mix of spaces and tabs" $- parse whitespace "test" " \t \t \t\t " `shouldBe` Right ()- it "fails on newlines" $- parse (whitespace <* eof) "test" "\n" `shouldFailOnLine` 1- it "fails on carriage return" $- parse (whitespace <* eof) "test" "\r" `shouldFailOnLine` 1- testDefaultKeyValue :: Spec testDefaultKeyValue = describe "defaultKeyValue" $ do it "parses \"<key>=<value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo=42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo=42" `shouldBe` Right 42 it "parses \"<key> = <value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo = 42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo = 42" `shouldBe` Right 42 it "parses \"<key>\\t=\\t<value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo\t=\t42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo\t=\t42" `shouldBe` Right 42 it "parses \"<key>\\n=\\n<value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo\n=\n42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo\n=\n42" `shouldBe` Right 42 it "parses \"<key>\\n =\\n <value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo\n =\n 42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo\n =\n 42" `shouldBe` Right 42 it "parses \"<key> \\n= \\n<value>\"" $- parse (defaultKeyValue "foo" integer) "test" "foo \n= \n42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "foo \n= \n42" `shouldBe` Right 42 it "fails on incorrect key" $- parse (defaultKeyValue "foo" integer) "test" "bar = 42"+ parse (defaultKeyValue (P.string "foo") integer) "test" "bar = 42" `shouldFailOnLine` 1 -testActionParser :: Spec-testActionParser = describe "actionParser" $ do- it "doesn't require whitespace at the start of a line" $- parse (actionParser' co2) "test" "f2 = 42" `shouldBe` Right ()- it "allows whitespace at the start of a line" $- parse (actionParser' co2) "test" " f2 = 42" `shouldBe` Right ()- where- actionParser' = void . actionParser cp- testRemoveLineComments :: Spec testRemoveLineComments = describe "removeLineComments" $ do it "preserves an empty file" $@@ -364,67 +338,6 @@ where removeLineComments' = removeLineComments cp >> getInput -testRemoveExtraSpaces :: Spec-testRemoveExtraSpaces = describe "removeExtraSpaces" $ do- it "preserves an empty file" $- parse removeExtraSpaces' "test" "" `shouldBe` Right ""- it "preserves a file with one simple line" $- parse removeExtraSpaces' "test" "foobaz" `shouldBe` Right "foobaz"- it "preserves spaces in the middle of a simple line" $- parse removeExtraSpaces' "test" "foo baz" `shouldBe` Right "foo baz"- it "preserves a simple multiline file" $- parse removeExtraSpaces' "test" "foo\nbar\nzap"- `shouldBe` Right "foo\nbar\nzap"- it "preserves a multiline file with spaces" $- parse removeExtraSpaces' "test" "foo\nwiz woz\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes space alternatives" $- parse removeExtraSpaces' "test" " \t\r\vbaz" `shouldBe` Right "baz"- it "removes spaces at the start of a simple line" $- parse removeExtraSpaces' "test" " baz" `shouldBe` Right "baz"- it "removes spaces at the end of a simple line" $- parse removeExtraSpaces' "test" "foo " `shouldBe` Right "foo"- it "removes spaces at the start of a multi-line file" $- parse removeExtraSpaces' "test" " foo\nwiz woz\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes spaces at the end of a multi-line file" $- parse removeExtraSpaces' "test" "foo\nwiz woz\nzap "- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes spaces at the start of a line in a multi-line file" $- parse removeExtraSpaces' "test" "foo\n wiz woz\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes spaces at the end of a line in a multi-line file" $- parse removeExtraSpaces' "test" "foo\nwiz woz \nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- where- removeExtraSpaces' = removeExtraSpaces >> getInput--testRemoveExtraLines :: Spec-testRemoveExtraLines = describe "removeExtraLines" $ do- it "preserves an empty file" $- parse removeExtraLines' "test" "" `shouldBe` Right ""- it "preserves a file with one simple line" $- parse removeExtraLines' "test" "foobaz" `shouldBe` Right "foobaz"- it "preserves spaces in the middle of a simple line" $- parse removeExtraLines' "test" "foo baz" `shouldBe` Right "foo baz"- it "preserves a simple multiline file" $- parse removeExtraLines' "test" "foo\nbar\nzap"- `shouldBe` Right "foo\nbar\nzap"- it "preserves a multiline file with spaces" $- parse removeExtraLines' "test" "foo\nwiz woz\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes newlines at the start of a multi-line file" $- parse removeExtraLines' "test" "\n\n\nfoo\nwiz woz\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes newlines at the end of a multi-line file" $- parse removeExtraLines' "test" "foo\nwiz woz\nzap\n\n\n"- `shouldBe` Right "foo\nwiz woz\nzap"- it "removes newlines in the middle of a multi-line file" $- parse removeExtraLines' "test" "foo\nwiz woz\n\n\nzap"- `shouldBe` Right "foo\nwiz woz\nzap"- where- removeExtraLines' = removeExtraLines >> getInput- testConfig :: Spec testConfig = describe "config" $ do it "parses an empty config file" $@@ -763,7 +676,7 @@ ]) `shouldSatisfy` \res -> case res of Right _ -> False Left e -> sourceLine (errorPos e) == 6- && "unexpected key: \"badkey\"" `elem` lines (show e)+ && "unexpected key \"badkey\"" `isInfixOf` show e it "errors on duplicate keys in config file with a pertinent message" $ parseFromText cp "test" (unlines [ "f1 = \"foo\""@@ -771,4 +684,4 @@ ]) `shouldSatisfy` \res -> case res of Right _ -> False Left e -> sourceLine (errorPos e) == 2- && "unexpected duplicate key: \"f1\"" `elem` lines (show e)+ && "duplicate key \"f1\"" `isInfixOf` show e