diff --git a/hsini.cabal b/hsini.cabal --- a/hsini.cabal +++ b/hsini.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hsini -version: 0.5.2 +version: 0.5.2.1 synopsis: ini configuration files description: Library for reading and writing configuration files in INI format (see ). @@ -26,12 +26,12 @@ hs-source-dirs: src build-depends: , base <5 - , bytestring , containers , mtl , parsec default-language: Haskell2010 + ghc-options: -Wall -Wunused-packages test-suite hsini-tests type: exitcode-stdio-1.0 @@ -43,10 +43,7 @@ hs-source-dirs: tst build-depends: , base <5 - , bytestring - , containers , hsini - , mtl , parsec , tasty , tasty-hunit @@ -54,3 +51,4 @@ , tasty-th default-language: Haskell2010 + ghc-options: -Wall -Wunused-packages diff --git a/src/Data/Ini/Reader/Internals.hs b/src/Data/Ini/Reader/Internals.hs --- a/src/Data/Ini/Reader/Internals.hs +++ b/src/Data/Ini/Reader/Internals.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ImportQualifiedPost #-} {- | Module : Data.Ini.Reader.Internals @@ -10,9 +9,9 @@ -} module Data.Ini.Reader.Internals where -import Control.Monad.Except (MonadError (throwError), liftM) +import Control.Monad (void) +import Control.Monad.Except (MonadError (throwError)) import Control.Monad.State (evalState, get, put) -import Data.ByteString qualified as BS import Text.Parsec as P ( anyChar, char, @@ -56,10 +55,10 @@ -- merge together OptionL and subsequent OptionContL items mergeOptions [] = return [] - mergeOptions (s@(SectionL _) : ifs) = (s :) `fmap` mergeOptions ifs - mergeOptions (CommentL : ifs) = (CommentL :) `fmap` mergeOptions ifs - mergeOptions (OptionL on ov : OptionContL ov2 : ifs) = mergeOptions $ OptionL on (ov ++ ov2) : ifs - mergeOptions (o@(OptionL on ov) : ifs) = (o :) `fmap` mergeOptions ifs + mergeOptions (s@(SectionL _) : ifs') = (s :) `fmap` mergeOptions ifs' + mergeOptions (CommentL : ifs') = (CommentL :) `fmap` mergeOptions ifs' + mergeOptions (OptionL on ov : OptionContL ov2 : ifs') = mergeOptions $ OptionL on (ov ++ ov2) : ifs' + mergeOptions (o@(OptionL _ _) : ifs') = (o :) `fmap` mergeOptions ifs' mergeOptions _ = throwError $ IniSyntaxError "Syntax error in INI file." -- build the configuration from a [IniFile] @@ -69,6 +68,7 @@ sn <- get let na = setOption sn on ov a buildit na is + buildit _ _ = undefined in mergeOptions fIfs >>= \is -> return $ evalState (buildit emptyConfig is) "default" @@ -86,12 +86,12 @@ validSecNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "._-/@\" " in do - char '[' - eatWhiteSpace + void $ char '[' + void eatWhiteSpace sn <- many1 $ oneOf validSecNameChrs - eatWhiteSpace - char ']' - manyTill anyChar newline + void eatWhiteSpace + void $ char ']' + void $ manyTill anyChar newline return $ SectionL sn {- | Parser for a single line of an option. The line must start with an option @@ -105,11 +105,11 @@ validOptNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "_-/@ " in do - eatWhiteSpace + void eatWhiteSpace on <- many1 $ oneOf validOptNameChrs - eatWhiteSpace - char '=' - eatWhiteSpace + void eatWhiteSpace + void $ char '=' + void eatWhiteSpace ov <- manyTill anyChar newline return $ OptionL on ov @@ -120,8 +120,8 @@ -} optContParser :: Parser IniFile optContParser = do - oneOf " \t" - eatWhiteSpace + void $ oneOf " \t" + void eatWhiteSpace oc <- noneOf " \t" ov <- manyTill anyChar newline return $ OptionContL $ oc : ov @@ -134,7 +134,7 @@ noiseParser = let commentP = do - oneOf "#;" + void $ oneOf "#;" manyTill anyChar newline emptyL = newline >> return "" in diff --git a/tst/Ini.hs b/tst/Ini.hs --- a/tst/Ini.hs +++ b/tst/Ini.hs @@ -7,33 +7,37 @@ ) where -- {{{1 imports -import Data.Maybe -import Test.Tasty -import Test.Tasty.QuickCheck -import Test.Tasty.TH +import Data.Maybe (fromJust, isJust, isNothing) +import Test.Tasty (TestTree) +import Test.Tasty.QuickCheck (Property, testProperty, (==>)) +import Test.Tasty.TH (testGroupGenerator) -import Data.Ini -import Data.Ini.Types +import Data.Ini (allItems, delOption, delSection, getOption, getSection, hasOption, hasSection, setOption) +import Data.Ini.Types (OptionName, OptionValue, SectionName, cfgFromList, cfgToList) -- {{{1 section properties -- adding and then deleting a section is a no-op (if the section doesn't exist -- already) +prop_secAddDel :: [Char] -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_secAddDel sn cfglst = delSection sn (setOption sn "foo" "bar" cfg2) == cfg2 where cfg = cfgFromList cfglst cfg2 = delSection sn cfg -- must make sure the section doesn't exist before adding -- after adding a section the config has such a section +prop_secAddHas :: SectionName -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_secAddHas sn cfglst = hasSection sn (setOption sn "foo" "bar" cfg) where cfg = cfgFromList cfglst -- after adding a section it's possible to get it +prop_secAddGet :: SectionName -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_secAddGet sn cfglst = isJust $ getSection sn (setOption sn "foo" "bar" cfg) where cfg = cfgFromList cfglst -- after deleting a section it's gone +prop_secDelGet :: [Char] -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_secDelGet sn cfglst = isNothing $ getSection sn $ delSection sn cfg2 where cfg = cfgFromList cfglst @@ -42,28 +46,33 @@ -- {{{1 option properties -- setting and then deleting an option is a no-op (if the option doesn't exist -- already) +prop_optSetDel :: [Char] -> [Char] -> OptionValue -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_optSetDel sn on ov cfglst = delOption sn on (setOption sn on ov cfg) == cfg2 where cfg = cfgFromList cfglst cfg2 = delOption sn on cfg -- after setting an option it's there +prop_optSetHas :: SectionName -> OptionName -> OptionValue -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_optSetHas sn on ov cfglst = hasOption sn on (setOption sn on ov cfg) where cfg = cfgFromList cfglst -- after setting an option it's possible to get it +prop_optSetGet :: SectionName -> OptionName -> OptionValue -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_optSetGet sn on ov cfglst = isJust $ getOption sn on $ setOption sn on ov cfg where cfg = cfgFromList cfglst -- after deleting a section it's gone +prop_optDelGet :: [Char] -> [Char] -> [Char] -> [(SectionName, [(OptionName, OptionValue)])] -> Bool prop_optDelGet sn on ov cfglst = isNothing $ getOption sn on $ delOption sn on cfg2 where cfg = cfgFromList cfglst cfg2 = setOption sn on ov cfg -- getting all items +prop_optAllItems :: [(SectionName, [(OptionName, OptionValue)])] -> Property prop_optAllItems cfglst = not (null _cfglst) ==> lstItems == allItems sn cfg where cfg = cfgFromList cfglst diff --git a/tst/ReaderI.hs b/tst/ReaderI.hs --- a/tst/ReaderI.hs +++ b/tst/ReaderI.hs @@ -7,15 +7,23 @@ allTests, ) where -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.TH -import Text.ParserCombinators.Parsec as P +import Test.Tasty (TestTree) +import Test.Tasty.HUnit (Assertion, testCase, (@=?)) +import Test.Tasty.TH (testGroupGenerator) +import Text.ParserCombinators.Parsec as P (parse, Parser) -import Data.Ini.Reader.Internals +import Data.Ini.Reader.Internals ( + IniFile (CommentL, OptionContL, OptionL, SectionL), + iniParser, + noiseParser, + optContParser, + optLineParser, + secParser, + ) -- Convenience function that translates a parser result to something that's -- easier to check. +p2E :: Parser a -> String -> String -> Either String a p2E p s t = let res = P.parse p s t @@ -25,6 +33,7 @@ Right e -> Right e -- {{{1 secParser +case_secParserAllowedChars1 :: Assertion case_secParserAllowedChars1 = let expected = Right $ SectionL "foo" @@ -32,6 +41,7 @@ in expected @=? actual +case_secParserAllowedChars2 :: Assertion case_secParserAllowedChars2 = let expected = Right $ SectionL "FooBar" @@ -39,6 +49,7 @@ in expected @=? actual +case_secParserAllowedChars3 :: Assertion case_secParserAllowedChars3 = let expected = Right $ SectionL "@Foo/Bar-" @@ -46,6 +57,7 @@ in expected @=? actual +case_secParserAllowedChars4 :: Assertion case_secParserAllowedChars4 = let expected = Right $ SectionL "foo123" @@ -53,6 +65,7 @@ in expected @=? actual +case_secParserAllowedChars5 :: Assertion case_secParserAllowedChars5 = let expected = Right $ SectionL "_foo" @@ -60,6 +73,7 @@ in expected @=? actual +case_secParserDropSpace :: Assertion case_secParserDropSpace = let expected = Right $ SectionL "foo" @@ -67,6 +81,7 @@ in expected @=? actual +case_secParserDropTrailing :: Assertion case_secParserDropTrailing = let expected = Right $ SectionL "foo" @@ -74,6 +89,7 @@ in expected @=? actual +case_secParserAllowGit1 :: Assertion case_secParserAllowGit1 = let expected = Right $ SectionL "branch \"master\"" @@ -81,6 +97,7 @@ in expected @=? actual +case_secParserAllowGit2 :: Assertion case_secParserAllowGit2 = let expected = Right $ SectionL "foo \"bar.baz\"" @@ -89,6 +106,7 @@ expected @=? actual -- {{{1 optLineParser +case_optLineParserAllowedChars1 :: Assertion case_optLineParserAllowedChars1 = let expected = Right $ OptionL "foo" "bar" @@ -96,6 +114,7 @@ in expected @=? actual +case_optLineParserAllowedChars2 :: Assertion case_optLineParserAllowedChars2 = let expected = Right $ OptionL "Foo" "bAr" @@ -103,6 +122,7 @@ in expected @=? actual +case_optLineParserAllowedChars3 :: Assertion case_optLineParserAllowedChars3 = let expected = Right $ OptionL "foo@/foo-" "bar" @@ -110,6 +130,7 @@ in expected @=? actual +case_optLineParserAllowedChars4 :: Assertion case_optLineParserAllowedChars4 = let expected = Right $ OptionL "foo123" "bar" @@ -117,6 +138,7 @@ in expected @=? actual +case_optLineParserAllowedChars5 :: Assertion case_optLineParserAllowedChars5 = let expected = Right $ OptionL "_foo" "bar" @@ -124,6 +146,7 @@ in expected @=? actual +case_optLineParserAllowedChars6 :: Assertion case_optLineParserAllowedChars6 = let expected = Right $ OptionL "foo bar" "baz" @@ -131,6 +154,7 @@ in expected @=? actual +case_optLineParserDisallowedChars1 :: Assertion case_optLineParserDisallowedChars1 = let expected = Left "bad" @@ -138,6 +162,7 @@ in expected @=? actual +case_optLineParserDropSpace :: Assertion case_optLineParserDropSpace = let expected = Right $ OptionL "foo" "bar" @@ -145,6 +170,7 @@ in expected @=? actual +case_optLineParserKeepSpace :: Assertion case_optLineParserKeepSpace = let expected = Right $ OptionL "foo" "bar \t \t" @@ -153,6 +179,7 @@ expected @=? actual -- {{{1 optContParser +case_optContParserSpace :: Assertion case_optContParserSpace = let expected = Right $ OptionContL "foo" @@ -160,6 +187,7 @@ in expected @=? actual +case_optContParserTab :: Assertion case_optContParserTab = let expected = Right $ OptionContL "foo" @@ -167,6 +195,7 @@ in expected @=? actual +case_optContParserKeepTrailing :: Assertion case_optContParserKeepTrailing = let expected = Right $ OptionContL "foo \t\t" @@ -175,6 +204,7 @@ expected @=? actual -- {{{1 noiseParser +case_noiseParserEmptyLine :: Assertion case_noiseParserEmptyLine = let expected = Right CommentL @@ -182,6 +212,7 @@ in expected @=? actual +case_noiseParserComment1 :: Assertion case_noiseParserComment1 = let expected = Right CommentL @@ -189,6 +220,7 @@ in expected @=? actual +case_noiseParserComment2 :: Assertion case_noiseParserComment2 = let expected = Right CommentL @@ -196,6 +228,7 @@ in expected @=? actual +case_noiseParserNonEmpty :: Assertion case_noiseParserNonEmpty = let expected = Left "bad"