hsini-0.5.0/src/0000755000000000000000000000000012765457375011630 5ustar0000000000000000hsini-0.5.0/src/Data/0000755000000000000000000000000012765457375012501 5ustar0000000000000000hsini-0.5.0/src/Data/Ini/0000755000000000000000000000000012765457375013220 5ustar0000000000000000hsini-0.5.0/src/Data/Ini/Reader/0000755000000000000000000000000012765457375014422 5ustar0000000000000000hsini-0.5.0/tst/0000755000000000000000000000000012765457375011653 5ustar0000000000000000hsini-0.5.0/src/Data/Ini.hs0000644000000000000000000000472712765457375013566 0ustar0000000000000000-- | -- 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 qualified Data.Map as M import Data.Maybe import Data.Ini.Types -- {{{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.0/src/Data/Ini/Types.hs0000644000000000000000000000117012765457375014657 0ustar0000000000000000-- | -- Module : Data.Ini.Types -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module Data.Ini.Types where import qualified Data.Map as M import Control.Arrow (second) 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.0/src/Data/Ini/Reader.hs0000644000000000000000000000115412765457375014757 0ustar0000000000000000-- | -- 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 import qualified Text.ParserCombinators.Parsec as P import Data.Ini.Types import Data.Ini.Reader.Internals -- | Parser for a configuration contained in a 'String'. parse :: String -> IniParseResult Config parse s = let pr = P.parse iniParser "ini" s in case pr of Left e -> throwError . IniParserError $ show e Right is -> buildConfig is hsini-0.5.0/src/Data/Ini/Reader/Internals.hs0000644000000000000000000001003712765457375016716 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 import Control.Monad.State import qualified Data.ByteString as BS import Text.Parsec as P import Text.Parsec.String import Data.Ini import Data.Ini.Types 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 :) `liftM` mergeOptions ifs mergeOptions (CommentL : ifs ) = (CommentL :) `liftM` mergeOptions ifs mergeOptions (OptionL on ov : OptionContL ov2 : ifs) = mergeOptions $ (OptionL on (ov ++ ov2)) : ifs mergeOptions (o@(OptionL on ov) : ifs) = (o :) `liftM` 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 in mergeOptions fIfs >>= (\ is -> return . fst $ runState (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 = let validSecNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "._-/@\" " in do char '[' eatWhiteSpace sn <- many1 $ oneOf validSecNameChrs eatWhiteSpace char ']' manyTill anyChar newline return $ SectionL sn -- | 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 = let validOptNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_-/@" in do on <- many1 $ oneOf validOptNameChrs eatWhiteSpace char '=' eatWhiteSpace ov <- manyTill anyChar newline return $ OptionL on ov -- | 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 = do oneOf " \t" eatWhiteSpace oc <- noneOf " \t" ov <- manyTill anyChar newline return $ OptionContL $ oc:ov -- | 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 = do oneOf "#;" manyTill anyChar newline emptyL = newline >> return "" in choice [commentP, emptyL] >> return CommentL iniParser :: Parser [IniFile] iniParser = many $ choice [secParser, optLineParser, optContParser, noiseParser] hsini-0.5.0/tst/Main.hs0000644000000000000000000000043012765457375013070 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.0/src/Data/Ini.hs0000644000000000000000000000472712765457375013566 0ustar0000000000000000-- | -- 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 qualified Data.Map as M import Data.Maybe import Data.Ini.Types -- {{{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.0/src/Data/Ini/Reader/Internals.hs0000644000000000000000000001003712765457375016716 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 import Control.Monad.State import qualified Data.ByteString as BS import Text.Parsec as P import Text.Parsec.String import Data.Ini import Data.Ini.Types 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 :) `liftM` mergeOptions ifs mergeOptions (CommentL : ifs ) = (CommentL :) `liftM` mergeOptions ifs mergeOptions (OptionL on ov : OptionContL ov2 : ifs) = mergeOptions $ (OptionL on (ov ++ ov2)) : ifs mergeOptions (o@(OptionL on ov) : ifs) = (o :) `liftM` 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 in mergeOptions fIfs >>= (\ is -> return . fst $ runState (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 = let validSecNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "._-/@\" " in do char '[' eatWhiteSpace sn <- many1 $ oneOf validSecNameChrs eatWhiteSpace char ']' manyTill anyChar newline return $ SectionL sn -- | 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 = let validOptNameChrs = ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_-/@" in do on <- many1 $ oneOf validOptNameChrs eatWhiteSpace char '=' eatWhiteSpace ov <- manyTill anyChar newline return $ OptionL on ov -- | 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 = do oneOf " \t" eatWhiteSpace oc <- noneOf " \t" ov <- manyTill anyChar newline return $ OptionContL $ oc:ov -- | 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 = do oneOf "#;" manyTill anyChar newline emptyL = newline >> return "" in choice [commentP, emptyL] >> return CommentL iniParser :: Parser [IniFile] iniParser = many $ choice [secParser, optLineParser, optContParser, noiseParser] hsini-0.5.0/src/Data/Ini/Types.hs0000644000000000000000000000117012765457375014657 0ustar0000000000000000-- | -- Module : Data.Ini.Types -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module Data.Ini.Types where import qualified Data.Map as M import Control.Arrow (second) 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.0/tst/Ini.hs0000644000000000000000000000442412765457375012732 0ustar0000000000000000{-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module Ini ( allTests ) where -- {{{1 imports import Data.Maybe import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.TH 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 :: TestTree allTests = $(testGroupGenerator) hsini-0.5.0/tst/ReaderI.hs0000644000000000000000000001126612765457375013530 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -XTemplateHaskell #-} -- Copyright : 2011-2014 Magnus Therning -- License : BSD3 module ReaderI (allTests ) where import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.TH 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_secParserAllowedChars1 = let expected = Right $ SectionL "foo" actual = p2E secParser "sec" "[foo]\n" in expected @=? actual case_secParserAllowedChars2 = let expected = Right $ SectionL "FooBar" actual = p2E secParser "sec" "[FooBar]\n" in expected @=? actual case_secParserAllowedChars3 = let expected = Right $ SectionL "@Foo/Bar-" actual = p2E secParser "sec" "[@Foo/Bar-]\n" in expected @=? actual case_secParserAllowedChars4 = let expected = Right $ SectionL "foo123" actual = p2E secParser "sec" "[foo123]\n" in expected @=? actual case_secParserAllowedChars5 = 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 case_secParserAllowGit1 = let expected = Right $ SectionL "branch \"master\"" actual = p2E secParser "sec" "[branch \"master\"]\n" in expected @=? actual case_secParserAllowGit2 = let expected = Right $ SectionL "foo \"bar.baz\"" actual = p2E secParser "sec" "[foo \"bar.baz\"]\n" in expected @=? actual -- {{{1 optLineParser case_optLineParserAllowedChars1 = let expected = Right $ OptionL "foo" "bar" actual = p2E optLineParser "optLine" "foo=bar\n" in expected @=? actual case_optLineParserAllowedChars2 = let expected = Right $ OptionL "Foo" "bAr" actual = p2E optLineParser "optLine" "Foo=bAr\n" in expected @=? actual case_optLineParserAllowedChars3 = let expected = Right $ OptionL "foo@/foo-" "bar" actual = p2E optLineParser "optLine" "foo@/foo-=bar\n" in expected @=? actual case_optLineParserAllowedChars4 = let expected = Right $ OptionL "foo123" "bar" actual = p2E optLineParser "optLine" "foo123=bar\n" in expected @=? actual case_optLineParserAllowedChars5 = let expected = Right $ OptionL "_foo" "bar" actual = p2E optLineParser "optLine" "_foo=bar\n" in expected @=? actual case_optLineParserDisallowedChars1 = let expected = Left "bad" actual = p2E optLineParser "optLine" "foo.bar=baz\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_noiseParserComment1 = let expected = Right CommentL actual = p2E noiseParser "noise" "# a comment\n" in expected @=? actual case_noiseParserComment2 = let expected = Right CommentL actual = p2E noiseParser "noise" "; another comment\n" in expected @=? actual 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) hsini-0.5.0/LICENSE0000644000000000000000000000274612765457375012057 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.0/Setup.hs0000755000000000000000000000241712765457375012504 0ustar0000000000000000#! /usr/bin/env runhaskell {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} -- Copyright : 2011 Magnus Therning -- License : BSD3 module Main where import Distribution.Simple import Distribution.PackageDescription import Distribution.Simple.Utils import Distribution.Simple.LocalBuildInfo import System.Cmd import Control.Monad import System.FilePath import System.Directory import System.IO.Error main = defaultMainWithHooks $ simpleUserHooks { cleanHook = profileClean , runTests = runTestsBuild } profileClean pd v uh cf = let _matchFileGlob g = catchIOError (matchFileGlob g) (\ _ -> return []) in do (cleanHook simpleUserHooks) pd v uh cf tixFiles <- _matchFileGlob "*.tix" mapM_ removeFile tixFiles doesDirectoryExist ".hpc" >>= \ d -> when d $ removeDirectoryRecursive ".hpc" runTestsBuild a b pd lbi = let doWithExe bldDir e _ = let _eN = exeName e _exe = bldDir _eN _eN _runTest = do putStrLn $ "** " ++ _eN ++ ":" system _exe >> return () in when (_eN `elem` ["tests"]) _runTest in do (runTests simpleUserHooks) a b pd lbi withExeLBI pd lbi (doWithExe $ buildDir lbi) hsini-0.5.0/hsini.cabal0000644000000000000000000000257412765460015013130 0ustar0000000000000000name: hsini version: 0.5.0 license: BSD3 license-file: LICENSE author: Magnus Therning maintainer: magnus@therning.org copyright: Magnus Therning, 2010-2014 synopsis: Package for user configuration files (INI) description: None yet build-type: Custom category: Configuration, Data cabal-version: >= 1.10 source-repository head type: git location: https://github.com/magthe/hsini.git library hs-source-dirs: src default-language: Haskell2010 build-depends: base >=4.7 && <4.10, bytestring ==0.10.*, containers ==0.5.*, mtl ==2.2.*, parsec ==3.1.* exposed-modules: Data.Ini Data.Ini.Types Data.Ini.Reader other-modules: Data.Ini.Reader.Internals test-suite hsini-tests type: exitcode-stdio-1.0 hs-source-dirs: tst, src main-is: Main.hs other-modules: Data.Ini Data.Ini.Reader.Internals Data.Ini.Types Ini ReaderI default-language: Haskell2010 build-depends: base, containers, bytestring, parsec, mtl, HUnit, tasty, tasty-hunit, tasty-quickcheck, tasty-th, QuickCheck