diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for config-parser + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2017 Ben Hamlin + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Text/ConfigParser.hs b/Text/ConfigParser.hs new file mode 100644 --- /dev/null +++ b/Text/ConfigParser.hs @@ -0,0 +1,81 @@ +{-| +Module : Text.ConfigParser +Description : A simple library to parse config files using parsec that + generates parse errors on invalid keys +Copyright : (c) Ben Hamlin, 2017 +License : MIT +Maintainer : protob3n@gmail.com +Stability : experimental +Portability : POSIX + +This is yet another entry in Haskell's enourmous collection of config-file +parsing libraries. It lacks many of the bells and whistles of other config-file +parsing libraries, such as hierarchical sections and on-the-fly reloading. On +the other hand, it has a combination of features I was unable to find in other +libraries: +* Keys and values are parsed with configurable parsec parsers, resulting in + flexible syntax and pretty error messages. +* Custom parsers can be created with parsec to handle values of any type. +* Keys that aren't explicitly handled result in parse errors. + +If you don't need all of these features, there are probably better libraries out +there for you. If you're free to use its idiosyncratic file format, the +config-value library, in particular, is excelent. + +By default, this library parses flat config like the following: +@ +a_string = "blah, blah, blah\nmore blah" +a_number = 9001 +a_list = [1,2,3,4,5] +# This is a comment +@ + +If you wanted to parse the above file, saved as @./config.txt@, you might do so +as follows: +@ +import Text.ConfigParser + +cp :: ConfigParser (Maybe String, Maybe Integer, [Integer]) +cp = configParser (Nothing, Nothing, []) + [ ConfigOption + { key = "a_string" + , parser = string + , action = \s (_,n,ns) -> (Just s, n, ns) + } + , ConfigOption + { key = "a_number" + , parser = integer + , action = \n (s,_,ns) -> (s, Just n, ns) + } + , ConfigOption + { key = "a_list" + , parser = list integer + , action = \ns (s,n,_) -> (s, n, ns) + } + ] + +main :: IO () +main = parseFromFile cp "./config.txt" >>= print +@ +-} +module Text.ConfigParser + ( module Types + , module Parser + ) where + +import Text.ConfigParser.Types as Types + ( Key + , ConfigOption + , ConfigParser + , configParser_ + , configParser + , defaultKeyValue + , defaultLineCommentInit + ) +import Text.ConfigParser.Parser as Parser + ( config + , string + , integer + , bool + , list + ) diff --git a/Text/ConfigParser/Parser.hs b/Text/ConfigParser/Parser.hs new file mode 100644 --- /dev/null +++ b/Text/ConfigParser/Parser.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +module Text.ConfigParser.Parser where + +import Control.Monad (void) +import Data.String (IsString(..)) +import Text.Parsec (SourceName, ParseError, State(..)) +import Text.Parsec (getParserState, setParserState, unexpected, newline) +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 Text.Parsec as P (string) + +import Text.ConfigParser.Util +import Text.ConfigParser.Types + +-- | Parse a string surrounded by quotes. Quotes within the string must be +-- escaped with backslashes. +string :: IsString s => Parser s +string = char '"' *> fmap fromString (many stringChar) <* char '"' + "string in quotes" + where + stringChar = noneOf "\"\n\\" <|> char '\\' *> escapeSeq + escapeSeq = char '"' <|> char '\\' <|> '\n' <$ char 'n' + +-- | Parse an integer. +integer :: Parser Integer +integer = read .: (++) <$> sign <*> many1 digit "integer" + where + sign = P.string "-" <|> P.string "" + +-- | 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 + where + intMin = minBound :: n + 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 + +-- | Parse a boolean. Valid synonyms for @True@ are @true@, @yes@, @Yes@, @on@, +-- and @On@. Valid synonyms for @False@ are @false@, @no@, @No@, @off@, and +-- @Off@. +bool :: Parser Bool +bool = True <$ try truthy <|> False <$ try falsey + where + truthy = choice $ fmap P.string ["true", "True", "yes", "Yes", "on", "On"] + falsey = choice $ fmap P.string ["false", "False", "no", "No", "off", "Off"] + +-- | Parse a list of values surrounded by @[@ and @]@, and separated by commas. +-- The list can contain whitespace and newlines. +list :: (Parser a) -> Parser [a] +list p = initial *> (p `sepBy` separator) <* terminator "list in brackets" + where + initial = try $ char '[' <* spaces + 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. +replaceParserInput :: Parser String -> Parser () +replaceParserInput p = do + s <- getParserState + i <- p + void $ setParserState s {stateInput = fromString i} + +-- Replace each line comment with a single newline. +removeLineComments :: ConfigParser c -> Parser () +removeLineComments ConfigParser {..} = replaceParserInput $ + mconcat <$> many (escapedComment <|> comment <|> content) + where + startComment = choice $ try . P.string <$> lineCommentInit + terminator = void newline <|> eof + comment = '\n':[] <$ startComment <* anyChar `manyTill` terminator + 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'. +config :: ConfigParser c -> Parser c +config p = foldr ($) (defaults p) <$> do + removeLineComments p + removeExtraSpaces + removeExtraLines + optionParsers `sepBy` newline <* eof + where + optionParsers = choice $ try . actionParser p <$> options p + +-- Parse a config file from disk. +parseFromFile :: ConfigParser c -> SourceName -> IO (Either ParseError c) +parseFromFile p f = parse (config p) f . fromString <$> readFile f diff --git a/Text/ConfigParser/Types.hs b/Text/ConfigParser/Types.hs new file mode 100644 --- /dev/null +++ b/Text/ConfigParser/Types.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# 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@. + } + +-- | 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' +-- or 'commentStart'. Otherwise, use the 'configParser' smart constructor. +data ConfigParser c = ConfigParser + { keyValue :: forall a. 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 + -- 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. + , 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. + } + +-- | 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 + +-- | Default syntax like @key = value@. +defaultKeyValue :: Key -> Parser a -> Parser a +defaultKeyValue k p = keyParser *> separator *> p + where + keyParser = string k "option key" + separator = spaces *> char '=' <* spaces + +-- | Default line comment like @# comment text@. +defaultLineCommentInit :: [String] +defaultLineCommentInit = ["#"] diff --git a/Text/ConfigParser/Util.hs b/Text/ConfigParser/Util.hs new file mode 100644 --- /dev/null +++ b/Text/ConfigParser/Util.hs @@ -0,0 +1,4 @@ +module Text.ConfigParser.Util where + +(.:) :: (c -> d) -> (a -> b -> c) -> a -> b -> d +(.:) = (.).(.) diff --git a/config-parser.cabal b/config-parser.cabal new file mode 100644 --- /dev/null +++ b/config-parser.cabal @@ -0,0 +1,61 @@ +name: config-parser +version: 0.1.0.0 +synopsis: Parse config files using parsec that generates parse errors + on invalid keys +description: This is yet another entry in Haskell's enourmous collection + of config-file parsing libraries. It lacks many of the + bells and whistles of other config-file parsing libraries, + such as hierarchical sections and on-the-fly reloading. On + the other hand, it has a combination of features I was + unable to find in other libraries: + * Keys and values are parsed with configurable parsec + parsers, resulting in flexible syntax and pretty error + messages. + * Custom parsers can be created with parsec to handle + values of any type. + * Keys that aren't explicitly handled result in parse + errors. + + If you don't need all of these features, there are + probably better libraries out there for you. If you're free + to use its idiosyncratic file format, the config-value + library, in particular, is excelent. +homepage: github.com/protoben/config-parser +license: MIT +license-file: LICENSE +author: Ben Hamlin +maintainer: protob3n@gmail.com +-- copyright: +category: Text +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 + +library + ghc-options: -Wall + exposed-modules: Text.ConfigParser + other-modules: Text.ConfigParser.Util, + Text.ConfigParser.Types, + Text.ConfigParser.Parser + other-extensions: ExistentialQuantification, + RankNTypes, + RecordWildCards + build-depends: base >=4.9 && <4.10, + parsec >=3.1 && <3.2 + -- hs-source-dirs: + default-language: Haskell2010 + +test-suite parsing + ghc-options: -Wall + other-modules: Text.ConfigParser.Util, + Text.ConfigParser.Types, + Text.ConfigParser.Parser, + Text.ConfigParser + type: exitcode-stdio-1.0 + main-is: tests/Parsing.hs + default-language: Haskell2010 + build-depends: base >=4.9 && <4.10, + hspec >=2.4 && <2.5, + lens >=4.15 && <4.16, + parsec >=3.1 && <3.2, + text >=1.2 && <1.3 diff --git a/tests/Parsing.hs b/tests/Parsing.hs new file mode 100644 --- /dev/null +++ b/tests/Parsing.hs @@ -0,0 +1,736 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +module Main where + +import Prelude hiding (unlines) + +import Control.Lens +import Control.Monad (void) +import Data.Int (Int8) +import Data.Text (unlines) +import Data.Word (Word8) +import Test.Hspec +import Text.Parsec (ParseError) +import Text.Parsec (parse, errorPos, sourceLine, eof, getInput, spaces) +import Text.Parsec.Text (Parser) +import qualified Text.Parsec as P (string) + +import Text.ConfigParser.Types +import Text.ConfigParser.Parser + +data C = C + { _f1 :: String + , _f2 :: Integer + , _f3 :: Bool + , _f4 :: [String] + , _f5 :: [Integer] + , _f6 :: [Bool] + , _f7 :: [[Integer]] + } deriving (Show, Eq) + +makeLenses ''C + +defC :: C +defC = C + { _f1 = "def" + , _f2 = 0 + , _f3 = False + , _f4 = [] + , _f5 = [] + , _f6 = [] + , _f7 = [] + } + +co1,co2,co3,co4,co5,co6,co7 :: ConfigOption C +co1 = ConfigOption + { key = "f1" + , action = set' f1 + , parser = string + } +co2 = ConfigOption + { key = "f2" + , action = set' f2 + , parser = integer + } +co3 = ConfigOption + { key = "f3" + , action = set' f3 + , parser = bool + } +co4 = ConfigOption + { key = "f4" + , action = set' f4 + , parser = list string + } +co5 = ConfigOption + { key = "f5" + , action = set' f5 + , parser = list integer + } +co6 = ConfigOption + { key = "f6" + , action = set' f6 + , parser = list bool + } +co7 = ConfigOption + { key = "f7" + , action = set' f7 + , parser = list (list 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] + 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 + _ -> expectationFailure $ show e + +main :: IO () +main = mapM_ hspec + [ testString + , testInteger + , testBoundedIntegral + , testBool + , testList + , testDefaultKeyValue + , testActionParser + , testRemoveLineComments + , testRemoveExtraSpaces + , testRemoveExtraLines + , testConfig + ] + +testString :: Spec +testString = describe "string" $ do + it "parses a string" $ + parse string' "test" "\"foo\"" `shouldBe` Right "foo" + it "parses a string with a literal 'n' in it" $ + parse string' "test" "\"foonbar\"" `shouldBe` Right "foonbar" + it "parses a string with a quote at the start" $ + parse string' "test" "\"\\\"bar\"" `shouldBe` Right "\"bar" + it "parses a string with a quote in the middle" $ + parse string' "test" "\"foo\\\"bar\"" `shouldBe` Right "foo\"bar" + it "parses a string with a quote at the end" $ + parse string' "test" "\"foo\\\"\"" `shouldBe` Right "foo\"" + it "parses a string with a newline at the start" $ + parse string' "test" "\"\\nbar\"" `shouldBe` Right "\nbar" + it "parses a string with a newline in the middle" $ + parse string' "test" "\"foo\\nbar\"" `shouldBe` Right "foo\nbar" + it "parses a string with a newline at the end" $ + parse string' "test" "\"foo\\n\"" `shouldBe` Right "foo\n" + it "parses a string with a backslash at the start" $ + parse string' "test" "\"\\\\bar\"" `shouldBe` Right "\\bar" + it "parses a string with a backslash in the middle" $ + parse string' "test" "\"foo\\\\bar\"" `shouldBe` Right "foo\\bar" + it "parses a string with a backslash in front of a quote" $ + parse string' "test" "\"foo\\\\\\\"bar\"" `shouldBe` Right "foo\\\"bar" + it "parses a string with a literal backslash-n" $ + parse string' "test" "\"foo\\\\nbar\"" `shouldBe` Right "foo\\nbar" + it "parses a string with a backslash at the end" $ + parse string' "test" "\"foo\\\\\"" `shouldBe` Right "foo\\" + it "ends a string at the first quote" $ + parse (string' <* eof) "test" "\"foo\"bar\"" `shouldFailOnLine` 1 + it "errors on an unterminated string" $ + parse string' "test" "\"foo" `shouldFailOnLine` 1 + it "errors on a newline inside a string" $ + parse string' "test" "\"foo\nbar\"" `shouldFailOnLine` 1 + where + string' = string :: Parser String + +testInteger :: Spec +testInteger = describe "integer" $ do + it "parses a positive integer" $ + parse integer "test" "42" `shouldBe` Right 42 + it "parses a negative integer" $ + parse integer "test" "-42" `shouldBe` Right (-42) + it "parses a zero" $ + parse integer "test" "0" `shouldBe` Right 0 + it "ignores initial zeroes" $ + parse integer "test" "000042" `shouldBe` Right 42 + +testBoundedIntegral :: Spec +testBoundedIntegral = describe "boundedIntegral" $ do + it "parses negative values in range" $ + parse int8 "test" "-128" `shouldBe` Right (-128) + it "parses positive values in range" $ + parse int8 "test" "127" `shouldBe` Right 127 + it "parses unsigned values in range" $ + parse word8 "test" "0" `shouldBe` Right 0 + it "bounds signed values below" $ + parse int8 "test" "-129" `shouldFailOnLine` 1 + it "bounds signed values above" $ + parse int8 "test" "128" `shouldFailOnLine` 1 + it "bounds unsigned values below" $ + parse word8 "test" "-1" `shouldFailOnLine` 1 + it "bounds unsigned values above" $ + parse word8 "test" "256" `shouldFailOnLine` 1 + where + int8 = boundedIntegral :: Parser Int8 + word8 = boundedIntegral :: Parser Word8 + +testBool :: Spec +testBool = describe "bool" $ do + it "parses \"true\"" $ + parse bool "test" "true" `shouldBe` Right True + it "parses \"True\"" $ + parse bool "test" "True" `shouldBe` Right True + it "parses \"on\"" $ + parse bool "test" "on" `shouldBe` Right True + it "parses \"On\"" $ + parse bool "test" "On" `shouldBe` Right True + it "parses \"yes\"" $ + parse bool "test" "yes" `shouldBe` Right True + it "parses \"Yes\"" $ + parse bool "test" "Yes" `shouldBe` Right True + it "parses \"false\"" $ + parse bool "test" "false" `shouldBe` Right False + it "parses \"False\"" $ + parse bool "test" "False" `shouldBe` Right False + it "parses \"off\"" $ + parse bool "test" "off" `shouldBe` Right False + it "parses \"Off\"" $ + parse bool "test" "Off" `shouldBe` Right False + it "parses \"no\"" $ + parse bool "test" "no" `shouldBe` Right False + it "parses \"No\"" $ + parse bool "test" "No" `shouldBe` Right False + +testList :: Spec +testList = describe "list" $ do + it "parses an empty list" $ + parse (list integer) "test" "[]" `shouldBe` Right [] + it "parses an empty list with spaces in it" $ + parse (list integer) "test" "[ ]" `shouldBe` Right [] + it "parses an empty list with a newline in it" $ + parse (list integer) "test" "[\n]" `shouldBe` Right [] + it "parses a singleton" $ + parse (list integer) "test" "[42]" `shouldBe` Right [42] + it "parses a singleton with spaces in it" $ + parse (list integer) "test" "[ 42 ]" `shouldBe` Right [42] + it "parses a singleton with newlines in it" $ + parse (list integer) "test" "[\n42\n]" `shouldBe` Right [42] + it "parses a list with multiple elements" $ + parse (list integer) "test" "[42,43,44]" `shouldBe` Right [42,43,44] + it "parses a list with multiple elements with spaces in it" $ + parse (list integer) "test" "[ 42 , 43 , 44 ]" + `shouldBe` Right [42,43,44] + it "parses a list with multiple elements with newlines in it" $ + parse (list integer) "test" "[\n42\n,\n43\n,\n44\n]" + `shouldBe` Right [42,43,44] + it "parses a nested list" $ + parse (list (list integer)) "test" "[[],[42],[42,43,44]]" + `shouldBe` Right [[],[42],[42,43,44]] + it "fails on an unterminated list with no elements" $ + parse (list integer) "test" "[" `shouldFailOnLine` 1 + it "fails on an unterminated list with elements" $ + parse (list integer) "test" "[42,43" `shouldFailOnLine` 1 + 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 \"=\"" $ + parse (defaultKeyValue "foo" integer) "test" "foo=42" + `shouldBe` Right 42 + it "parses \" = \"" $ + parse (defaultKeyValue "foo" integer) "test" "foo = 42" + `shouldBe` Right 42 + it "parses \"\\t=\\t\"" $ + parse (defaultKeyValue "foo" integer) "test" "foo\t=\t42" + `shouldBe` Right 42 + it "parses \"\\n=\\n\"" $ + parse (defaultKeyValue "foo" integer) "test" "foo\n=\n42" + `shouldBe` Right 42 + it "parses \"\\n =\\n \"" $ + parse (defaultKeyValue "foo" integer) "test" "foo\n =\n 42" + `shouldBe` Right 42 + it "parses \" \\n= \\n\"" $ + parse (defaultKeyValue "foo" integer) "test" "foo \n= \n42" + `shouldBe` Right 42 + it "fails on incorrect key" $ + parse (defaultKeyValue "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" $ + parse removeLineComments' "test" "" `shouldBe` Right "" + it "preserves a file with one simple line" $ + parse removeLineComments' "test" "foobaz" `shouldBe` Right "foobaz" + it "preserves spaces in the middle of a simple line" $ + parse removeLineComments' "test" "foo baz" + `shouldBe` Right "foo baz" + it "preserves a simple multiline file" $ + parse removeLineComments' "test" "foo\nbar\nzap" + `shouldBe` Right "foo\nbar\nzap" + it "preserves a multiline file with spaces" $ + parse removeLineComments' "test" "foo\nwiz woz\nzap" + `shouldBe` Right "foo\nwiz woz\nzap" + it "removes a lone comment with no spaces" $ + parse removeLineComments' "test" "#foo" `shouldBe` Right "\n" + it "removes a lone comment preceded by spaces" $ + parse removeLineComments' "test" " #foo" `shouldBe` Right " \n" + it "removes a lone comment followed by spaces" $ + parse removeLineComments' "test" "#foo " `shouldBe` Right "\n" + it "removes a lone comment starting with spaces" $ + parse removeLineComments' "test" "# foo" `shouldBe` Right "\n" + it "removes a lone comment with spaces in the middle" $ + parse removeLineComments' "test" "#foo bar" `shouldBe` Right "\n" + it "removes a comment before a single input line" $ + parse removeLineComments' "test" "#foobar\nbaz" + `shouldBe` Right "\nbaz" + it "removes a comment after a single input line" $ + parse removeLineComments' "test" "baz\n#foobar" + `shouldBe` Right "baz\n\n" + it "removes a comment after a single input line without spaces" $ + parse removeLineComments' "test" "baz#foobar" `shouldBe` Right "baz\n" + it "removes a comment after a single input line with spaces" $ + parse removeLineComments' "test" "baz #foobar" + `shouldBe` Right "baz \n" + it "removes a comment at the start of a multi-line file" $ + parse removeLineComments' "test" "#foobar\nfoo\nwiz woz\nzap" + `shouldBe` Right "\nfoo\nwiz woz\nzap" + it "removes a full-line comment at the end of a multi-line file" $ + parse removeLineComments' "test" "foo\nwiz woz\nzap\n#foobar" + `shouldBe` Right "foo\nwiz woz\nzap\n\n" + it "removes a line-end comment at the end of a multi-line file" $ + parse removeLineComments' "test" "foo\nwiz woz\nzap #foobar" + `shouldBe` Right "foo\nwiz woz\nzap \n" + it "removes a full-line comment in the middle of a multi-line file" $ + parse removeLineComments' "test" "foo\nwiz woz\n#foobar\nzap" + `shouldBe` Right "foo\nwiz woz\n\nzap" + it "removes a line-end comment in the middle of a multi-line file" $ + parse removeLineComments' "test" "foo\nwiz woz #foobar\nzap #foobar" + `shouldBe` Right "foo\nwiz woz \nzap \n" + it "resolves an escaped `#` at the start of a line" $ + parse removeLineComments' "test" "\\#bar" `shouldBe` Right "#bar" + it "resolves an escaped `#` at the end of a line" $ + parse removeLineComments' "test" "foo\\#" `shouldBe` Right "foo#" + it "resolves an escaped `#` in the middle of a line" $ + parse removeLineComments' "test" "foo\\#bar" `shouldBe` Right "foo#bar" + it "allows an unescaped `\\`" $ + parse removeLineComments' "test" "\\" `shouldBe` Right "\\" + it "permits a literal `\\#` represented as `\\\\#'" $ + parse removeLineComments' "test" "\\\\#" `shouldBe` Right "\\#" + it "permits an escaped `#` in a comment" $ + parse removeLineComments' "test" "#foobaz\\#asdf " `shouldBe` Right "\n" + 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" $ + parse p "test" "" `shouldBe` Right defC + it "parses a config file with just empty lines" $ + parse p "test" (unlines + [ "" + , "\t" + , " " + ]) `shouldBe` Right defC + it "parses a config file with just a line comment" $ do + parse p "test" "# foo" `shouldBe` Right defC + it "parses a config file with just one line" $ + parse p "test" "f1 = \"foo\"" `shouldBe` Right defC {_f1 = "foo"} + it "parses a string with escape sequences in it" $ + parse p "test" "f1 = \"foo\\n\\\"\\\\\"" + `shouldBe` Right defC {_f1 = "foo\n\"\\"} + it "parses multiple in-order options from a config file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "parses multiple out-of-order options from a config file" $ + parse p "test" (unlines + [ "f4 = [\"foo\",\"bar\"]" + , "f2 = 9001" + , "f1 = \"foo\"" + , "f3 = True" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a comment at the top of a config file" $ + parse p "test" (unlines + [ "# I'm a comment" + , "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a comment in the middle of a config file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "# I'm a comment" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a comment at the end of a config file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + , "# I'm a comment" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a comment at the end of a line" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True # I'm a comment" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a comment at the end of a line and file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5] # I'm a comment" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a newline at the top of a config file" $ + parse p "test" (unlines + [ "" + , "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a newline in the middle of a config file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows a newline at the end of a config file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + , "" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows whitespace at the start of a line" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , " \r\v\tf3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows whitespace at the start of a line and file" $ + parse p "test" (unlines + [ " \r\v\tf1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows whitespace at the end of a line" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True \r\v\t" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows whitespace at the end of a line and file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5] \r\v\t" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows empty lines at the start of a file" $ + parse p "test" (unlines + [ " \r\v\t" + , "" + , "" + , "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows empty lines in the middle of a file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , " \r\v\t" + , "" + , "" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "allows empty lines at the end of a file" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True" + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + , "" + , "" + , " \r\v\t" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "parses an alternative key-value syntax" $ + parse p' "test" (unlines + [ "\"foo\" -> f1" + , "9001 -> f2" + , "True -> f3" + , "[\"foo\",\"bar\"] -> f4" + , "[1,2,3,4,5] -> f5" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "parses an alternative comment syntax" $ + parse p' "test" (unlines + [ "\"foo\" -> f1" + , "9001 -> f2" + , "True -> f3" + , "-- This is a comment" + , "[\"foo\",\"bar\"] -> f4" + , "[1,2,3,4,5] -> f5" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "parses an multiple comment syntaxes" $ + parse p' "test" (unlines + [ "\"foo\" -> f1" + , "9001 -> f2" + , "True -> f3" + , "// This is a comment" + , "[\"foo\",\"bar\"] -> f4" + , "[1,2,3,4,5] -> f5" + ]) `shouldBe` Right defC + { _f1 = "foo" + , _f2 = 9001 + , _f3 = True + , _f4 = ["foo","bar"] + , _f5 = [1,2,3,4,5] + } + it "errors on non-existent keys" $ + parse p "test" (unlines + [ "f1 = \"foo\"" + , "f2 = 9001" + , "f3 = True " + , "f4 = [\"foo\",\"bar\"]" + , "f5 = [1,2,3,4,5]" + , "badkey = 9999" + ]) `shouldFailOnLine` 6