packages feed

hsini (empty) → 0.1

raw patch · 10 files changed

+536/−0 lines, 10 filesdep +HUnitdep +QuickCheckdep +basebuild-type:Customsetup-changed

Dependencies added: HUnit, QuickCheck, base, bytestring, containers, mtl, parsec, test-framework, test-framework-hunit, test-framework-quickcheck2, test-framework-th

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,40 @@+#! /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++main = defaultMainWithHooks $ simpleUserHooks+    { cleanHook = profileClean+    , runTests = runTestsBuild+    }++profileClean pd v uh cf = let+        _matchFileGlob g = catch (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.cabal view
@@ -0,0 +1,42 @@+name          : hsini+version       : 0.1+license       : BSD3+license-file  : LICENSE+author        : Magnus Therning+maintainer    : magnus@therning.org+copyright     : Magnus Therning, 2010+synopsis      : Package for user configuration files (INI)+description   : None yet+build-type    : Custom+category      : Network+cabal-version : >= 1.6++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++library+    hs-source-dirs  : src+    build-depends   : base ==4.3.*, bytestring ==0.9.*, containers ==0.4.*, mtl ==2.0.*, 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
+ src/Data/Ini.hs view
@@ -0,0 +1,77 @@+-- |+-- Module    : Data.Ini+-- Copyright : 2011 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 $ do+    s <- getSection sn cfg+    M.lookup on s++-- | 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++-- | 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 = let+        s = getSection sn cfg+        new_s = M.insert on ov M.empty+    in maybe (M.insert sn new_s cfg) (\ sec -> M.insert sn (M.insert on ov sec) cfg) s++-- | Removes the option if it exists.  Empty sections are pruned.+delOption :: SectionName -> OptionName -> Config -> Config+delOption sn on cfg = let+        s = getSection sn cfg+        sEmptyAfterDelete = maybe True (\ sec -> M.empty == M.delete on sec) s+    in if sEmptyAfterDelete+        then M.delete sn cfg+        else maybe cfg (\ sec -> M.insert sn (M.delete on sec) cfg) s++-- | Returns all options and their values of a section.+allItems :: SectionName -> Config -> [(OptionName, OptionValue)]+allItems sn cfg = maybe [] M.toList (getSection sn cfg)
+ src/Data/Ini/Reader.hs view
@@ -0,0 +1,25 @@+-- |+-- Module    : Data.Ini.Reader+-- Copyright : 2011 Magnus Therning+-- License   : BSD3+--+-- Parser for configurations.+module Data.Ini.Reader+    ( parse+    , IniReaderError(..)+    , IniParseResult+    ) where++import Control.Monad.Error+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
+ src/Data/Ini/Reader/Internals.hs view
@@ -0,0 +1,127 @@+-- |+-- Module    : Data.Ini.Reader.Internals+-- Copyright : 2011 Magnus Therning+-- License   : BSD3+--+-- Internal functions used in 'Data.Ini.Reader'.+module Data.Ini.Reader.Internals where++import Control.Monad.Error+import Control.Monad.State+-- import Text.ParserCombinators.Parsec as P+import Text.Parsec as P+import Text.Parsec.String+import qualified Data.ByteString as BS++import Data.Ini+import Data.Ini.Types++data IniReaderError+    = IniParserError String+    | IniSyntaxError String+    | IniOtherError String+    deriving (Eq, Show)++instance Error IniReaderError where+    noMsg = IniOtherError "Unknown error"+    strMsg s = IniOtherError s++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'] ++ "-/@"+    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'] ++ "-/@"+    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+            char '#'+            manyTill anyChar newline+        emptyL = newline >> return ""+    in choice [commentP, emptyL] >> return CommentL++iniParser :: Parser [IniFile]+iniParser = do+    many noiseParser+    s1 <- secParser+    r <- many $ choice [secParser, optLineParser, optContParser, noiseParser]+    return (s1:r)
+ src/Data/Ini/Types.hs view
@@ -0,0 +1,22 @@+-- |+-- Module    : Data.Ini.Types+-- Copyright : 2011 Magnus Therning+-- License   : BSD3+module Data.Ini.Types where++import qualified Data.Map 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 (\ (sn, ol) -> (sn, M.fromList ol))++cfgToList :: Config -> [(SectionName, [(OptionName, OptionValue)])]+cfgToList = M.toList . M.map M.toList
+ tst/Ini.hs view
@@ -0,0 +1,71 @@+{-# 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)
+ tst/Main.hs view
@@ -0,0 +1,13 @@+-- Copyright : 2011 Magnus Therning+-- License   : BSD3+module Main where++import Test.Framework++import qualified Ini as I+import qualified ReaderI as RI++main = defaultMain+    [ I.allTests+    , RI.allTests+    ]
+ tst/ReaderI.hs view
@@ -0,0 +1,92 @@+{-# 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)