hsini-0.5.2.2/0000755000000000000000000000000007346545000011161 5ustar0000000000000000hsini-0.5.2.2/LICENSE0000644000000000000000000000274607346545000012177 0ustar0000000000000000Copyright (c) 2011, Magnus Therning All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither the name of the author nor the names of contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hsini-0.5.2.2/hsini.cabal0000644000000000000000000000223507346545000013261 0ustar0000000000000000cabal-version: 3.0 name: hsini version: 0.5.2.2 synopsis: ini configuration files description: Library for reading and writing configuration files in INI format (see ). category: Configuration, Data author: Magnus Therning maintainer: Magnus Therning license: BSD-3-Clause license-file: LICENSE build-type: Simple source-repository head type: git location: https://github.com/magthe/hsini.git library exposed-modules: Data.Ini Data.Ini.Reader Data.Ini.Reader.Internals Data.Ini.Types hs-source-dirs: src build-depends: , base <5 , containers , mtl , parsec default-language: Haskell2010 ghc-options: -Wall -Wunused-packages test-suite hsini-tests type: exitcode-stdio-1.0 main-is: Main.hs other-modules: Ini ReaderI hs-source-dirs: tst build-depends: , base <5 , hsini , parsec , tasty , tasty-hunit , tasty-quickcheck , tasty-th default-language: Haskell2010 ghc-options: -Wall -Wunused-packages hsini-0.5.2.2/src/Data/0000755000000000000000000000000007346545000012621 5ustar0000000000000000hsini-0.5.2.2/src/Data/Ini.hs0000644000000000000000000000502407346545000013675 0ustar0000000000000000{-# LANGUAGE ImportQualifiedPost #-} {- | Module : Data.Ini Copyright : 2011-2014 Magnus Therning License : BSD3 A representation of configuration options. It consists of /sections/, each which can contain 0 or more /options/. Each options is a /key/, /value/ pair. This module contains the API for constructing, manipulating, and querying configurations. -} module Data.Ini where -- {{{1 imports import Data.Map qualified as M import Data.Maybe (isJust) import Data.Ini.Types (Config, OptionName, OptionValue, Section, SectionName) -- {{{1 configurations -- | Constructs an empty configuration. emptyConfig :: Config emptyConfig = M.empty -- {{{1 sections -- | Returns @True@ iff the configuration has a section with that name. hasSection :: SectionName -> Config -> Bool hasSection = M.member -- | Returns the section with the given name if it exists in the configuration. getSection :: SectionName -> Config -> Maybe Section getSection = M.lookup -- | Returns a list of the names of all section. sections :: Config -> [SectionName] sections = M.keys -- | Removes the section if it exists. delSection :: SectionName -> Config -> Config delSection = M.delete -- {{{1 options -- | Returns @True@ if the names section has the option. hasOption :: SectionName -> OptionName -> Config -> Bool 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 = 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) -- | Sets the value of the option, adding it if it doesn't exist. setOption :: SectionName -> OptionName -> OptionValue -> Config -> Config setOption sn on ov cfg = maybe (M.insert sn new_s cfg) (\sec -> M.insert sn (M.insert on ov sec) cfg) s where s = getSection sn cfg new_s = M.insert on ov M.empty -- | Removes the option if it exists. Empty sections are pruned. delOption :: SectionName -> OptionName -> Config -> Config delOption sn on cfg = if sEmptyAfterDelete then M.delete sn cfg else maybe cfg (\sec -> M.insert sn (M.delete on sec) cfg) s where s = getSection sn cfg sEmptyAfterDelete = maybe True (\sec -> M.empty == M.delete on sec) s -- | Returns all options and their values of a section. allItems :: SectionName -> Config -> [(OptionName, OptionValue)] allItems sn cfg = maybe [] M.toList (getSection sn cfg) hsini-0.5.2.2/src/Data/Ini/0000755000000000000000000000000007346545000013340 5ustar0000000000000000hsini-0.5.2.2/src/Data/Ini/Reader.hs0000644000000000000000000000126407346545000015101 0ustar0000000000000000{-# LANGUAGE ImportQualifiedPost #-} {- | Module : Data.Ini.Reader Copyright : 2011-2014 Magnus Therning License : BSD3 Parser for configurations. -} module Data.Ini.Reader ( parse, IniReaderError (..), IniParseResult, ) where import Control.Monad.Except (throwError) import Text.ParserCombinators.Parsec qualified as P import Data.Ini.Reader.Internals (IniParseResult, IniReaderError (..), buildConfig, iniParser) import Data.Ini.Types (Config) -- | Parser for a configuration contained in a 'String'. parse :: String -> IniParseResult Config parse s = case P.parse iniParser "ini" s of Left e -> throwError . IniParserError $ show e Right is -> buildConfig is hsini-0.5.2.2/src/Data/Ini/Reader/0000755000000000000000000000000007346545000014542 5ustar0000000000000000hsini-0.5.2.2/src/Data/Ini/Reader/Internals.hs0000644000000000000000000001062007346545000017034 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {- | Module : Data.Ini.Reader.Internals Copyright : 2011-2014 Magnus Therning License : BSD3 Internal functions used in 'Data.Ini.Reader'. -} module Data.Ini.Reader.Internals where import Control.Monad.Except (MonadError (throwError)) import Control.Monad.State (evalState, get, put) import Data.Functor (($>)) import Text.Parsec as P ( anyChar, between, char, choice, many, many1, manyTill, newline, noneOf, oneOf, ) import Text.Parsec.String (Parser) import Data.Char (isSpace) import Data.Ini (emptyConfig, setOption) import Data.Ini.Types (Config) import Data.List (dropWhileEnd) data IniReaderError = IniParserError String | IniSyntaxError String | IniOtherError String deriving (Eq, Show) type IniParseResult = Either IniReaderError -- | The type used to represent a line of a config file. data IniFile = SectionL String | OptionL String String | OptionContL String | CommentL deriving (Show, Eq) -- | Build a configuration from a list of 'IniFile' items. buildConfig :: [IniFile] -> IniParseResult Config buildConfig ifs = let isComment CommentL = True isComment _ = False fIfs = filter (not . isComment) ifs -- 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 _ _) : ifs') = (o :) `fmap` mergeOptions ifs' mergeOptions _ = throwError $ IniSyntaxError "Syntax error in INI file." -- build the configuration from a [IniFile] buildit a [] = return a buildit a (SectionL sn : is) = put sn >> buildit a is buildit a (OptionL on ov : is) = do sn <- get let na = setOption sn on ov a buildit na is buildit _ _ = undefined in mergeOptions fIfs >>= \is -> return $ evalState (buildit emptyConfig is) "default" -- | Consumer of whitespace \"@ \t@\". eatWhiteSpace :: Parser String eatWhiteSpace = many $ oneOf " \t" {- | Parser for the start-of-section line. It expects the line to start with a @[@ then find the section name, and finally a @]@. The section name may be surrounded by any number of white space characters (see 'eatWhiteSpace'). -} secParser :: Parser IniFile secParser = SectionL <$> between sectionNameOpen sectionNameClose sectionName where sectionNameOpen = char '[' *> eatWhiteSpace sectionNameClose = eatWhiteSpace *> char ']' *> manyTill anyChar newline sectionName = many1 $ oneOf validSecNameChrs validSecNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "._-/@\" " {- | Parser for a single line of an option. The line must start with an option name, then a @=@ must be found, and finally the rest of the line is taken as the option value. The equal sign may be surrounded by any number of white space characters (see 'eatWhiteSpace'). -} optLineParser :: Parser IniFile optLineParser = OptionL <$> optionName <*> (optionEqual *> optionValue) where optionName = dropWhileEnd isSpace <$> (eatWhiteSpace *> many1 (oneOf validOptNameChrs)) optionEqual = eatWhiteSpace *> char '=' *> eatWhiteSpace optionValue = manyTill anyChar newline validOptNameChrs = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ "_-/@ " {- | Parser for an option-value continuation line. The line must start with either a space or a tab character (\"@ \t@\"). Everything else on the line, until the newline character, is taken as the continuation of an option value. -} optContParser :: Parser IniFile optContParser = OptionContL <$> value where value = (:) <$> (oneOf " \t" *> eatWhiteSpace *> noneOf " \t") <*> manyTill anyChar newline {- | Parser for "noise" in the configuration file, such as comments and empty lines. (Note that lines containing only space characters will be successfully parsed by 'optContParser'.) -} noiseParser :: Parser IniFile noiseParser = let commentP = oneOf "#;" *> manyTill anyChar newline emptyL = (newline $> "") in choice [commentP, emptyL] $> CommentL iniParser :: Parser [IniFile] iniParser = many $ choice [secParser, optLineParser, optContParser, noiseParser] hsini-0.5.2.2/src/Data/Ini/Types.hs0000644000000000000000000000123007346545000014774 0ustar0000000000000000{-# LANGUAGE ImportQualifiedPost #-} {- | Module : Data.Ini.Types Copyright : 2011-2014 Magnus Therning License : BSD3 -} module Data.Ini.Types where import Control.Arrow (second) import Data.Map qualified as M type Config = M.Map SectionName Section type SectionName = String type Section = M.Map OptionName OptionValue type OptionName = String type OptionValue = String -- useful since Map doesn't have any Serial instance cfgFromList :: [(SectionName, [(OptionName, OptionValue)])] -> Config cfgFromList = M.fromList . map (second M.fromList) cfgToList :: Config -> [(SectionName, [(OptionName, OptionValue)])] cfgToList = M.toList . M.map M.toList hsini-0.5.2.2/tst/0000755000000000000000000000000007346545000011773 5ustar0000000000000000hsini-0.5.2.2/tst/Ini.hs0000644000000000000000000000643307346545000013054 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module Ini ( allTests, ) where -- {{{1 imports import Data.Maybe (fromJust, isJust, isNothing) import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (Property, testProperty, (==>)) import Test.Tasty.TH (testGroupGenerator) 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 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 :: [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 _cfglst = cfgToList cfg -- sn = head . sort $ map fst _cfglst sn = head $ map fst _cfglst lstItems = fromJust $ lookup sn _cfglst -- {{{1 allTests allTests :: TestTree allTests = $(testGroupGenerator) hsini-0.5.2.2/tst/Main.hs0000644000000000000000000000043007346545000013210 0ustar0000000000000000-- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module Main where import Test.Tasty import qualified Ini as I import qualified ReaderI as RI main :: IO () main = defaultMain allTests allTests :: TestTree allTests = testGroup "All tests" [I.allTests, RI.allTests] hsini-0.5.2.2/tst/ReaderI.hs0000644000000000000000000001526107346545000013647 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module ReaderI ( allTests, ) where import Test.Tasty (TestTree) import Test.Tasty.HUnit (Assertion, testCase, (@=?)) import Test.Tasty.TH (testGroupGenerator) import Text.ParserCombinators.Parsec as P (Parser, parse) 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 in case res of Left _ -> Left "bad" Right e -> Right e -- {{{1 secParser case_secParserAllowedChars1 :: Assertion case_secParserAllowedChars1 = let expected = Right $ SectionL "foo" actual = p2E secParser "sec" "[foo]\n" in expected @=? actual case_secParserAllowedChars2 :: Assertion case_secParserAllowedChars2 = let expected = Right $ SectionL "FooBar" actual = p2E secParser "sec" "[FooBar]\n" in expected @=? actual case_secParserAllowedChars3 :: Assertion case_secParserAllowedChars3 = let expected = Right $ SectionL "@Foo/Bar-" actual = p2E secParser "sec" "[@Foo/Bar-]\n" in expected @=? actual case_secParserAllowedChars4 :: Assertion case_secParserAllowedChars4 = let expected = Right $ SectionL "foo123" actual = p2E secParser "sec" "[foo123]\n" in expected @=? actual case_secParserAllowedChars5 :: Assertion case_secParserAllowedChars5 = let expected = Right $ SectionL "_foo" actual = p2E secParser "sec" "[_foo]\n" in expected @=? actual case_secParserDropSpace :: Assertion case_secParserDropSpace = let expected = Right $ SectionL "foo" actual = p2E secParser "sec" "[ \tfoo\t ]\n" in expected @=? actual case_secParserDropTrailing :: Assertion case_secParserDropTrailing = let expected = Right $ SectionL "foo" actual = p2E secParser "sec" "[foo] \t foobar\n" in expected @=? actual case_secParserAllowGit1 :: Assertion case_secParserAllowGit1 = let expected = Right $ SectionL "branch \"master\"" actual = p2E secParser "sec" "[branch \"master\"]\n" in expected @=? actual case_secParserAllowGit2 :: Assertion case_secParserAllowGit2 = let expected = Right $ SectionL "foo \"bar.baz\"" actual = p2E secParser "sec" "[foo \"bar.baz\"]\n" in expected @=? actual -- {{{1 optLineParser case_optLineParserAllowedChars1 :: Assertion case_optLineParserAllowedChars1 = let expected = Right $ OptionL "foo" "bar" actual = p2E optLineParser "optLine" "foo=bar\n" in expected @=? actual case_optLineParserAllowedChars2 :: Assertion case_optLineParserAllowedChars2 = let expected = Right $ OptionL "Foo" "bAr" actual = p2E optLineParser "optLine" "Foo=bAr\n" in expected @=? actual case_optLineParserAllowedChars3 :: Assertion case_optLineParserAllowedChars3 = let expected = Right $ OptionL "foo@/foo-" "bar" actual = p2E optLineParser "optLine" "foo@/foo-=bar\n" in expected @=? actual case_optLineParserAllowedChars4 :: Assertion case_optLineParserAllowedChars4 = let expected = Right $ OptionL "foo123" "bar" actual = p2E optLineParser "optLine" "foo123=bar\n" in expected @=? actual case_optLineParserAllowedChars5 :: Assertion case_optLineParserAllowedChars5 = let expected = Right $ OptionL "_foo" "bar" actual = p2E optLineParser "optLine" "_foo=bar\n" in expected @=? actual case_optLineParserAllowedChars6 :: Assertion case_optLineParserAllowedChars6 = let expected = Right $ OptionL "foo bar" "baz" actual = p2E optLineParser "optLine" "foo bar=baz\n" in expected @=? actual case_optLineParserDisallowedChars1 :: Assertion case_optLineParserDisallowedChars1 = let expected = Left "bad" actual = p2E optLineParser "optLine" "foo.bar=baz\n" in expected @=? actual case_optLineParserDropSpace1 :: Assertion case_optLineParserDropSpace1 = let expected = Right $ OptionL "foo" "bar" actual = p2E optLineParser "optLine" " foo = bar\n" in expected @=? actual case_optLineParserDropSpace2 :: Assertion case_optLineParserDropSpace2 = let expected = Right $ OptionL "foo" "bar" actual = p2E optLineParser "optLine" " \tfoo\t \t=\t \t bar\n" in expected @=? actual case_optLineParserKeepSpace :: Assertion 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 :: Assertion case_optContParserSpace = let expected = Right $ OptionContL "foo" actual = p2E optContParser "optCont" " foo\n" in expected @=? actual case_optContParserTab :: Assertion case_optContParserTab = let expected = Right $ OptionContL "foo" actual = p2E optContParser "optCont" "\tfoo\n" in expected @=? actual case_optContParserKeepTrailing :: Assertion case_optContParserKeepTrailing = let expected = Right $ OptionContL "foo \t\t" actual = p2E optContParser "optCont" "\tfoo \t\t\n" in expected @=? actual -- {{{1 noiseParser case_noiseParserEmptyLine :: Assertion case_noiseParserEmptyLine = let expected = Right CommentL actual = p2E noiseParser "noise" "\n" in expected @=? actual case_noiseParserComment1 :: Assertion case_noiseParserComment1 = let expected = Right CommentL actual = p2E noiseParser "noise" "# a comment\n" in expected @=? actual case_noiseParserComment2 :: Assertion case_noiseParserComment2 = let expected = Right CommentL actual = p2E noiseParser "noise" "; another comment\n" in expected @=? actual case_noiseParserNonEmpty :: Assertion case_noiseParserNonEmpty = let expected = Left "bad" actual = p2E noiseParser "noise" " \n" in expected @=? actual -- {{{1 iniParser case_iniParserEmpty :: Assertion case_iniParserEmpty = expected @=? actual where expected = Right [] actual = p2E iniParser "parsing empty file" "" -- {{{1 buildConfig -- TBD allTests :: TestTree allTests = $(testGroupGenerator)