config-parser 0.2.0.0 → 1.0.0.0
raw patch · 7 files changed
+170/−108 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Text.ConfigParser: ConfigOption :: Key -> Parser a -> (a -> c -> c) -> ConfigOption c
- Text.ConfigParser: [action] :: ConfigOption c -> a -> c -> c
- Text.ConfigParser: [key] :: ConfigOption c -> Key
- Text.ConfigParser: [parser] :: ConfigOption c -> Parser a
- Text.ConfigParser: bool :: Parser Bool
- Text.ConfigParser: config :: ConfigParser c -> Parser c
- Text.ConfigParser: configParser :: c -> [ConfigOption c] -> ConfigParser c
- Text.ConfigParser: configParser_ :: (forall a. Key -> Parser a -> Parser a) -> [String] -> c -> [ConfigOption c] -> ConfigParser c
- Text.ConfigParser: data ConfigOption c
- Text.ConfigParser: data ConfigParser c
- Text.ConfigParser: defaultKeyValue :: Key -> Parser a -> Parser a
- Text.ConfigParser: defaultLineCommentInit :: [String]
- Text.ConfigParser: integer :: Parser Integer
- Text.ConfigParser: list :: (Parser a) -> Parser [a]
- Text.ConfigParser: parseFromFile :: ConfigParser c -> SourceName -> IO (Either ParseError c)
- Text.ConfigParser: string :: IsString s => Parser s
- Text.ConfigParser: type Key = String
Files
- ChangeLog.md +11/−1
- Text/ConfigParser.hs +9/−17
- Text/ConfigParser/Parser.hs +33/−10
- Text/ConfigParser/Types.hs +14/−19
- Text/ConfigParser/Util.hs +3/−0
- config-parser.cabal +3/−2
- tests/Parsing.hs +97/−59
ChangeLog.md view
@@ -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.
Text/ConfigParser.hs view
@@ -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 )
Text/ConfigParser/Parser.hs view
@@ -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
Text/ConfigParser/Types.hs view
@@ -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@.
Text/ConfigParser/Util.hs view
@@ -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)
config-parser.cabal view
@@ -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
tests/Parsing.hs view
@@ -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)