diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -12,6 +12,7 @@ import Control.Monad import System.FilePath import System.Directory +import System.IO.Error main = defaultMainWithHooks $ simpleUserHooks { cleanHook = profileClean @@ -19,7 +20,7 @@ } profileClean pd v uh cf = let - _matchFileGlob g = catch (matchFileGlob g) (\ _ -> return []) + _matchFileGlob g = catchIOError (matchFileGlob g) (\ _ -> return []) in do (cleanHook simpleUserHooks) pd v uh cf tixFiles <- _matchFileGlob "*.tix" diff --git a/hsini.cabal b/hsini.cabal --- a/hsini.cabal +++ b/hsini.cabal @@ -1,5 +1,5 @@ name : hsini -version : 0.1 +version : 0.2 license : BSD3 license-file : LICENSE author : Magnus Therning @@ -9,34 +9,34 @@ description : None yet build-type : Custom category : Network -cabal-version : >= 1.6 +cabal-version : >= 1.10 source-repository head type : git - location : https : //github.com/magthe/hsini.git - -source-repository this - type : git - location : https : //github.com/magthe/hsini.git - tag : REL_0.1 - -flag Test - description : Enable building of tests - default : False + location : https://github.com/magthe/hsini.git library hs-source-dirs : src - build-depends : base ==4.3.*, bytestring ==0.9.*, containers ==0.4.*, mtl ==2.0.*, parsec ==3.1.* + default-language : Haskell2010 + build-depends : base >=4.2 && <4.7, bytestring >=0.9 && <0.11, + containers >=0.3 && <0.6, mtl >=2.0 && <2.2, parsec ==3.1.* exposed-modules : Data.Ini Data.Ini.Types Data.Ini.Reader other-modules : Data.Ini.Reader.Internals -executable tests - main-is : Main.hs - hs-source-dirs : tst, src - other-modules : Ini ReaderI - if flag(Test) - build-depends : HUnit, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th, QuickCheck - buildable : True - ghc-options : -fhpc - else - buildable : False +test-suite hsini-tests + type: exitcode-stdio-1.0 + hs-source-dirs: tst, src + main-is: Main.hs + default-language : Haskell2010 + build-depends: + base, + containers, + bytestring, + parsec, + mtl, + HUnit, + test-framework, + test-framework-hunit, + test-framework-quickcheck2, + test-framework-th, + QuickCheck diff --git a/src/Data/Ini.hs b/src/Data/Ini.hs --- a/src/Data/Ini.hs +++ b/src/Data/Ini.hs @@ -42,19 +42,15 @@ -- {{{1 options -- | Returns @True@ if the names section has the option. hasOption :: SectionName -> OptionName -> Config -> Bool -hasOption sn on cfg = isJust $ do - s <- getSection sn cfg - M.lookup on s +hasOption sn on cfg = isJust $ getSection sn cfg >>= M.lookup on -- | Returns the value of the option, if it exists. getOption :: SectionName -> OptionName -> Config -> Maybe OptionValue -getOption sn on cfg = do - s <- getSection sn cfg - M.lookup on s +getOption sn on cfg = getSection sn cfg >>= M.lookup on -- | Returns a list of all options in the section. options :: SectionName -> Config -> [OptionName] -options sn cfg = maybe [] (M.keys) (getSection sn cfg) +options sn cfg = maybe [] M.keys (getSection sn cfg) -- | Sets the value of the option, adding it if it doesn't exist. setOption :: SectionName -> OptionName -> OptionValue -> Config -> Config 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 @@ -71,7 +71,7 @@ -- surrounded by any number of white space characters (see 'eatWhiteSpace'). secParser :: Parser IniFile secParser = let - validSecNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ "-/@" + validSecNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_-/@" in do char '[' eatWhiteSpace @@ -87,7 +87,7 @@ -- space characters (see 'eatWhiteSpace'). optLineParser :: Parser IniFile optLineParser = let - validOptNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ "-/@" + validOptNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_-/@" in do on <- many1 $ oneOf validOptNameChrs eatWhiteSpace @@ -114,7 +114,7 @@ noiseParser :: Parser IniFile noiseParser = let commentP = do - char '#' + oneOf "#;" manyTill anyChar newline emptyL = newline >> return "" in choice [commentP, emptyL] >> return CommentL diff --git a/src/Data/Ini/Types.hs b/src/Data/Ini/Types.hs --- a/src/Data/Ini/Types.hs +++ b/src/Data/Ini/Types.hs @@ -5,6 +5,7 @@ module Data.Ini.Types where import qualified Data.Map as M +import Control.Arrow (second) type Config = M.Map SectionName Section @@ -16,7 +17,7 @@ -- useful since Map doesn't have any Serial instance cfgFromList :: [(SectionName, [(OptionName, OptionValue)])] -> Config -cfgFromList = M.fromList . map (\ (sn, ol) -> (sn, M.fromList ol)) +cfgFromList = M.fromList . map (second M.fromList) cfgToList :: Config -> [(SectionName, [(OptionName, OptionValue)])] cfgToList = M.toList . M.map M.toList diff --git a/tst/Ini.hs b/tst/Ini.hs deleted file mode 100644 --- a/tst/Ini.hs +++ /dev/null @@ -1,71 +0,0 @@ -{-# OPTIONS_GHC -XTemplateHaskell #-} --- Copyright : 2011 Magnus Therning --- License : BSD3 -module Ini where - --- {{{1 imports -import Data.List -import Data.Maybe -import Test.Framework -import Test.Framework.TH -import Test.Framework.Providers.QuickCheck2 -import Test.QuickCheck - -import Data.Ini -import Data.Ini.Types - --- {{{1 section properties --- adding and then deleting a section is a no-op (if the section doesn't exist --- already) -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 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 sn cfglst = isJust $ getSection sn (setOption sn "foo" "bar" cfg) - where cfg = cfgFromList cfglst - --- after deleting a section it's gone -prop_secDelGet sn cfglst = isNothing $ getSection sn $ delSection sn cfg2 - where - cfg = cfgFromList cfglst - cfg2 = setOption sn "foo" "bar" cfg - --- {{{1 option properties --- setting and then deleting an option is a no-op (if the option doesn't exist --- already) -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 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 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 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 cfglst = (length _cfglst > 0) ==> lstItems == (allItems sn cfg) - where - cfg = cfgFromList cfglst - _cfglst = cfgToList cfg - -- sn = head . sort $ map fst _cfglst - sn = head $ map fst _cfglst - lstItems = fromJust $ lookup sn _cfglst - --- {{{1 allTests -allTests = $(testGroupGenerator) diff --git a/tst/ReaderI.hs b/tst/ReaderI.hs deleted file mode 100644 --- a/tst/ReaderI.hs +++ /dev/null @@ -1,92 +0,0 @@ -{-# OPTIONS_GHC -XTemplateHaskell #-} --- Copyright : 2011 Magnus Therning --- License : BSD3 -module ReaderI where - -import Test.Framework -import Test.Framework.Providers.HUnit -import Test.Framework.TH -import Test.HUnit.Base -import Text.ParserCombinators.Parsec as P - -import Data.Ini.Reader.Internals - --- Convenience function that translates a parser result to something that's --- easier to check. -p2E p s t = let - res = P.parse p s t - in case res of - Left _ -> Left "bad" - Right e -> Right e - --- {{{1 secParser -case_secParserBasic = let - expected = Right $ SectionL "foo" - actual = p2E secParser "sec" "[foo]\n" - in expected @=? actual - -case_secParserDropSpace = let - expected = Right $ SectionL "foo" - actual = p2E secParser "sec" "[ \tfoo\t ]\n" - in expected @=? actual - -case_secParserDropTrailing = let - expected = Right $ SectionL "foo" - actual = p2E secParser "sec" "[foo] \t foobar\n" - in expected @=? actual - --- {{{1 optLineParser -case_optLineParserBasic = let - expected = Right $ OptionL "foo" "bar" - actual = p2E optLineParser "optLine" "foo=bar\n" - in expected @=? actual - -case_optLineParserDropSpace = let - expected = Right $ OptionL "foo" "bar" - actual = p2E optLineParser "optLine" "foo\t \t=\t \t bar\n" - in expected @=? actual - -case_optLineParserKeepSpace = let - expected = Right $ OptionL "foo" "bar \t \t" - actual = p2E optLineParser "optLine" "foo\t \t=\t \t bar \t \t\n" - in expected @=? actual - --- {{{1 optContParser -case_optContParserSpace = let - expected = Right $ OptionContL "foo" - actual = p2E optContParser "optCont" " foo\n" - in expected @=? actual - -case_optContParserTab = let - expected = Right $OptionContL "foo" - actual = p2E optContParser "optCont" "\tfoo\n" - in expected @=? actual - -case_optContParserKeepTrailing = let - expected = Right $ OptionContL "foo \t\t" - actual = p2E optContParser "optCont" "\tfoo \t\t\n" - in expected @=? actual - --- {{{1 noiseParser -case_noiseParserEmptyLine = let - expected = Right CommentL - actual = p2E noiseParser "noise" "\n" - in expected @=? actual - -case_noiseParserComment = let - expected = Right CommentL - actual = p2E noiseParser "noise" "# a comment\n" - in expected @=? actual - -case_noiseParserNonEmpty = let - expected = Left "bad" - actual = p2E noiseParser "noise" " \n" - in expected @=? actual - --- {{{1 iniParser --- TBD - --- {{{1 buildConfig --- TBD - -allTests = $(testGroupGenerator)