ConfigFile 1.0.4 → 1.0.5
raw patch · 6 files changed
+134/−79 lines, 6 filesdep +HUnitdep +testpackPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, testpack
API changes (from Hackage documentation)
Files
- ConfigFile.cabal +27/−14
- src/Data/ConfigFile.hs +48/−47
- src/Data/ConfigFile/Lexer.hs +20/−5
- src/Data/ConfigFile/Parser.hs +11/−8
- src/Data/ConfigFile/Types.hs +3/−5
- testsrc/runtests.hs +25/−0
ConfigFile.cabal view
@@ -1,5 +1,5 @@ Name: ConfigFile-Version: 1.0.4+Version: 1.0.5 License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen@@ -23,21 +23,34 @@ It's possible to make a config file parsable by this module, the Unix shell, and make. Stability: Stable-Hs-Source-Dirs: src-Exposed-Modules: Data.ConfigFile,+Build-Type: Simple+Cabal-Version: >=1.2.3++Flag buildtests+ description: Build the executable to run unit tests+ default: False++Library+ Hs-Source-Dirs: src+ Exposed-Modules: Data.ConfigFile, Data.ConfigFile.Types, Data.ConfigFile.Parser-Other-Modules: Data.ConfigFile.Lexer-Extensions: ExistentialQuantification, OverlappingInstances, + Other-Modules: Data.ConfigFile.Lexer+ Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances, TypeSynonymInstances, FlexibleContexts, FlexibleInstances-Build-Depends: parsec, base,- haskell98, mtl, MissingH>=1.0.0, containers-GHC-Options: -O2+ Build-Depends: parsec, base,+ haskell98, mtl, MissingH>=1.0.0, containers+ GHC-Options: -O2 -Wall -Executable: runtests-Buildable: False-Main-Is: runtests.hs-HS-Source-Dirs: testsrc, .-Extensions: ExistentialQuantification, OverlappingInstances,- UndecidableInstances, CPP+Executable runtests+ if flag(buildtests)+ Buildable: True+ Build-depends: HUnit, testpack+ else+ Buildable: False+ Main-Is: runtests.hs+ HS-Source-Dirs: testsrc, src, .+ Extensions: ExistentialQuantification, OverlappingInstances,+ UndecidableInstances, CPP, TypeSynonymInstances, FlexibleContexts,+ FlexibleInstances
src/Data/ConfigFile.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances, OverlappingInstances #-} {- Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org> @@ -21,7 +22,7 @@ Copyright : Copyright (C) 2004-2008 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen <jgoerzen@complete.org> + Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -79,7 +80,7 @@ -- * Configuring the ConfigParser -- $configuringcp- + -- ** Access Functions simpleAccess, interpolatingAccess, @@ -101,11 +102,10 @@ -- * Output Data to_string + ) where -) where import Data.ConfigFile.Types import Data.ConfigFile.Parser-import Data.Map.Utils import Data.Either.Utils import Data.String.Utils import qualified Data.Map as Map@@ -115,9 +115,8 @@ import Control.Monad.Error -- For interpolatingAccess-import Text.ParserCombinators.Parsec.Error(ParseError, messageString,- errorMessages, Message(..))-import Text.ParserCombinators.Parsec(parse)+import Text.ParserCombinators.Parsec.Error (errorMessages, Message(..))+import Text.ParserCombinators.Parsec (parse) ---------------------------------------------------------------------- -- Basic types / default values@@ -218,22 +217,22 @@ defdefaulthandler :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m String -defdefaulthandler cp sectn opt = +defdefaulthandler cp sectn opt = let fm = content cp- lookup s o = do sect <- maybeToEither (NoSection s, - "get " ++ formatSO sectn opt) $ + lookUp s o = do sect <- maybeToEither (NoSection s,+ "get " ++ formatSO sectn opt) $ Map.lookup s fm- maybeToEither (NoOption o, - "get " ++ formatSO sectn opt) $ + maybeToEither (NoOption o,+ "get " ++ formatSO sectn opt) $ Map.lookup o sect trydefault e = if (usedefault cp)- then - lookup "DEFAULT" opt + then+ lookUp "DEFAULT" opt -- Use original error if it's not in DEFAULT either `catchError` (\_ -> throwError e) else throwError e- in - lookup sectn opt `catchError` trydefault+ in+ lookUp sectn opt `catchError` trydefault {- | Combines two 'ConfigParser's into one.@@ -244,14 +243,14 @@ The 'ConfigParser' options in the resulting object will be set as they are in the second one passed to this function. -} merge :: ConfigParser -> ConfigParser -> ConfigParser-merge src dest = +merge src dest = let conv :: String -> String conv = optionxform dest convFM :: CPOptions -> CPOptions convFM = Map.fromList . map (\x -> (conv (fst x), snd x)) . Map.toList mergesects a b = Map.union a b in- dest { content = Map.unionWith mergesects + dest { content = Map.unionWith mergesects (content dest) (Map.map convFM (content src)) } {- | Utility to do a special case merge. -}@@ -313,7 +312,7 @@ {- | Adds the specified section name. Returns a 'SectionAlreadyExists' error if the-section was already present. Otherwise, returns the new +section was already present. Otherwise, returns the new 'ConfigParser' object.-} add_section :: MonadError CPError m => ConfigParser -> SectionSpec -> m ConfigParser@@ -332,7 +331,7 @@ remove_section :: MonadError CPError m => ConfigParser -> SectionSpec -> m ConfigParser remove_section _ "DEFAULT" = throwError $ (NoSection "DEFAULT", "remove_section")-remove_section cp s = +remove_section cp s = if has_section cp s then return $ cp {content = Map.delete s (content cp)} else throwError $ (NoSection s, "remove_section")@@ -344,15 +343,15 @@ remove_option :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m ConfigParser remove_option cp s passedo =- do sectmap <- maybeToEither (NoSection s, - "remove_option " ++ formatSO s passedo) $ + do sectmap <- maybeToEither (NoSection s,+ "remove_option " ++ formatSO s passedo) $ Map.lookup s (content cp) let o = (optionxform cp) passedo let newsect = Map.delete o sectmap let newmap = Map.insert s newsect (content cp) if Map.member o sectmap then return $ cp {content = newmap}- else throwError $ (NoOption o, + else throwError $ (NoOption o, "remove_option " ++ formatSO s passedo) {- | Returns a list of the names of all the options present in the@@ -362,7 +361,7 @@ -} options :: MonadError CPError m => ConfigParser -> SectionSpec -> m [OptionSpec]-options cp x = maybeToEither (NoSection x, "options") $ +options cp x = maybeToEither (NoSection x, "options") $ do o <- Map.lookup x (content cp) return $ Map.keys o@@ -373,7 +372,7 @@ exception could be raised or error returned. -} has_option :: ConfigParser -> SectionSpec -> OptionSpec -> Bool-has_option cp s o = +has_option cp s o = let c = content cp v = do secthash <- Map.lookup s c return $ Map.member (optionxform cp $ o) secthash@@ -381,7 +380,7 @@ {- | The class representing the data types that can be returned by "get". -}-class Get_C a where +class Get_C a where {- | Retrieves a string from the configuration file. When used in a context where a String is expected, returns that string verbatim.@@ -421,7 +420,7 @@ * false -} get :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m a- + instance Get_C String where get cp s o = eitherToMonadError $ (accessfunc cp) cp s o @@ -431,11 +430,12 @@ instance (Num t, Read t) => Get_C t where get = genericget +genericget :: (Read b, MonadError CPError m) => ConfigParser -> SectionSpec -> OptionSpec -> m b genericget cp s o = get cp s o >>= return . read getbool :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m Bool-getbool cp s o = +getbool cp s o = do val <- get cp s o case map toLower . strip $ val of "1" -> return True@@ -451,6 +451,7 @@ _ -> throwError (ParseError $ "couldn't parse bool " ++ val ++ " from " ++ formatSO s o, "getbool") +formatSO :: [Char] -> [Char] -> [Char] formatSO s o = "(" ++ s ++ "/" ++ o ++ ")" @@ -459,7 +460,7 @@ of the given section. Returns an error the section is invalid. -} items :: MonadError CPError m => ConfigParser -> SectionSpec -> m [(OptionSpec, String)]-items cp s = do fm <- maybeToEither (NoSection s, "items") $ +items cp s = do fm <- maybeToEither (NoSection s, "items") $ Map.lookup s (content cp) return $ Map.toList fm @@ -468,8 +469,8 @@ Returns an error if the section does not exist. -} set :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> String -> m ConfigParser-set cp s passedo val = - do sectmap <- maybeToEither (NoSection s, "set " ++ formatSO s passedo) $ +set cp s passedo val =+ do sectmap <- maybeToEither (NoSection s, "set " ++ formatSO s passedo) $ Map.lookup s (content cp) let o = (optionxform cp) passedo let newsect = Map.insert o val sectmap@@ -481,7 +482,7 @@ This can be used with bool values, as well as numeric ones. Returns an error if the section does not exist. -}-setshow :: (Show a, MonadError CPError m) => +setshow :: (Show a, MonadError CPError m) => ConfigParser -> SectionSpec -> OptionSpec -> a -> m ConfigParser setshow cp s o val = set cp s o (show val) @@ -497,8 +498,8 @@ The result is, however, guaranteed to parse the same as the original input. -} to_string :: ConfigParser -> String-to_string cp = - let gen_option (key, value) = +to_string cp =+ let gen_option (key, value) = key ++ ": " ++ (replace "\n" "\n " value) ++ "\n" gen_section (sect, valfm) = -- gen a section, but omit DEFAULT if empty if (sect /= "DEFAULT") || (Map.size valfm > 0)@@ -594,7 +595,7 @@ >inputfile = /etc/passwd >names = Peter, Paul, Mary, George, Abrahaham, John, Bill, Gerald, Richard, > Franklin, Woodrow->color = red +>color = red This defines a file without any explicit section, so all items will occur within the default section @DEFAULT@. The @debug@ option can be read@@ -603,21 +604,21 @@ whitespace, and containing something other than whitespace or comments, is taken as a continuation of the previous line. -Here's another example: +Here's another example: ># Default options >[DEFAULT]->hostname: localhost +>hostname: localhost ># Options for the first file >[file1] >location: /usr/local >user: Fred >uid: 1000->optionaltext: Hello, this entire string is included +>optionaltext: Hello, this entire string is included >[file2] >location: /opt >user: Fred->uid: 1001 +>uid: 1001 This file defines three sections. The @DEFAULT@ section specifies an entry @hostname@. If you attempt to read the hostname option in any@@ -634,7 +635,7 @@ before\/after the colon or equal sign if they like, and it will be automatically stripped. -Blank lines or lines consisting solely of whitespace are ignored. +Blank lines or lines consisting solely of whitespace are ignored. A line giving an option or a section name may not begin with white space. This requirement is necessary so there is no ambiguity between such lines@@ -649,7 +650,7 @@ of the line. Comments /may not/ occur within the definitions of options; that is, you-may not place a comment in the middle of a line such as @user: Fred@. +may not place a comment in the middle of a line such as @user: Fred@. That is because the parser considers the comment characters part of the string; otherwise, you'd be unable to use those characters in your strings. You can, however, \"comment out\" options by putting the@@ -673,8 +674,8 @@ >arch = i386 >project = test >filename = test_%(arch)s.c->dir = /usr/src/%(filename)s ->percent = 5%% +>dir = /usr/src/%(filename)s+>percent = 5%% With interpolation, you would get these results: @@ -691,7 +692,7 @@ The basic theory of working with ConfigParser is this: 1. Parse or build a 'ConfigParser' object- + 2. Work with it in one of several ways 3. To make changes, you discard the original object and use a new one.@@ -706,7 +707,7 @@ -} {- $usagenomonad-You'll notice that many functions in this module return a +You'll notice that many functions in this module return a @MonadError 'CPError'@ over some type. Although its definition is not this simple, you can consider this to be the same as returning @Either CPError a@.@@ -717,7 +718,7 @@ more detail. Some people find it annoying to have to deal with errors manually.-You can transform errors into exceptions in your code by using +You can transform errors into exceptions in your code by using 'Data.Either.Utils.forceEither'. Here's an example of this style of programming: > import Data.Either.Utils@@ -785,7 +786,7 @@ {- $usageerroriomonad You've seen a nice way to use this module in the Error monad and get an Either-value out. But that's the Error monad, so IO is not permitted. +value out. But that's the Error monad, so IO is not permitted. Using Haskell's monad transformers, you can run it in the combined Error\/IO monad. That is, you will get an IO result back. Here is a full standalone example of doing that:
src/Data/ConfigFile/Lexer.hs view
@@ -1,5 +1,5 @@ {- arch-tag: ConfigParser lexer support-Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2004, 2008 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by@@ -21,7 +21,7 @@ Copyright : Copyright (C) 2004 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen <jgoerzen@complete.org> + Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -30,7 +30,7 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org -}-module Data.ConfigFile.Lexer +module Data.ConfigFile.Lexer ( -- -- * Temporary for testing --comment_chars, eol, optionsep, whitespace_chars, comment_line,@@ -50,36 +50,51 @@ | NEWOPTION (String, String) deriving (Eq, Show, Ord) +comment_chars :: CharParser st Char comment_chars = oneOf "#;"+eol :: GenParser Char st String eol = string "\n" <|> string "\r\n" <|> string "\r" <?> "End of line"+eoleof :: GenParser Char st () eoleof = eof <|> do {eol; return ()}+optionsep :: GenParser Char st Char optionsep = oneOf ":=" <?> "option separator"+whitespace_chars :: GenParser Char st Char whitespace_chars = oneOf " \t" <?> "whitespace"+comment_line :: GenParser Char st () comment_line = do skipMany whitespace_chars comment_chars <?> "start of comment" (many $ noneOf "\r\n") <?> "content of comment" eoleof+eolstuff :: GenParser Char st () eolstuff = (try comment_line) <|> (try empty_line)+empty_line :: GenParser Char st () empty_line = do many whitespace_chars eoleof <?> "empty line"+sectheader_chars :: CharParser st Char sectheader_chars = noneOf "]\r\n"+sectheader :: GenParser Char st String sectheader = do char '[' sname <- many1 $ sectheader_chars char ']' eolstuff return sname <?> "start of section"+oname_chars :: CharParser st Char oname_chars = noneOf ":=\r\n"+value_chars :: CharParser st Char value_chars = noneOf "\r\n"+extension_line :: GenParser Char st String extension_line = do many1 whitespace_chars c1 <- noneOf "\r\n#;" remainder <- many value_chars eolstuff return (c1 : remainder) +optionkey, optionvalue :: GenParser Char st String optionkey = many1 oname_chars optionvalue = many value_chars+optionpair :: GenParser Char st (String, String) optionpair = do key <- optionkey optionsep value <- optionvalue@@ -92,13 +107,13 @@ -- Ignore these things try (do {comment_line; togtok $ IGNOREDATA}) <|> try (do {empty_line; togtok $ IGNOREDATA})- + -- Real stuff <|> (do {sname <- sectheader; togtok $ NEWSECTION sname}) <|> try (do {extension <- extension_line; togtok $ EXTENSIONLINE extension}) <|> try (do {pair <- optionpair; togtok $ NEWOPTION pair}) -- <?> "Invalid syntax in configuration file"- + loken :: Parser [GeneralizedToken CPTok] loken = do x <- manyTill iloken eof return $ filter (\y -> snd y /= IGNOREDATA) x
src/Data/ConfigFile/Parser.hs view
@@ -1,4 +1,4 @@-{- +{- Copyright (C) 2004-2008 John Goerzen <jgoerzen@complete.org> This program is free software; you can redistribute it and/or modify@@ -21,7 +21,7 @@ Copyright : Copyright (C) 2004-2008 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen <jgoerzen@complete.org> + Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -50,7 +50,7 @@ parse_string :: MonadError CPError m => String -> m ParseOutput-parse_string s = +parse_string s = detokenize "(string)" $ parse loken "(string)" s --parse_file :: FilePath -> IO (CPResult ParseOutput)@@ -69,26 +69,29 @@ ---------------------------------------------------------------------- -- Private funcs ----------------------------------------------------------------------+detokenize :: (Show t, MonadError (CPErrorData, [Char]) m) => SourceName+ -> Either t [GeneralizedToken CPTok]+ -> m ParseOutput detokenize fp l = let conv msg (Left err) = throwError $ (ParseError (show err), msg)- conv msg (Right val) = return val+ conv _ (Right val) = return val in do r <- conv "lexer" l conv "parser" $ runParser main () fp r main :: GeneralizedTokenParser CPTok () ParseOutput main = do {s <- sectionlist; return s}- <|> try (do + <|> try (do o <- optionlist s <- sectionlist return $ ("DEFAULT", o) : s ) <|> do {o <- optionlist; return $ [("DEFAULT", o)] } <?> "Error parsing config file tokens"- + sectionlist :: GeneralizedTokenParser CPTok () ParseOutput sectionlist = do {eof; return []}- <|> try (do + <|> try (do s <- sectionhead eof return [(s, [])]@@ -102,7 +105,7 @@ section = do {sh <- sectionhead; ol <- optionlist; return (sh, ol)} sectionhead :: GeneralizedTokenParser CPTok () String-sectionhead = +sectionhead = let wf (NEWSECTION x) = Just x wf _ = Nothing in
src/Data/ConfigFile/Types.hs view
@@ -21,7 +21,7 @@ Copyright : Copyright (C) 2004-2008 John Goerzen License : GNU LGPL, version 2.1 or above - Maintainer : John Goerzen <jgoerzen@complete.org> + Maintainer : John Goerzen <jgoerzen@complete.org> Stability : provisional Portability: portable @@ -32,7 +32,7 @@ -} module Data.ConfigFile.Types (- CPOptions, CPData, + CPOptions, CPData, CPErrorData(..), CPError, {-CPResult,-} ConfigParser(..), SectionSpec,@@ -91,7 +91,7 @@ {- | This is the main record that is used by 'Data.ConfigFile'. -}-data ConfigParser = ConfigParser +data ConfigParser = ConfigParser { -- | The data itself content :: CPData, -- | How to transform an option into a standard representation@@ -109,5 +109,3 @@ -- The option value is not assumed to be transformed. accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> Either CPError String) }--
+ testsrc/runtests.hs view
@@ -0,0 +1,25 @@+{- arch-tag: Test runner+Copyright (C) 2004 John Goerzen <jgoerzen@complete.org>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++module Main where ++import Test.HUnit+import Tests++main = runTestTT tests+