diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # Revision history for config-parser -## 0.1.0.0 -- YYYY-mm-dd +## 1.0.0.0 -- 2017-12-04 + +* Removed 'ConfigParser' constructor with janky call to 'error'. Non-unique keys + will now cause parsing to fail, instead. +* Duplicate keys in config files will now cause parsing to fail. +* 'ConfigOption' now has a 'required' field to specify that omitting a + particular key from a config file is an error. Omiting required keys causes + parsing to fail. +* The 'boundedIntegral' parser is now correctly exported. + +## 0.2.0.0 -- 2017-10-31 * First version. Released on an unsuspecting world. diff --git a/Text/ConfigParser.hs b/Text/ConfigParser.hs --- a/Text/ConfigParser.hs +++ b/Text/ConfigParser.hs @@ -63,36 +63,28 @@ -} {-# OPTIONS_HADDOCK ignore_exports #-} module Text.ConfigParser - ( Key - , ConfigOption(..) - , ConfigParser(keyValue, lineCommentInit, defaults, options) - , configParser_ - , configParser - , defaultKeyValue - , defaultLineCommentInit - , config - , string - , integer - , bool - , list - , parseFromFile + ( module Types + , module Parser ) where -import Text.ConfigParser.Types +import Text.ConfigParser.Types as Types ( Key , ConfigOption(..) - , ConfigParser(keyValue, lineCommentInit, defaults, options) - , configParser_ + , ConfigParser(..) + , optionalCO + , requiredCO , configParser , defaultKeyValue , defaultLineCommentInit ) -import Text.ConfigParser.Parser +import Text.ConfigParser.Parser as Parser ( config , string , integer + , boundedIntegral , bool , list + , parseFromText , parseFromFile ) diff --git a/Text/ConfigParser/Parser.hs b/Text/ConfigParser/Parser.hs --- a/Text/ConfigParser/Parser.hs +++ b/Text/ConfigParser/Parser.hs @@ -2,14 +2,17 @@ {-# LANGUAGE ScopedTypeVariables #-} module Text.ConfigParser.Parser where -import Control.Monad (void) +import Control.Monad (void, unless, when) +import Data.List (nub, (\\), intercalate) import Data.String (IsString(..)) -import Text.Parsec (SourceName, ParseError, State(..)) -import Text.Parsec (getParserState, setParserState, unexpected, newline) +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.Char (noneOf, oneOf, anyChar) import Text.Parsec.Text (Parser) +import qualified Data.Text as T (Text) +import qualified Data.Text.IO as T (readFile) import qualified Text.Parsec as P (string) import Text.ConfigParser.Util @@ -40,8 +43,7 @@ intMax = maxBound :: n bound n | n > fromIntegral intMax = unexpected $ "integer above " ++ show intMax | n < fromIntegral intMin = unexpected $ "integer below " ++ show intMin - - | otherwise = return $ fromIntegral n + | otherwise = return $ fromIntegral n -- | Parse a boolean. Valid synonyms for @True@ are @true@, @yes@, @Yes@, @on@, -- and @On@. Valid synonyms for @False@ are @false@, @no@, @No@, @off@, and @@ -65,7 +67,7 @@ whitespace :: Parser () whitespace = () <$ many (oneOf " \t\v\r") "whitespace" --- | Extract a parser for a transformation on c's from a 'ConfigOption'. +-- | 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) @@ -108,14 +110,35 @@ -- Parse a config file as specified by a 'ConfigParser'. config :: ConfigParser c -> Parser c -config p = foldr ($) (defaults p) <$> do +config p = do + unless optionKeysUniq $ + parserFail "non-unique keys in ConfigParser" removeLineComments p removeExtraSpaces removeExtraLines - optionParsers `sepBy` newline <* eof + (ks,c) <- go [] (defaults p) + let missingKeys = requiredKeys \\ ks + unless (null missingKeys) $ + parserFail ("missing required keys: " ++ intercalate ", " (fmap show missingKeys)) + return c where - optionParsers = choice $ try . actionParser p <$> options p + 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 +-- Parse a config file from 'Text'. +parseFromText :: ConfigParser c -> SourceName -> T.Text -> Either ParseError c +parseFromText = parse . config + -- Parse a config file from disk. parseFromFile :: ConfigParser c -> SourceName -> IO (Either ParseError c) -parseFromFile p f = parse (config p) f . fromString <$> readFile f +parseFromFile p f = parseFromText p f <$> T.readFile f diff --git a/Text/ConfigParser/Types.hs b/Text/ConfigParser/Types.hs --- a/Text/ConfigParser/Types.hs +++ b/Text/ConfigParser/Types.hs @@ -2,21 +2,26 @@ {-# LANGUAGE RankNTypes #-} module Text.ConfigParser.Types where -import Data.List (nub) import Text.Parsec (string, spaces, char, ()) import Text.Parsec.Text (Parser) type Key = String -- Key-value pair to parse from a config file. -data ConfigOption c = forall a. ConfigOption - { key :: Key -- ^ Key name. - , parser :: Parser a -- ^ Parser for the given value type. - , action :: a -> c -> c -- ^ How the value should change the state @c@. - } +data ConfigOption c + = forall a. ConfigOption + { key :: Key -- ^ Key name. + , required :: Bool -- ^ Whether it is an error to omit this key. + , parser :: Parser a -- ^ Parser for the given value type. + , action :: a -> c -> c -- ^ How the value should change the state @c@. + } +optionalCO, requiredCO :: Key -> Parser a -> (a -> c -> c) -> ConfigOption c +optionalCO k = ConfigOption k False +requiredCO k = ConfigOption k True + -- | Parameters for a parser that takes a config file and produces a @c@. Use --- the 'configParser_' constructor if you want to specify your own 'lineParser' +-- 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 @@ -34,26 +39,16 @@ -- config file that doesn't appear here will result in parse error. } --- | Smart constructor to check that 'options' doesn't contain any duplicate --- keys before creating a 'ConfigParser'. -configParser_ :: (forall a. Key -> Parser a -> Parser a) - -> [String] -> c -> [ConfigOption c] -> ConfigParser c -configParser_ kv cs ds os' = ConfigParser kv cs ds os - where - os = if length (nub $ fmap key os') == length os' - then os' - else error "duplicate option keys in ConfigParser" - -- | 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 -- | Default syntax like @key = value@. defaultKeyValue :: Key -> Parser a -> Parser a defaultKeyValue k p = keyParser *> separator *> p where - keyParser = string k "option key" + keyParser = string k "key \"" ++ k ++ "\"" separator = spaces *> char '=' <* spaces -- | Default line comment like @# comment text@. diff --git a/Text/ConfigParser/Util.hs b/Text/ConfigParser/Util.hs --- a/Text/ConfigParser/Util.hs +++ b/Text/ConfigParser/Util.hs @@ -2,3 +2,6 @@ (.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d (.:) = (.).(.) + +(&&&) :: (a -> b) -> (a -> c) -> a -> (b,c) +(&&&) f g a = (f a, g 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: 0.2.0.0 +version: 1.0.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 @@ -44,7 +44,8 @@ RankNTypes, RecordWildCards build-depends: base >=4.9 && <4.10, - parsec >=3.1 && <3.2 + parsec >=3.1 && <3.2, + text >=1.2 && <1.3 -- hs-source-dirs: default-language: Haskell2010 diff --git a/tests/Parsing.hs b/tests/Parsing.hs --- a/tests/Parsing.hs +++ b/tests/Parsing.hs @@ -16,8 +16,9 @@ import Text.Parsec.Text (Parser) import qualified Text.Parsec as P (string) -import Text.ConfigParser.Types -import Text.ConfigParser.Parser +import Text.ConfigParser +import Text.ConfigParser.Parser (whitespace, actionParser, removeLineComments) +import Text.ConfigParser.Parser (removeExtraSpaces, removeExtraLines) data C = C { _f1 :: String @@ -27,6 +28,7 @@ , _f5 :: [Integer] , _f6 :: [Bool] , _f7 :: [[Integer]] + , _f8 :: Integer } deriving (Show, Eq) makeLenses ''C @@ -40,57 +42,69 @@ , _f5 = [] , _f6 = [] , _f7 = [] + , _f8 = 0 } -co1,co2,co3,co4,co5,co6,co7 :: ConfigOption C +co1,co2,co3,co4,co5,co6,co7,co8 :: ConfigOption C co1 = ConfigOption - { key = "f1" - , action = set' f1 - , parser = string + { key = "f1" + , required = False + , action = set' f1 + , parser = string } co2 = ConfigOption - { key = "f2" - , action = set' f2 - , parser = integer + { key = "f2" + , required = False + , action = set' f2 + , parser = integer } co3 = ConfigOption - { key = "f3" - , action = set' f3 - , parser = bool + { key = "f3" + , required = False + , action = set' f3 + , parser = bool } co4 = ConfigOption - { key = "f4" - , action = set' f4 - , parser = list string + { key = "f4" + , required = False + , action = set' f4 + , parser = list string } co5 = ConfigOption - { key = "f5" - , action = set' f5 - , parser = list integer + { key = "f5" + , required = False + , action = set' f5 + , parser = list integer } co6 = ConfigOption - { key = "f6" - , action = set' f6 - , parser = list bool + { key = "f6" + , required = False + , action = set' f6 + , parser = list bool } co7 = ConfigOption - { key = "f7" - , action = set' f7 - , parser = list (list integer) + { key = "f7" + , required = False + , action = set' f7 + , parser = list (list integer) } +co8 = ConfigOption + { key = "f8" + , required = True + , action = set' f8 + , parser = integer + } -cp, cp' :: ConfigParser C -cp = configParser defC [co1,co2,co3,co4,co5,co6,co7] -cp' = configParser_ lp lcs defC [co1,co2,co3,co4,co5,co6,co7] +cp, cp', badcp, reqcp :: ConfigParser C +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] where lp :: Key -> Parser a -> Parser a lp k q = q <* spaces <* P.string "->" <* spaces <* P.string k lcs = ["--","//"] -p, p' :: Parser C -p = config cp -p' = config cp' - shouldFailOnLine :: Show a => Either ParseError a -> Int -> Expectation shouldFailOnLine e n = case e of Left err -> sourceLine (errorPos err) `shouldBe` n @@ -414,22 +428,23 @@ testConfig :: Spec testConfig = describe "config" $ do it "parses an empty config file" $ - parse p "test" "" `shouldBe` Right defC + parseFromText cp "test" "" `shouldBe` Right defC it "parses a config file with just empty lines" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "" , "\t" , " " ]) `shouldBe` Right defC it "parses a config file with just a line comment" $ do - parse p "test" "# foo" `shouldBe` Right defC + parseFromText cp "test" "# foo" `shouldBe` Right defC it "parses a config file with just one line" $ - parse p "test" "f1 = \"foo\"" `shouldBe` Right defC {_f1 = "foo"} + parseFromText cp "test" "f1 = \"foo\"" + `shouldBe` Right defC {_f1 = "foo"} it "parses a string with escape sequences in it" $ - parse p "test" "f1 = \"foo\\n\\\"\\\\\"" + parseFromText cp "test" "f1 = \"foo\\n\\\"\\\\\"" `shouldBe` Right defC {_f1 = "foo\n\"\\"} it "parses multiple in-order options from a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -443,7 +458,7 @@ , _f5 = [1,2,3,4,5] } it "parses multiple out-of-order options from a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f4 = [\"foo\",\"bar\"]" , "f2 = 9001" , "f1 = \"foo\"" @@ -457,7 +472,7 @@ , _f5 = [1,2,3,4,5] } it "allows a comment at the top of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "# I'm a comment" , "f1 = \"foo\"" , "f2 = 9001" @@ -472,7 +487,7 @@ , _f5 = [1,2,3,4,5] } it "allows a comment in the middle of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -487,7 +502,7 @@ , _f5 = [1,2,3,4,5] } it "allows a comment at the end of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -502,7 +517,7 @@ , _f5 = [1,2,3,4,5] } it "allows a comment at the end of a line" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True # I'm a comment" @@ -516,7 +531,7 @@ , _f5 = [1,2,3,4,5] } it "allows a comment at the end of a line and file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -530,7 +545,7 @@ , _f5 = [1,2,3,4,5] } it "allows a newline at the top of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "" , "f1 = \"foo\"" , "f2 = 9001" @@ -545,7 +560,7 @@ , _f5 = [1,2,3,4,5] } it "allows a newline in the middle of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -560,7 +575,7 @@ , _f5 = [1,2,3,4,5] } it "allows a newline at the end of a config file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -575,7 +590,7 @@ , _f5 = [1,2,3,4,5] } it "allows whitespace at the start of a line" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , " \r\v\tf3 = True" @@ -589,7 +604,7 @@ , _f5 = [1,2,3,4,5] } it "allows whitespace at the start of a line and file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ " \r\v\tf1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -603,7 +618,7 @@ , _f5 = [1,2,3,4,5] } it "allows whitespace at the end of a line" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True \r\v\t" @@ -617,7 +632,7 @@ , _f5 = [1,2,3,4,5] } it "allows whitespace at the end of a line and file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -631,7 +646,7 @@ , _f5 = [1,2,3,4,5] } it "allows empty lines at the start of a file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ " \r\v\t" , "" , "" @@ -648,7 +663,7 @@ , _f5 = [1,2,3,4,5] } it "allows empty lines in the middle of a file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , " \r\v\t" @@ -665,7 +680,7 @@ , _f5 = [1,2,3,4,5] } it "allows empty lines at the end of a file" $ - parse p "test" (unlines + parseFromText cp "test" (unlines [ "f1 = \"foo\"" , "f2 = 9001" , "f3 = True" @@ -682,7 +697,7 @@ , _f5 = [1,2,3,4,5] } it "parses an alternative key-value syntax" $ - parse p' "test" (unlines + parseFromText cp' "test" (unlines [ "\"foo\" -> f1" , "9001 -> f2" , "True -> f3" @@ -696,7 +711,7 @@ , _f5 = [1,2,3,4,5] } it "parses an alternative comment syntax" $ - parse p' "test" (unlines + parseFromText cp' "test" (unlines [ "\"foo\" -> f1" , "9001 -> f2" , "True -> f3" @@ -711,7 +726,7 @@ , _f5 = [1,2,3,4,5] } it "parses an multiple comment syntaxes" $ - parse p' "test" (unlines + parseFromText cp' "test" (unlines [ "\"foo\" -> f1" , "9001 -> f2" , "True -> f3" @@ -725,12 +740,35 @@ , _f4 = ["foo","bar"] , _f5 = [1,2,3,4,5] } - it "errors on non-existent keys" $ - parse p "test" (unlines + it "errors on non-unique keys in ConfigParser with a pertinent message" $ + parseFromText badcp "test" "" + `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 1 + && "non-unique keys in ConfigParser" `elem` lines (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) + it "errors on non-existent keys 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" - ]) `shouldFailOnLine` 6 + ]) `shouldSatisfy` \res -> case res of + Right _ -> False + Left e -> sourceLine (errorPos e) == 6 + && "unexpected key: \"badkey\"" `elem` lines (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 + && "unexpected duplicate key: \"f1\"" `elem` lines (show e)