[Haskell-cafe] Typed Configuration Files

Sebastian Fischer sebf at informatik.uni-kiel.de
Sun Jan 10 17:29:29 EST 2010


>> Is there something similar for parsing config files?
>
> If you write one I most certainly will use it! ;)

You (we) can already start using the cmdargs package to parse config  
files.

Upon my feature request to add a function to the cmdargs package that  
allows to add default arguments, Neil pointed out that the function  
System.Environment.withArgs can be used to get the same effect without  
changes to the cmdargs package.

Here is a complete example:

     {-# LANGUAGE DeriveDataTypeable #-}

     import System.Environment
     import System.Console.CmdArgs

     data Conf = Conf { option :: Bool }
      deriving (Show,Data,Typeable)

     myConf = mode $ Conf { option = enum False [True,False] }

     main = print =<< getConfig "my.conf" "My Program v0.0" myConf

     getConfig configFileName welcomeMsg modeDesc =
       do originalArgs <- getArgs
          argsFromFile <- words `fmap` readFile configFileName
          withArgs (argsFromFile ++ originalArgs) (cmdArgs welcomeMsg  
[modeDesc])

If you save the String '--true' in the file 'my.conf', this program  
reads the config from the file and prints it:

     # runhaskell typed-config.hs
     Conf {option = True}

You can overwrite the default behaviour with command line arguments:

     # runhaskell typed-config.hs --false
     Conf {option = False}

After parsing a config file into command-line arguments, the parsing  
of the typed `Config` comes for free.

Sebastian

P.S.:

Instead of the `words` function one would use some smarter function  
that translates real config files into command-line arguments, but the  
fez-conf package (which provides such functionality) segfaults on my  
computer.

Depending on how one specifies the mode value, one may not be able to  
overwrite default options. For example, the usual translation of the  
boolean field above is a single flag --option that can be present or  
absent. I did not find a way to unset a set flag other than declaring  
it as an enum flag. This could be improved if flags without arguments  
would support optional arguments like '--option=yes/no' or similar.  
(Btw. the documentation of enum seems wrong, the given example does  
not typecheck).

-- 
Underestimating the novelty of the future is a time-honored tradition.
(D.G.)





More information about the Haskell-Cafe mailing list