ConfigFile-1.1.4/0000755000175000017500000000000012424307443015255 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/src/0000755000175000017500000000000012424307443016044 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/src/Data/0000755000175000017500000000000012424307443016715 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/src/Data/ConfigFile.hs0000644000175000017500000007371412424307443021272 0ustar00jgoerzenjgoerzen00000000000000{-# LANGUAGE UndecidableInstances, OverlappingInstances #-} {- Copyright (C) 2004-2008 John Goerzen This program is free software; you can redistribute it and/or modify it, as specified in the COPYRIGHT file, under the terms of either version 2.1 of the LGPL (or, at your option, any later version) or the 3-clause BSD license. -} {- | Module : Data.ConfigFile Copyright : Copyright (C) 2004-2008 John Goerzen License : Either LGPL or BSD3, as specified in the COPYRIGHT file. Maintainer : John Goerzen Stability : provisional Portability: portable Configuration file parsing, generation, and manipulation Copyright (c) 2004-2008 John Goerzen, jgoerzen\@complete.org 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. This module contains extensive documentation. Please scroll down to the Introduction section to continue reading. -} module Data.ConfigFile ( -- * Introduction -- $introduction -- ** Features -- $features -- ** History -- $history -- * Configuration File Format -- $format -- ** White Space -- $whitespace -- ** Comments -- $comments -- ** Case Sensitivity -- $casesens -- ** Interpolation -- $interpolation -- * Usage Examples -- $usage -- ** Non-Monadic Usage -- $usagenomonad -- ** Error Monad Usage -- $usageerrormonad -- ** Combined Error\/IO Monad Usage -- $usageerroriomonad -- * Types -- $types SectionSpec, OptionSpec, ConfigParser(..), CPErrorData(..), CPError, -- * Initialization -- $initialization emptyCP, -- * Configuring the ConfigParser -- $configuringcp -- ** Access Functions simpleAccess, interpolatingAccess, -- * Reading -- $reading readfile, readhandle, readstring, -- * Accessing Data Get_C(..), sections, has_section, options, has_option, items, -- * Modifying Data set, setshow, remove_option, add_section, remove_section, merge, -- * Output Data to_string ) where import Data.ConfigFile.Types import Data.ConfigFile.Parser import Data.Either.Utils import Data.String.Utils import qualified Data.Map as Map import Data.List import System.IO(Handle) import Data.Char import Control.Monad.Error -- For interpolatingAccess import Text.ParserCombinators.Parsec.Error (errorMessages, Message(..)) import Text.ParserCombinators.Parsec (parse) ---------------------------------------------------------------------- -- Basic types / default values ---------------------------------------------------------------------- {- | The default empty 'Data.ConfigFile' object. The content contains only an empty mandatory @DEFAULT@ section. 'optionxform' is set to @map toLower@. 'usedefault' is set to @True@. 'accessfunc' is set to 'simpleAccess'. -} emptyCP :: ConfigParser emptyCP = ConfigParser { content = fromAL [("DEFAULT", [])], defaulthandler = defdefaulthandler, optionxform = map toLower, usedefault = True, accessfunc = simpleAccess} {- | Low-level tool to convert a parsed object into a 'CPData' representation. Performs no option conversions or special handling of @DEFAULT@. -} fromAL :: ParseOutput -> CPData fromAL origal = let conv :: CPData -> (String, [(String, String)]) -> CPData conv fm sect = Map.insert (fst sect) (Map.fromList $ snd sect) fm in foldl conv Map.empty origal {- | Default (non-interpolating) access function -} simpleAccess :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m String simpleAccess cp s o = defdefaulthandler cp s (optionxform cp $ o) {- | Interpolating access function. Please see the Interpolation section above for a background on interpolation. Although the format string looks similar to one used by "Text.Printf", it is not the same. In particular, only the %(...)s format is supported. No width specifiers are supported and no conversions other than s are supported. To use this function, you must specify a maximum recursion depth for interpolation. This is used to prevent a stack overflow in the event that the configuration file contains an endless interpolation loop. Values of 10 or so are usually more than enough, though you could probably go into the hundreds or thousands before you have actual problems. A value less than one will cause an instant error every time you attempt a lookup. This access method can cause 'get' and friends to return a new 'CPError': 'InterpolationError'. This error would be returned when: * The configuration file makes a reference to an option that does not exist * The maximum interpolation depth is exceeded * There is a syntax error processing a %-directive in the configuration file An interpolation lookup name specifies an option only. There is no provision to specify a section. Interpolation variables are looked up in the current section, and, if 'usedefault' is True, in @DEFAULT@ according to the normal logic. To use a literal percent sign, you must place @%%@ in the configuration file when interpolation is used. Here is how you might enable interpolation: >let cp2 = cp {accessfunc = interpolatingAccess 10} The @cp2@ object will now support interpolation with a maximum depth of 10. -} interpolatingAccess :: MonadError CPError m => Int -> ConfigParser -> SectionSpec -> OptionSpec -> m String interpolatingAccess maxdepth cp s o = if maxdepth < 1 then interError "maximum interpolation depth exceeded" else do x <- simpleAccess cp s o case parse (interpmain $ lookupfunc) (s ++ "/" ++ o) x of Left y -> case head (errorMessages y) of Message z -> interError z _ -> interError (show y) Right y -> return y where lookupfunc = interpolatingAccess (maxdepth - 1) cp s interError x = throwError (InterpolationError x, "interpolatingAccess") -- internal function: default handler defdefaulthandler :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m String defdefaulthandler cp sectn opt = let fm = content cp lookUp s o = do sect <- maybeToEither (NoSection s, "get " ++ formatSO sectn opt) $ Map.lookup s fm maybeToEither (NoOption o, "get " ++ formatSO sectn opt) $ Map.lookup o sect trydefault e = if (usedefault cp) 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 {- | Combines two 'ConfigParser's into one. Any duplicate options are resolved to contain the value specified in the second parser. 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 = 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 (content dest) (Map.map convFM (content src)) } {- | Utility to do a special case merge. -} readutil :: ConfigParser -> ParseOutput -> ConfigParser readutil old new = merge old $ old { content = fromAL new } {- | Loads data from the specified file. It is then combined with the given 'ConfigParser' using the semantics documented under 'merge' with the new data taking precedence over the old. However, unlike 'merge', all the options as set in the old object are preserved since the on-disk representation does not convey those options. May return an error if there is a syntax error. May raise an exception if the file could not be accessed. -} --readfile :: ConfigParser -> FilePath ->IO (CPResult ConfigParser) readfile :: MonadError CPError m => ConfigParser -> FilePath -> IO (m ConfigParser) {- readfile cp fp = do n <- parse_file fp return $ do y <- n return $ readutil cp y -} readfile cp fp = do n <- parse_file fp return $ n >>= (return . readutil cp) {- | Like 'readfile', but uses an already-open handle. You should use 'readfile' instead of this if possible, since it will be able to generate better error messages. Errors would be returned on a syntax error. -} --readhandle :: ConfigParser -> Handle -> IO (CPResult ConfigParser) readhandle :: MonadError CPError m => ConfigParser -> Handle -> IO (m ConfigParser) readhandle cp h = do n <- parse_handle h return $ n >>= (return . (readutil cp)) {- | Like 'readfile', but uses a string. You should use 'readfile' instead of this if you are processing a file, since it can generate better error messages. Errors would be returned on a syntax error. -} readstring :: MonadError CPError m => ConfigParser -> String -> m ConfigParser readstring cp s = do n <- parse_string s return $ readutil cp n {- | Returns a list of sections in your configuration file. Never includes the always-present section @DEFAULT@. -} sections :: ConfigParser -> [SectionSpec] sections = filter (/= "DEFAULT") . Map.keys . content {- | Indicates whether the given section exists. No special @DEFAULT@ processing is done. -} has_section :: ConfigParser -> SectionSpec -> Bool has_section cp x = Map.member x (content cp) {- | Adds the specified section name. Returns a 'SectionAlreadyExists' error if the section was already present. Otherwise, returns the new 'ConfigParser' object.-} add_section :: MonadError CPError m => ConfigParser -> SectionSpec -> m ConfigParser add_section cp s = if has_section cp s then throwError $ (SectionAlreadyExists s, "add_section") else return $ cp {content = Map.insert s Map.empty (content cp)} {- | Removes the specified section. Returns a 'NoSection' error if the section does not exist; otherwise, returns the new 'ConfigParser' object. This call may not be used to remove the @DEFAULT@ section. Attempting to do so will always cause a 'NoSection' error. -} remove_section :: MonadError CPError m => ConfigParser -> SectionSpec -> m ConfigParser remove_section _ "DEFAULT" = throwError $ (NoSection "DEFAULT", "remove_section") remove_section cp s = if has_section cp s then return $ cp {content = Map.delete s (content cp)} else throwError $ (NoSection s, "remove_section") {- | Removes the specified option. Returns a 'NoSection' error if the section does not exist and a 'NoOption' error if the option does not exist. Otherwise, returns the new 'ConfigParser' object. -} 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) $ 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, "remove_option " ++ formatSO s passedo) {- | Returns a list of the names of all the options present in the given section. Returns an error if the given section does not exist. -} options :: MonadError CPError m => ConfigParser -> SectionSpec -> m [OptionSpec] options cp x = maybeToEither (NoSection x, "options") $ do o <- Map.lookup x (content cp) return $ Map.keys o {- | Indicates whether the given option is present. Returns True only if the given section is present AND the given option is present in that section. No special @DEFAULT@ processing is done. No exception could be raised or error returned. -} has_option :: ConfigParser -> SectionSpec -> OptionSpec -> Bool has_option cp s o = let c = content cp v = do secthash <- Map.lookup s c return $ Map.member (optionxform cp $ o) secthash in maybe False id v {- | The class representing the data types that can be returned by "get". -} 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. When used in a context where a Bool is expected, parses the string to a Boolean value (see logic below). When used in a context where anything that is an instance of Read is expected, calls read to parse the item. An error will be returned of no such option could be found or if it could not be parsed as a boolean (when returning a Bool). When parsing to a Bool, strings are case-insentively converted as follows: The following will produce a True value: * 1 * yes * on * enabled * true The following will produce a False value: * 0 * no * off * disabled * 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 instance Get_C Bool where get = getbool instance Read t => Get_C t where get = genericget -- Based on code from Neil Mitchell's safe-0.3.3 package. readMaybe :: Read a => String -> Maybe a readMaybe s = case [x | (x, t) <- reads s, ("","") <- lex t] of [x] -> Just x _ -> Nothing genericget :: (Read b, MonadError CPError m) => ConfigParser -> SectionSpec -> OptionSpec -> m b genericget cp s o = do val <- get cp s o let errMsg = "couldn't parse value " ++ val ++ " from " ++ formatSO s o maybe (throwError (ParseError errMsg, "genericget")) return $ readMaybe val getbool :: MonadError CPError m => ConfigParser -> SectionSpec -> OptionSpec -> m Bool getbool cp s o = do val <- get cp s o case map toLower . strip $ val of "1" -> return True "yes" -> return True "on" -> return True "enabled" -> return True "true" -> return True "0" -> return False "no" -> return False "off" -> return False "disabled" -> return False "false" -> return False _ -> throwError (ParseError $ "couldn't parse bool " ++ val ++ " from " ++ formatSO s o, "getbool") formatSO :: [Char] -> [Char] -> [Char] formatSO s o = "(" ++ s ++ "/" ++ o ++ ")" {- | Returns a list of @(optionname, value)@ pairs representing the content 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") $ Map.lookup s (content cp) return $ Map.toList fm {- | Sets the option to a new value, replacing an existing one if it exists. 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) $ Map.lookup s (content cp) let o = (optionxform cp) passedo let newsect = Map.insert o val sectmap let newmap = Map.insert s newsect (content cp) return $ cp { content = newmap} {- | Sets the option to a new value, replacing an existing one if it exists. It requires only a showable value as its parameter. 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) => ConfigParser -> SectionSpec -> OptionSpec -> a -> m ConfigParser setshow cp s o val = set cp s o (show val) {- | Converts the 'ConfigParser' to a string representation that could be later re-parsed by this module or modified by a human. Note that this does not necessarily re-create a file that was originally loaded. Things may occur in a different order, comments will be removed, etc. The conversion makes an effort to make the result human-editable, but it does not make an effort to make the result identical to the original input. 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) = 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) then "[" ++ sect ++ "]\n" ++ (concat $ map gen_option (Map.toList valfm)) ++ "\n" else "" in concat $ map gen_section (Map.toList (content cp)) ---------------------------------------------------------------------- -- Docs ---------------------------------------------------------------------- {- $introduction Many programs need configuration files. These configuration files are typically used to configure certain runtime behaviors that need to be saved across sessions. Various different configuration file formats exist. The ConfigParser module attempts to define a standard format that is easy for the user to edit, easy for the programmer to work with, yet remains powerful and flexible. -} {- $features For the programmer, this module provides: * Simple calls to both read /and write/ configuration files * Call that can generate a string version of a file that is re-parsable by this module (useful for, for instance, sending the file down a network) * Segmented configuration files that let you separate configuration into distinct sections, each with its own namespace. This can be used to configure multiple modules in one file, to configure multiple instances of a single object, etc. * On-the-fly parsing of integer, boolean, float, multi-line string values, and anything else Haskell's read can deal with * It is possible to make a configuration file parsable by this module, the Unix shell, and\/or Unix make, though some feautres are, of course, not compatible with these other tools. * Syntax checking with error reporting including line numbers * Implemented in pure Haskell. No dependencies on modules outside the standard library distributed with Haskell compilers or interpreters. All calls except those that read directly from a handle are pure calls and can be used outside the IO monad. * Comprehensive documentation * Extensible API * Complete compatibility with Python's ConfigParser module, or my ConfigParser module for OCaml, part of my MissingLib package. For the user, this module provides: * Easily human-editable configuration files with a clear, concise, and consistent format * Configuration file format consistent with other familiar formats (\/etc\/passwd is a valid ConfigParser file) * No need to understand semantics of markup languages like XML -} {- $history This module is based on Python's ConfigParser module at . I had earlier developed an OCaml implementation as part of my MissingLib library at . While the API of these three modules is similar, and the aim is to preserve all useful features of the original Python module, there are some differences in the implementation details. This module is a complete, clean re-implementation in Haskell, not a Haskell translation of a Python program. As such, the feature set is slightly different. -} {- $format The basic configuration file format resembles that of an old-style Windows .INI file. Here are two samples: >debug = yes >inputfile = /etc/passwd >names = Peter, Paul, Mary, George, Abrahaham, John, Bill, Gerald, Richard, > Franklin, Woodrow >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 as a boolean or a string. The remaining items can be read as a string only. The @names@ entry spans two lines -- any line starting with whitespace, and containing something other than whitespace or comments, is taken as a continuation of the previous line. Here's another example: ># Default options >[DEFAULT] >hostname: localhost ># Options for the first file >[file1] >location: /usr/local >user: Fred >uid: 1000 >optionaltext: Hello, this entire string is included >[file2] >location: /opt >user: Fred >uid: 1001 This file defines three sections. The @DEFAULT@ section specifies an entry @hostname@. If you attempt to read the hostname option in any section, and that section doesn't define @hostname@, you will get the value from @DEFAULT@ instead. This is a nice time-saver. You can also note that you can use colons instead of the = character to separate option names from option entries. -} {- $whitespace Whitespace (spaces, tabs, etc) is automatically stripped from the beginning and end of all strings. Thus, users can insert whitespace 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. 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 and continuation lines for multi-line options. -} {- $comments Comments are introduced with the pound sign @#@ or the semicolon @;@. They cause the parser to ignore everything from that character to the end 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@. 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 comment character at the start of the line. -} {- $casesens By default, section names are case-sensitive but option names are not. The latter can be adjusted by adjusting 'optionxform'. -} {- $interpolation Interpolation is an optional feature, disabled by default. If you replace the default 'accessfunc' ('simpleAccess') with 'interpolatingAccess', then you get interpolation support with 'get' and the other 'get'-based functions. As an example, consider the following file: >arch = i386 >project = test >filename = test_%(arch)s.c >dir = /usr/src/%(filename)s >percent = 5%% With interpolation, you would get these results: >get cp "DEFAULT" "filename" -> "test_i386.c" >get cp "DEFAULT" "dir" -> "/usr/src/test_i386.c" >get cp "DEFAULT" "percent" -> "5%" For more details on interpolation, please see the documentation for the 'interpolatingAccess' function. -} {- $usage 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. Changes can be "chained" through one of several monads. The default 'ConfigParser' object that you always start with is 'emptyCP'. From here, you load data into it (merging data into the empty object), set up structures yourself, or adjust options. Let's take a look at some basic use cases. -} {- $usagenomonad 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@. That is, these functions will return @Left error@ if there's a problem or @Right result@ if things are fine. The documentation for individual functions describes the specific circumstances in which an error may occur in 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 'Data.Either.Utils.forceEither'. Here's an example of this style of programming: > import Data.Either.Utils > do > val <- readfile emptyCP "/etc/foo.cfg" > let cp = forceEither val > putStrLn "Your setting is:" > putStrLn $ forceEither $ get cp "sect1" "opt1" In short, you can just put @forceEither $@ in front of every call that returns something that is a MonadError. This is still a pure functional call, so it can be used outside of the IO monads. The exception, however, can only be caught in the IO monad. If you don't want to bother with 'forceEither', you can use the error monad. It's simple and better... read on. -} {- $usageerrormonad The return type is actually defined in terms of the Error monad, which is itself based on the Either data type. Here's a neat example of chaining together calls to build up a 'ConfigParser' object: >do let cp = emptyCP > cp <- add_section cp "sect1" > cp <- set cp "sect1" "opt1" "foo" > cp <- set cp "sect1" "opt2" "bar" > options cp "sect1" The return value of this little snippet is @Right [\"opt1\", \"opt2\"]@. (Note to beginners: unlike the IO monad, you /can/ escape from the Error monad.) Although it's not obvious, there actually was error checking there. If any of those calls would have generated an error, processing would have stopped immediately and a @Left@ value would have been returned. Consider this example: >do let cp = emptyCP > cp <- add_section cp "sect1" > cp <- set cp "sect1" "opt1" "foo" > cp <- set cp "sect2" "opt2" "bar" > options cp "sect1" The return value from this is @Left ('NoSection' \"sect2\", \"set\")@. The second call to 'set' failed, so the final call was skipped, and the result of the entire computation was considered to be an error. You can combine this with the non-monadic style to get a final, pure value out of it: >forceEither $ do let cp = emptyCP > cp <- add_section cp "sect1" > cp <- set cp "sect1" "opt1" "foo" > cp <- set cp "sect1" "opt2" "bar" > options cp "sect1" This returns @[\"opt1\", \"opt2\"]@. A quite normal value. -} {- $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. 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: >import Data.ConfigFile >import Control.Monad.Error > >main = do > rv <- runErrorT $ > do > cp <- join $ liftIO $ readfile emptyCP "/etc/passwd" > let x = cp > liftIO $ putStrLn "In the test" > nb <- get x "DEFAULT" "nobody" > liftIO $ putStrLn nb > foo <- get x "DEFAULT" "foo" > liftIO $ putStrLn foo > return "done" > print rv On my system, this prints: >In the test >x:65534:65534:nobody:/nonexistent:/bin/sh >Left (NoOption "foo","get") That is, my @\/etc\/passwd@ file contains a @nobody@ user but not a @foo@ user. Let's look at how that works. First, @main@ always runs in the IO monad only, so we take the result from the later calls and put it in @rv@. Note that the combined block is started with @runErrorT $ do@ instead of just @do@. To get something out of the call to 'readfile', we use @join $ liftIO $ readfile@. This will bring the result out of the IO monad into the combined monad and process it like usual. From here on, everything looks normal, except for IO calls. They are all executed under @liftIO@ so that the result value is properly brought into the combined monad. This finally returns @\"done\"@. Since we are in the Error monad, that means that the literal value is @Right \"done\"@. Since we are also in the IO monad, this is wrapped in IO. So the final return type after applying @runErrorT@ is @IO (Either CPError String)@. In this case, there was an error, and processing stopped at that point just like the example of the pure Error monad. We print out the return value, so you see the error displayed as a @Left@ value. It all works quite easily. -} {- $configuringcp You may notice that the 'ConfigParser' object has some configurable parameters, such as 'usedefault'. In case you're not familiar with the Haskell syntax for working with these, you can use syntax like this to set these options: >let cp2 = cp { usedefault = False } This will create a new 'ConfigParser' that is the same as @cp@ except for the 'usedefault' field, which is now always False. The new object will be called @cp2@ in this example. -} {- $reading You can use these functions to read data from a file. A common idiom for loading a new object from stratch is: @cp <- 'readfile' 'emptyCP' \"\/etc\/foo.cfg\"@ Note the use of 'emptyCP'; this will essentially cause the file's data to be merged with the empty 'ConfigParser'. -} {- $types The code used to say this: >type CPResult a = MonadError CPError m => m a >simpleAccess :: ConfigParser -> SectionSpec -> OptionSpec -> CPResult String But Hugs did not support that type declaration. Therefore, types are now given like this: >simpleAccess :: MonadError CPError m => > ConfigParser -> SectionSpec -> OptionSpec -> m String Although it looks more confusing than before, it still means the same. The return value can still be treated as @Either CPError String@ if you so desire. -} ConfigFile-1.1.4/src/Data/ConfigFile/0000755000175000017500000000000012424307443020722 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/src/Data/ConfigFile/Lexer.hs0000644000175000017500000000772112424307443022344 0ustar00jgoerzenjgoerzen00000000000000{- arch-tag: ConfigParser lexer support Copyright (C) 2004, 2008 John Goerzen This program is free software; you can redistribute it and/or modify it, as specified in the COPYRIGHT file, under the terms of either version 2.1 of the LGPL (or, at your option, any later version) or the 3-clause BSD license. -} {- | Module : Data.ConfigFile.Lexer Copyright : Copyright (C) 2004, 2008 John Goerzen License : Either LGPL or BSD3, as specified in the COPYRIGHT file. Maintainer : John Goerzen Stability : provisional Portability: portable Lexer support for "Data.ConfigFile". This module is not intended to be used directly by your programs. Copyright (c) 2004, 2008 John Goerzen, jgoerzen\@complete.org 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. -} module Data.ConfigFile.Lexer ( -- -- * Temporary for testing --comment_chars, eol, optionsep, whitespace_chars, comment_line, --empty_line, sectheader_chars, sectheader, oname_chars, value_chars, --extension_line, optionkey, optionvalue, optionpair loken, CPTok(..) ) where import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Utils data CPTok = IGNOREDATA | NEWSECTION String | NEWSECTION_EOF String | EXTENSIONLINE String | 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 value <- option "" $ do { optionsep; optionvalue } eolstuff return (key, value) "key/value option" iloken :: Parser (GeneralizedToken CPTok) iloken = -- 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 ConfigFile-1.1.4/src/Data/ConfigFile/Parser.hs0000644000175000017500000001236612424307443022522 0ustar00jgoerzenjgoerzen00000000000000{- Copyright (C) 2004-2008 John Goerzen This program is free software; you can redistribute it and/or modify it, as specified in the COPYRIGHT file, under the terms of either version 2.1 of the LGPL (or, at your option, any later version) or the 3-clause BSD license. -} {- | Module : Data.ConfigFile.Parser Copyright : Copyright (C) 2004-2008 John Goerzen License : Either LGPL or BSD3, as specified in the COPYRIGHT file. Maintainer : John Goerzen Stability : provisional Portability: portable Parser support for "Data.ConfigFile". This module is not intended to be used directly by your programs. Copyright (c) 2004-2008 John Goerzen, jgoerzen\@complete.org 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. -} module Data.ConfigFile.Parser ( parse_string, parse_file, parse_handle, interpmain, ParseOutput --satisfyG, --main ) where import Text.ParserCombinators.Parsec import Control.Monad.Error(throwError, MonadError) import Data.String.Utils import Data.ConfigFile.Lexer import System.IO(Handle, hGetContents) import Text.ParserCombinators.Parsec.Utils import Data.ConfigFile.Types ---------------------------------------------------------------------- -- Exported funcs ---------------------------------------------------------------------- parse_string :: MonadError CPError m => String -> m ParseOutput parse_string s = detokenize "(string)" $ parse loken "(string)" s --parse_file :: FilePath -> IO (CPResult ParseOutput) parse_file :: MonadError CPError m => FilePath -> IO (m ParseOutput) parse_file f = do o <- parseFromFile loken f return $ detokenize f o --parse_handle :: Handle -> IO (CPResult ParseOutput) parse_handle :: MonadError CPError m => Handle -> IO (m ParseOutput) parse_handle h = do s <- hGetContents h let o = parse loken (show h) s return $ detokenize (show h) o ---------------------------------------------------------------------- -- 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 _ (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 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 s <- sectionhead eof return [(s, [])] ) <|> do s <- section sl <- sectionlist return (s : sl) section :: GeneralizedTokenParser CPTok () (String, [(String, String)]) section = do {sh <- sectionhead; ol <- optionlist; return (sh, ol)} sectionhead :: GeneralizedTokenParser CPTok () String sectionhead = let wf (NEWSECTION x) = Just x wf _ = Nothing in do {s <- tokeng wf; return $ strip s} optionlist :: GeneralizedTokenParser CPTok () [(String, String)] optionlist = many coption coption :: GeneralizedTokenParser CPTok () (String, String) coption = let wf (NEWOPTION x) = Just x wf _ = Nothing wfx (EXTENSIONLINE x) = Just x wfx _ = Nothing in do o <- tokeng wf l <- many $ tokeng wfx return (strip (fst o), valmerge ((snd o) : l)) valmerge :: [String] -> String valmerge vallist = let vl2 = map strip vallist in join "\n" vl2 ---------------------------------------------------------------------- -- Interpolation ---------------------------------------------------------------------- interpval :: Parser String interpval = do string "%(" s <- (many1 $ noneOf ")") "interpolation name" string ")s" "end of interpolation name" return s percentval :: Parser String percentval = do string "%%" return "%" interpother :: Parser String interpother = do c <- noneOf "%" return [c] interptok :: (String -> Either CPError String) -> Parser String interptok lookupfunc = (try percentval) <|> interpother <|> do s <- interpval case lookupfunc s of Left (InterpolationError x, _) -> fail x Left _ -> fail $ "unresolvable interpolation reference to \"" ++ s ++ "\"" Right x -> return x interpmain :: (String -> Either CPError String) -> Parser String interpmain lookupfunc = do r <- manyTill (interptok lookupfunc) eof return $ concat r ConfigFile-1.1.4/src/Data/ConfigFile/Monadic.hs0000644000175000017500000000636012424307443022635 0ustar00jgoerzenjgoerzen00000000000000module Data.ConfigFile.Monadic ( -- * Overview -- $overview module Reexporting, simpleAccess, interpolatingAccess, readfile, readhandle, readstring, has_section, options, has_option, items, set, setshow, remove_option, add_section, remove_section ) where import Control.Monad.Error import System.IO(Handle) import Data.ConfigFile as Reexporting (SectionSpec, OptionSpec, ConfigParser(..), CPErrorData, CPError, emptyCP, Get_C(..), sections, merge, to_string) import qualified Data.ConfigFile as C {- $overview This module reexports a slightly different version of the standard API which makes it more convenient for chaining monadically. Everywhere a 'ConfigParser' was the first argument in a function in the standard API, it is now the last. This lets you rewrite > do let cp = emptyCP > cp <- add_section cp "sect1" > cp <- set cp "sect1" "opt1" "foo" > cp <- set cp "sect1" "opt2" "bar" > options cp "sect1" as > return emptyCP >>= > add_section "sect1" >>= > set "sect1" "opt1" "foo" >>= > set "sect1" "opt2" "bar" >>= > options "sect1" which may be more elegant in some cases. A future development might be to chain the 'ConfigParser' implicitly with a state monad, which would be yet more elegant. -} simpleAccess :: MonadError CPError m => SectionSpec -> OptionSpec -> ConfigParser -> m String simpleAccess s o cp = C.simpleAccess cp s o interpolatingAccess :: MonadError CPError m => Int -> SectionSpec -> OptionSpec -> ConfigParser -> m String interpolatingAccess maxdepth s o cp = C.interpolatingAccess maxdepth cp s o readfile :: MonadError CPError m => FilePath -> ConfigParser -> IO (m ConfigParser) readfile fp cp = C.readfile cp fp readhandle :: MonadError CPError m => Handle -> ConfigParser -> IO (m ConfigParser) readhandle h cp = C.readhandle cp h readstring :: MonadError CPError m => String -> ConfigParser -> m ConfigParser readstring cp s = C.readstring s cp has_section :: SectionSpec -> ConfigParser -> Bool has_section x cp = C.has_section cp x add_section :: MonadError CPError m => SectionSpec -> ConfigParser -> m ConfigParser add_section s cp = C.add_section cp s options :: MonadError CPError m => SectionSpec -> ConfigParser -> m [OptionSpec] options x cp = C.options cp x has_option :: SectionSpec -> OptionSpec -> ConfigParser -> Bool has_option s o cp = C.has_option cp s o items :: MonadError CPError m => SectionSpec -> ConfigParser -> m [(OptionSpec, String)] items s cp = C.items cp s set :: MonadError CPError m => SectionSpec -> OptionSpec -> String -> ConfigParser -> m ConfigParser set s passedo val cp = C.set cp s passedo val setshow :: (Show a, MonadError CPError m) => SectionSpec -> OptionSpec -> a -> ConfigParser -> m ConfigParser setshow s o val cp = C.setshow cp s o val remove_option :: MonadError CPError m => SectionSpec -> OptionSpec -> ConfigParser -> m ConfigParser remove_option s passedo cp = C.remove_option cp s passedo remove_section :: MonadError CPError m => SectionSpec -> ConfigParser -> m ConfigParser remove_section s cp = C.remove_section cp s ConfigFile-1.1.4/src/Data/ConfigFile/Types.hs0000644000175000017500000001012212424307443022356 0ustar00jgoerzenjgoerzen00000000000000{- Copyright (C) 2004-2008 John Goerzen This program is free software; you can redistribute it and/or modify it, as specified in the COPYRIGHT file, under the terms of either version 2.1 of the LGPL (or, at your option, any later version) or the 3-clause BSD license. -} {- | Module : Data.ConfigFile.Types Copyright : Copyright (C) 2004-2008 John Goerzen License : Either LGPL or BSD3, as specified in the COPYRIGHT file. Maintainer : John Goerzen Stability : provisional Portability: portable Internal types for "Data.ConfigFile". This module is not intended to be used directly by your programs. Copyright (c) 2004-2008 John Goerzen, jgoerzen\@complete.org 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. -} module Data.ConfigFile.Types ( CPOptions, CPData, CPErrorData(..), CPError, {-CPResult,-} ConfigParser(..), SectionSpec, OptionSpec, ParseOutput ) where import qualified Data.Map as Map import Data.Char import Control.Monad.Error {- | Internal output from parser -} type ParseOutput = [(String, [(String, String)])] {- | Names of sections -} type SectionSpec = String {- | Names of options -} type OptionSpec = String {- | Storage of options. -} type CPOptions = Map.Map OptionSpec String {- | The main data storage type (storage of sections). PLEASE NOTE: This type is exported only for use by other modules under Data.ConfigFile. You should NEVER access the FiniteMap in a ConfigParser directly. This type may change in future releases of MissingH, which could break your programs. Please retrict yourself to the interface in 'Data.ConfigFile'. -} type CPData = Map.Map SectionSpec CPOptions {- | Possible ConfigParser errors. -} data CPErrorData = ParseError String -- ^ Parse error | SectionAlreadyExists SectionSpec -- ^ Attempt to create an already-existing ection | NoSection SectionSpec -- ^ The section does not exist | NoOption OptionSpec -- ^ The option does not exist | OtherProblem String -- ^ Miscellaneous error | InterpolationError String -- ^ Raised by 'Data.ConfigFile.interpolatingAccess' if a request was made for a non-existant option deriving (Eq, Ord, Show) {- | Indicates an error occurred. The String is an explanation of the location of the error. -} type CPError = (CPErrorData, String) instance Error CPError where noMsg = (OtherProblem "", "") strMsg x = (OtherProblem x, "") {- Removed due to Hugs incompatibility. | Basic ConfigParser error handling. The Left value indicates an error, while a Right value indicates success. type CPResult a = MonadError CPError m => m a -} {- | This is the main record that is used by 'Data.ConfigFile'. -} data ConfigParser = ConfigParser { -- | The data itself content :: CPData, -- | How to transform an option into a standard representation optionxform :: (OptionSpec -> OptionSpec), -- | Function to look up an option, considering a default value -- if 'usedefault' is True; or ignoring a default value otherwise. -- The option specification is assumed to be already transformed. defaulthandler :: ConfigParser -> SectionSpec -> OptionSpec -> Either CPError String, -- | Whether or not to seek out a default action when no match -- is found. usedefault :: Bool, -- | Function that is used to perform lookups, do optional -- interpolation, etc. It is assumed that accessfunc -- will internally call defaulthandler to do the underlying lookup. -- The option value is not assumed to be transformed. accessfunc :: (ConfigParser -> SectionSpec -> OptionSpec -> Either CPError String) } ConfigFile-1.1.4/testsrc/0000755000175000017500000000000012424307443016744 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/testsrc/Tests.hs0000644000175000017500000000214712424307443020406 0ustar00jgoerzenjgoerzen00000000000000{- arch-tag: Tests main file Copyright (C) 2004 John Goerzen 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 Tests(tests) where import Test.HUnit import qualified ConfigParser.Parsertest import qualified ConfigParser.Maintest test1 = TestCase ("x" @=? "x") tests = TestList [TestLabel "test1" test1, TestLabel "ConfigParser.RunParser" ConfigParser.Parsertest.tests, TestLabel "ConfigParser.Main" ConfigParser.Maintest.tests] ConfigFile-1.1.4/testsrc/ConfigParser/0000755000175000017500000000000012424307443021326 5ustar00jgoerzenjgoerzen00000000000000ConfigFile-1.1.4/testsrc/ConfigParser/Parsertest.hs0000644000175000017500000001016212424307443024016 0ustar00jgoerzenjgoerzen00000000000000{- arch-tag: ConfigParser parser tests main file Copyright (C) 2004 John Goerzen 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 ConfigParser.Parsertest(tests) where import Test.HUnit import Data.ConfigFile.Parser import Data.ConfigFile.Types import Test.HUnit.Tools import Control.Exception test_basic = let f msg inp exp = TestLabel msg $ TestCase $ assertEqual "" (Right exp) (parse_string inp) in [ f "empty string" "" [] ,f "one empty line" "\n" [] -- These two should go to OCaml ,f "one empty comment" "#" [] ,f "one empty comment eol" "#\n" [] ,f "one comment line" "#foo bar" [] ,f "one comment line with eol" "#foo bar\n" [] ,f "one empty section" "[emptysect]" [("emptysect", [])] ,f "one empty section w/eol" "[emptysect]\n" [("emptysect", [])] ,f "comment and empty sect noeol" "#foo bar\n[emptysect]" [("emptysect", [])] ,f "comment and empty sect" "#foo bar\n[emptysect]\n" [("emptysect", [])] ,f "comments2" "# [nonexistant]\n[emptysect]\n" [("emptysect", [])] ,f "comments3" "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg" [("Cemptysect", [])] ,f "comments4" "[emptysect]\n# [nonexistant]\n" [("emptysect", [])] ,f "simple section" "[sect1]\nfoo: bar\n" [("sect1", [("foo", "bar")])] ,f "comments5" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3" [("sect1", [("o1", "v1"), ("o2", "v2"), ("o3", "v3")])] ,f "comments5ext" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\n o3: v3" [("sect1", [("o1", "v1"), ("o2", "v2\no3: v3")])] ,f "comments5eol" "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3\n" [("sect1", [("o1", "v1"), ("o2", "v2"), ("o3", "v3")])] ,f "default1" "v1: o1\n[sect1]\nv2: o2" [("DEFAULT", [("v1", "o1")]), ("sect1", [("v2", "o2")])] ,f "simple default" "foo: bar" [("DEFAULT", [("foo", "bar")])] ] test_asserts = let f msg inp exp = TestLabel msg $ TestCase $ exp @=? parse_string inp in [ f "e test1" "#foo\nthis is bad data" (Left (ParseError "\"(string)\" (line 2, column 1):\nunexpected \"t\"\nexpecting end of input, whitespace, start of comment, empty line, start of section or option separator", "lexer")) ,f "e test2" "[sect1]\n#iiiiii \n extensionline\n#foo" (Left (ParseError "\"(string)\" (line 4, column 1):\nunexpected EXTENSIONLINE \"extensionline\"","parser")) ] {- assertRaises "e test1" (ErrorCall "Lexer: \"(string)\" (line 1, column 5):\nunexpected \"\\n\"\nexpecting Option separator") ([] @=? parse_string "#foo\nthis is bad data") assertRaises "e test2" (ErrorCall "Lexer: \"(string)\" (line 2, column 9):\nunexpected \"\\n\"\nexpecting Option separator") ([] @=? parse_string "[sect1]\n#iiiiii \n extensionline\n#foo") -} test_extensionlines = let f inp exp = (Right exp) @=? parse_string inp in do f "[sect1]\nfoo: bar\nbaz: l1\n l2\n l3\n# c\nquux: asdf" [("sect1", [("foo", "bar"), ("baz", "l1\nl2\nl3"), ("quux", "asdf")])] tests = TestList [TestLabel "test_basic" (TestList test_basic), TestLabel "test_asserts" (TestList test_asserts), TestLabel "test_extensionlines" (TestCase test_extensionlines) ] ConfigFile-1.1.4/testsrc/ConfigParser/test.cfg0000644000175000017500000000044412424307443022770 0ustar00jgoerzenjgoerzen00000000000000# arch-tag: test file for ConfigParser tests # Default options [DEFAULT] hostname: localhost # Options for the first file [file1] location: /usr/local user: Fred uid: 1000 optionaltext: Hello, this entire string is included [file2] location: /opt user: Fred uid: 1001 hostname: somewhere ConfigFile-1.1.4/testsrc/ConfigParser/Maintest.hs0000644000175000017500000002541312424307443023453 0ustar00jgoerzenjgoerzen00000000000000{- arch-tag: ConfigParser tests main file Copyright (C) 2004-2006 John Goerzen 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 ConfigParser.Maintest(tests) where import Test.HUnit import Data.ConfigFile import Data.Either.Utils import System.IO.PlafCompat(nullFileName) import Test.HUnit.Tools import Control.Exception import System.IO nullfile = openFile nullFileName ReadWriteMode testfile = "testsrc/ConfigParser/test.cfg" p inp = forceEither $ readstring emptyCP inp f msg inp exp conv = TestLabel msg $ TestCase $ assertEqual "" (Right exp) (conv (p inp)) -- f2s, f2b are useful for matching Left return values f2s :: String -> Either CPError String -> Either CPError String -> Test f2s = f2 f2b :: String -> Either CPError Bool -> Either CPError Bool -> Test f2b = f2 f2 msg exp res = TestLabel msg $ TestCase $ assertEqual "" exp res f3 msg inp exp conv = TestLabel msg $ TestCase $ assertEqual "" exp (conv (p inp)) instance Show ConfigParser where show x = show (content x) instance Eq ConfigParser where x == y = (content x) == (content y) test_basic = [ f3 "empty doc, no sections" "" [] sections, f3 "one empty line" "\n" [] sections, f3 "comment line only" "#foo bar" [] sections, f3 "comment line with \\n" "#foo bar\n" [] sections, f3 "one empty sect" "[emptysect]" ["emptysect"] sections, f3 "one empty sect w comment" "#foo bar\n[emptysect]\n" ["emptysect"] sections, f3 "assure comments not processed" "# [nonexistant]\n[emptysect]\n" ["emptysect"] sections, f3 "1 empty s w/comments" "#fo\n[Cemptysect]\n#asdf boo\n \n # fnonexistantg" ["Cemptysect"] sections, f3 "1 empty s, comments, EOL" "[emptysect]\n# [nonexistant]\n" ["emptysect"] sections, TestLabel "1 sec w/option" $ TestCase $ do let cp = p "[sect1]\nfoo: bar\n" ["sect1"] @=? sections cp (Right "bar") @=? get cp "sect1" "foo" , f "comments in option text" "[s1]\no1: v1#v2\n" "v1#v2" (\cp -> get cp "s1" "o1") , TestLabel "mult options" $ TestCase $ do let cp = p "\n#foo\n[sect1]\n\n#iiii \no1: v1\no2: v2\no3: v3" Right ["o1", "o2", "o3"] @=? options cp "sect1" ["sect1"] @=? sections cp Right "v2" @=? get cp "sect1" "o2" , TestLabel "sectionless option" $ TestCase $ do let cp = p "v1: o1\n[sect1]\nv2: o2" Right "o1" @=? get cp "sect1" "v1" Right "o2" @=? get cp "sect1" "v2" Right "o1" @=? get cp "DEFAULT" "v1" , f3 "extensions to string" "[sect1]\nfoo: bar\nbaz: l1\n l2\n l3\n# c\nquux: asdf" "[sect1]\nbaz: l1\n l2\n l3\nfoo: bar\nquux: asdf\n\n" to_string ] test_defaults = let cp = p "def: ault\n[sect1]\nfoo: bar\nbaz: quuz\nint: 2\nfloat: 3\nbool: yes\n[sect4]\ndef: different" in [ f2 "default item" (Right "ault") (get cp "sect1" "def") ,f2 "normal item" (Right "bar") (get cp "sect1" "foo") ,f2s "no option" (Left (NoOption "abc", "get (sect1/abc)")) (get cp "sect1" "abc") ,f2s "no section" (Left (NoSection "sect2", "get (sect2/foo)")) (get cp "sect2" "foo") ,f2 "default from bad sect" (Right "ault") (get cp "sect2" "def") ,f2 "overriding default" (Right "different") (get cp "sect4" "def") -- not in haskell: ,f2 "using default feature" -- default int -- default float -- default bool ] test_nodefault = let cp = (p "def: ault\n[sect1]\nfoo: bar\nbaz: quuz\nint: 2\nfloat: 3\nbool: yes\n[sect4]\ndef: different"){usedefault = False} in [ f2s "default item" (Left (NoOption "def", "get (sect1/def)")) (get cp "sect1" "def") ,f2 "normal item" (Right "bar") (get cp "sect1" "foo") ,f2s "no option" (Left (NoOption "abc", "get (sect1/abc)")) (get cp "sect1" "abc") ,f2s "no section" (Left (NoSection "sect2", "get (sect2/foo)")) (get cp "sect2" "foo") ,f2s "default bad sect" (Left (NoSection "sect2", "get (sect2/def)")) (get cp "sect2" "def") ,f2 "overriding default" (Right "different") (get cp "sect4" "def") -- not in haskell: ,f2 "using default feature" -- default int -- default float -- default bool ] test_instances = let cp = p "[x]\na: true\nb: 1\nbad: never" in [f2 "bool 1st" (Right True) (get cp "x" "a"), f2 "bool 1nd" (Right True) (get cp "x" "b"), f2b "bad bool" (Left (ParseError "couldn't parse bool never from (x/bad)", "getbool")) (get cp "x" "bad"), f2 "number" (Right (1::Int)) (get cp "x" "b") ] test_merge = let cp = p "test: foo" cp2 = p "test: bar" in [f2 "merge1" (cp) (merge emptyCP cp) ,f2 "merge2" (cp) (merge cp emptyCP) ,f2 "merge3" (cp2) (merge cp cp2) ,f2 "merge4" (cp) (merge cp2 cp)] test_remove = let cp = forceEither $ readstring emptyCP "def:ault\n[sect1]\ns1o1: v1\ns1o2:v2\n[sect2]\ns2o1: v1\ns2o2: v2\n[sect3]" in [ f2 "setup" ["sect1", "sect2", "sect3"] (sections cp) ,f2 "remove 1st s" (Right ["sect2", "sect3"]) (do x <- remove_section cp "sect1" return $ sections x ) ,f2 "remove 2nd s" (Right ["sect1", "sect3"]) (do x <- remove_section cp "sect2" return $ sections x ) ,f2 "remove 3rd s" (Right ["sect1", "sect2"]) (do x <- remove_section cp "sect3" return $ sections x ) ,f2 "error handling s" (Left (NoSection "sect4", "remove_section")) (remove_section cp "sect4") ,f2 "remove an option" (Right (["sect1", "sect2", "sect3"], ["s1o2"])) (do x <- remove_option cp "sect1" "s1o1" y <- options x "sect1" return (sections x, y) ) ,f2 "option err 1" (Left (NoSection "sect4", "remove_option (sect4/s4o1)")) (remove_option cp "sect4" "s4o1") ,f2 "option err 2" (Left (NoOption "s1o3", "remove_option (sect1/s1o3)")) (remove_option cp "sect1" "s1o3") ] test_ex_nomonad = do fh <- nullfile val <- readfile emptyCP testfile let cp = forceEither val hPutStr fh "Your setting is:" hPutStr fh $ forceEither $ get cp "file1" "location" test_ex_errormonad = [ TestLabel "chaining1" $ TestCase $ (Right ["opt1", "opt2"]) @=? do let cp = emptyCP cp <- add_section cp "sect1" cp <- set cp "sect1" "opt1" "foo" cp <- set cp "sect1" "opt2" "bar" options cp "sect1" ,TestLabel "chaining2" $ TestCase $ (Left (NoSection "sect2", "set (sect2/opt2)")) @=? do let cp = emptyCP cp <- add_section cp "sect1" cp <- set cp "sect1" "opt1" "foo" cp <- set cp "sect2" "opt2" "bar" options cp "sect1" ,TestLabel "chaining3" $ TestCase $ ["opt1", "opt2"] @=? ( forceEither $ do let cp = emptyCP cp <- add_section cp "sect1" cp <- set cp "sect1" "opt1" "foo" cp <- set cp "sect1" "opt2" "bar" options cp "sect1" ) ] test_interp = let interpdoc = "[DEFAULT]\narch = i386\n\n[builder]\n" ++ "filename = test_%(arch)s.c\n" ++ "dir = /usr/src/%(filename)s\n" ++ "percent = 5%%\n" ++ "bad = /usr/src/%(nonexistent)s\n" ++ "recursive = foo%(recursive)s\n" ++ "syn1 = foo%()s\n" ++ "syn2 = foo%(asdf)\n" ++ "syn3 = foo%s\n" ++ "syn4 = %\n" cp = (forceEither $ (readstring emptyCP interpdoc)){ accessfunc = interpolatingAccess 5} in [ f2 "basic" (Right "i386") (get cp "DEFAULT" "arch") ,f2 "filename" (Right "test_i386.c") (get cp "builder" "filename") ,f2 "dir" (Right "/usr/src/test_i386.c") (get cp "builder" "dir") ,f2 "percents" (Right "5%") (get cp "builder" "percent") ,f2s "error" (Left (InterpolationError "unresolvable interpolation reference to \"nonexistent\"", "interpolatingAccess")) (get cp "builder" "bad") ,f2s "recursive" (Left (InterpolationError "maximum interpolation depth exceeded", "interpolatingAccess")) (get cp "builder" "recursive") ,f2s "syn1" (Left (InterpolationError "\"builder/syn1\" (line 1, column 6):\nunexpected \")\"\nexpecting interpolation name","interpolatingAccess")) (get cp "builder" "syn1") ,f2s "syn2" (Left (InterpolationError "\"builder/syn2\" (line 1, column 10):\nunexpected end of input\nexpecting \")s\"","interpolatingAccess")) (get cp "builder" "syn2") ,f2s "syn3" (Left (InterpolationError "\"builder/syn3\" (line 1, column 4):\nunexpected \"s\"\nexpecting \"%(\"","interpolatingAccess")) (get cp "builder" "syn3") ,f2s "syn4" (Left (InterpolationError "\"builder/syn4\" (line 1, column 1):\nunexpected end of input\nexpecting \"%(\"","interpolatingAccess")) (get cp "builder" "syn4") ] tests = TestList [TestLabel "test_basic" (TestList test_basic), TestLabel "test_defaults" (TestList test_defaults), TestLabel "test_nodefault" (TestList test_nodefault), TestLabel "test_remove" (TestList test_remove), TestLabel "test_ex_nomonad" (TestCase test_ex_nomonad), TestLabel "test_ex_errormonad" (TestList test_ex_errormonad), TestLabel "test_interp" (TestList test_interp), TestLabel "test_instances" (TestList test_instances), TestLabel "test_merge" (TestList test_merge)] ConfigFile-1.1.4/testsrc/runtests.hs0000644000175000017500000000150612424307443021171 0ustar00jgoerzenjgoerzen00000000000000{- arch-tag: Test runner Copyright (C) 2004 John Goerzen 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 ConfigFile-1.1.4/LGPL-2.10000644000175000017500000006363712424307443016253 0ustar00jgoerzenjgoerzen00000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! ConfigFile-1.1.4/COPYRIGHT0000644000175000017500000000163012424307443016550 0ustar00jgoerzenjgoerzen00000000000000ConfigFile Copyright (C) 2004-2010 John Goerzen This program is free software; you can redistribute it and/or modify it under the terms of either: a) the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 (see the file LGPL-2.1), or (at your option) any later version, or b) the 3-clause BSD License (see the file BSD3). 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. You should have received a copy of the GNU Lesser General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA If these licenses are unacceptable for your uses, please e-mail me; alternative terms can be negotiated for your project. ConfigFile-1.1.4/README0000644000175000017500000000013512424307443016134 0ustar00jgoerzenjgoerzen00000000000000Welcome to ConfigFile. For more information, visit http://software.complete.org/configfile ConfigFile-1.1.4/BSD30000644000175000017500000000272012424307443015674 0ustar00jgoerzenjgoerzen00000000000000Copyright (c) 2004-2010, John Goerzen All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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. ConfigFile-1.1.4/Setup.hs0000644000175000017500000000011212424307443016703 0ustar00jgoerzenjgoerzen00000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain ConfigFile-1.1.4/Makefile0000644000175000017500000000165512424307443016724 0ustar00jgoerzenjgoerzen00000000000000all: setup @echo "Please use Cabal to build this package; not make." ./setup configure ./setup build setup: Setup.hs ghc --make -package Cabal -o setup Setup.hs install: setup ./setup install clean: -runghc Setup.hs clean -rm -rf html `find . -name "*.o"` `find . -name "*.hi" | grep -v debian` \ `find . -name "*~" | grep -v debian` *.a setup dist testsrc/runtests \ local-pkg doctmp -rm -rf testtmp/* testtmp* .PHONY: test test: test-ghc test-hugs @echo "" @echo "All tests pass." test-hugs: setup @echo " ****** Running hugs tests" ./setup configure -f buildtests --hugs --extra-include-dirs=/usr/lib/hugs/include ./setup build runhugs -98 +o -P$(PWD)/dist/scratch:$(PWD)/dist/scratch/programs/runtests: \ dist/scratch/programs/runtests/Main.hs test-ghc: setup @echo " ****** Building GHC tests" ./setup configure -f buildtests ./setup build @echo " ****** Running GHC tests" ./dist/build/runtests/runtests ConfigFile-1.1.4/ConfigFile.cabal0000644000175000017500000000401012424307443020241 0ustar00jgoerzenjgoerzen00000000000000Name: ConfigFile Version: 1.1.4 License: BSD3 Maintainer: John Goerzen Author: John Goerzen Copyright: Copyright (c) 2004-2014 John Goerzen license-file: COPYRIGHT extra-source-files: README, Makefile, COPYRIGHT, LGPL-2.1, BSD3, testsrc/ConfigParser/test.cfg Category: Parsing homepage: http://software.complete.org/configfile synopsis: Configuration file reading & writing Description: Parser and writer for handling sectioned config files in Haskell. . The ConfigFile module works with configuration files in a standard format that is easy for the user to edit, easy for the programmer to work with, yet remains powerful and flexible. It is inspired by, and compatible with, Python's ConfigParser module. It uses files that resemble Windows .INI-style files, but with numerous improvements. . ConfigFile provides simple calls to both read and write config files. It's possible to make a config file parsable by this module, the Unix shell, and make. Stability: Stable 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, Data.ConfigFile.Monadic Other-Modules: Data.ConfigFile.Lexer Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances, TypeSynonymInstances, FlexibleContexts, FlexibleInstances Build-Depends: parsec, base < 5, mtl, MissingH>=1.0.0, containers GHC-Options: -O2 -Wall Executable runtests if flag(buildtests) Buildable: True Build-depends: HUnit, testpack else Buildable: False Main-Is: runtests.hs HS-Source-Dirs: testsrc, src, . Other-Modules: Tests, ConfigParser.Maintest, ConfigParser.Parsertest Extensions: ExistentialQuantification, OverlappingInstances, UndecidableInstances, CPP, TypeSynonymInstances, FlexibleContexts, FlexibleInstances