| License | Apache 2.0 |
|---|---|
| Safe Haskell | None |
| Language | Haskell2010 |
HFlags
Contents
Description
The HFlags library supports easy definition of command line flags,
reimplementing the ideas from Google's gflags
(http://code.google.com/p/gflags).
Command line flags can be declared in any file at the toplevel,
using defineFlag. At runtime, the actual values are assigned to
the toplevel flags_name constants. Those can be used purely
throughout the program.
At the beginning of the main function, $ has to be called to initialize the flags. All flags
will be initialized that are transitively reachable via imports
from initHFlags "program
description"main. This means, that any Haskell package can easily
define command line flags with HFlags. This feature is
demonstrated by
http://github.com/errge/hflags/blob/master/examples/ImportExample.hs
and http://github.com/errge/hflags/tree/master/examples/package.
A simple example (more in the http://github.com/errge/hflags/tree/master/examples directory):
#!/usr/bin/env runhaskell
{-# LANGUAGE TemplateHaskell #-}
import HFlags
defineFlag "name" "Indiana Jones" "Who to greet."
defineFlag "r:repeat" (3 + 4 :: Int) "Number of times to repeat the message."
main = do s <- $initHFlags "Simple program v0.1"
sequence_ $ replicate flags_repeat greet
putStrLn $ "Your additional arguments were: " ++ show s
putStrLn $ "Which is the same as: " ++ show HFlags.arguments
where
greet = putStrLn $ "Hello " ++ flags_name ++ ", very nice to meet you!"At initHFlags time, the library also tries to gather flags out of
environment variables. HFLAGS_verbose=True is equivalent to
specifying --verbose=True on the command line. This environment
feature only works with long options and the user has to specify a
value even for Bools.
Since version 0.2, you mustn't put the initHFlags in a parentheses with the program description. Just $initHFlags, it's cleaner.
- defineCustomFlag :: String -> ExpQ -> String -> ExpQ -> ExpQ -> String -> Q [Dec]
- defineEQFlag :: String -> ExpQ -> String -> String -> Q [Dec]
- class FlagType t where
- initHFlags :: ExpQ
- initHFlagsDependentDefaults :: ExpQ
- arguments :: [String]
- undefinedOptions :: [String]
- class Flag a where
- data MakeThisOrphan = MakeThisOrphan
- globalHFlags :: IORef (Maybe (Map String String))
- globalArguments :: IORef (Maybe [String])
- globalUndefinedOptions :: IORef (Maybe [String])
Definition of flags
defineCustomFlag :: String -> ExpQ -> String -> ExpQ -> ExpQ -> String -> Q [Dec] Source #
The most flexible way of defining a flag. For an example see
http://github.com/errge/hflags/blob/master/examples/ComplexExample.hs.
For most things defineFlag should be enough instead.
The parameters:
- name of the flag (
l:longsyntax if you want to have the short optionlfor this flag), - expression quoted and type signed default value,
- help string identifying the type of the argument (e.g. INTLIST),
- read function, expression quoted,
- show function, expression quoted,
- help string for the flag.
defineEQFlag :: String -> ExpQ -> String -> String -> Q [Dec] Source #
This just forwards to defineCustomFlag with [| read |] and
[| show |]. Useful for flags where the type is not an instance
of FlagType. For examples, see
http://github.com/errge/hflags/blob/master/examples/ComplexExample.hs.
The parameters:
- name of the flag (
l:longsyntax if you want to have the short optionlfor this flag), - expression quoted and type signed default value,
- help string identifying the type of the argument (e.g. INTLIST),
- help string for the flag.
class FlagType t where Source #
Class of types for which the easy defineFlag syntax is supported.
Minimal complete definition
Initialization of flags at runtime
initHFlags :: ExpQ Source #
Has to be called from the main before doing anything else:
main = do args <- $initHFlags "Simple program v0.1"
...Since version 0.2, you mustn't put the initHFlags in a parentheses with the program description. Just $initHFlags, it's cleaner.
Internally, it uses Template Haskell trickery to gather all the
instances of the Flag class and then generates a call to
initFlags with the appropriate data gathered together from those
instances to a list.
Type after splicing is String -> IO [String].
initHFlagsDependentDefaults :: ExpQ Source #
Same as initHFlags, but makes it possible to introduce programmatic defaults based on user supplied flag values.
The second parameter has to be a function that gets the following alists:
- defaults,
- values from HFLAGS_* environment variables,
- command line options.
Has to return an alist that contains the additional defaults that will override the default flag values (but not the user supplied values: environment or command line).
Type after splicing is String -> DependentDefaults -> IO [String].
Where:
type AList = [(String, String)]
type DependentDefaults = AList -> AList -> AList -> AList
For easy access to arguments, after initHFlags has been called
arguments :: [String] Source #
Contains the non-parsed, non-option parts of the command line,
the arguments. Can only be used after initHFlags has been called.
undefinedOptions :: [String] Source #
Contains the non-parsed, option parts of the command line, if
--undefok is in use. This can be useful, when you have to pass
these options to other libraries, e.g. criterion or GTK. Can
only be used after initHFlags has been called.
For debugging, shouldn't be used in production code
Every flag the program supports has to be defined through a new phantom datatype and the Flag instance of that datatype.
But users of the library shouldn't worry about this class or the
implementation details behind these functions, just use the
defineFlag Template Haskell function for defining new flags.
Minimal complete definition
Methods
getFlagData :: a -> FlagData Source #
data MakeThisOrphan Source #
This is a temporary hack to force visibility of flags inside libraries, by making the module that defines the flag orphan. For usage example, check out http://github.com/errge/hflags/blob/master/examples/package/Tup.hs. A proper fix is already proposed for GHC 7.8, see http://ghc.haskell.org/trac/ghc/ticket/7867.
Constructors
| MakeThisOrphan |
globalHFlags :: IORef (Maybe (Map String String)) Source #
A global IORef for the communication between initHFlags and
flags_*. This is a map between flag name and current value.