Safe Haskell | None |
---|
Dyre is a library for configuring your Haskell programs. Like Xmonad, programs configured with Dyre will look for a configuration file written in Haskell, which essentially defines a custom program configured exactly as the user wishes it to be. And since the configuration is written in Haskell, the user is free to do anything they might wish in the context of configuring the program.
Dyre places emphasis on elegance of operation and ease of integration
with existing applications. The wrapMain
function is the sole entry
point for Dyre. When partially applied with a parameter structure, it
wraps around the realMain
value from that structure, yielding an almost
identical function which has been augmented with dynamic recompilation
functionality.
The Relaunch
module provides the ability to restart the
program (recompiling if applicable), and persist state across restarts,
but it has no impact whatsoever on the rest of the library whether it
is used or not.
A full example of using most of Dyre's major features is as follows:
-- DyreExample.hs -- module DyreExample where import qualified Config.Dyre as Dyre import Config.Dyre.Relaunch import System.IO data Config = Config { message :: String, errorMsg :: Maybe String } data State = State { bufferLines :: [String] } deriving (Read, Show) defaultConfig :: Config defaultConfig = Config "Dyre Example v0.1" Nothing showError :: Config -> String -> Config showError cfg msg = cfg { errorMsg = Just msg } realMain Config{message = message, errorMsg = errorMsg } = do (State buffer) <- restoreTextState $ State [] case errorMsg of Nothing -> return () Just em -> putStrLn $ "Error: " ++ em putStrLn message mapM putStrLn . reverse $ buffer putStr "> " >> hFlush stdout input <- getLine case input of "exit" -> return () "quit" -> return () other -> relaunchWithTextState (State $ other:buffer) Nothing dyreExample = Dyre.wrapMain $ Dyre.defaultParams { Dyre.projectName = "dyreExample" , Dyre.realMain = realMain , Dyre.showError = showError }
Notice that all of the program logic is contained in the DyreExample
module. The main module of the program is absolutely trivial, being
essentially just the default configuration for the program:
-- Main.hs -- import DyreExample main = dyreExample defaultConfig
The user can then create a custom configuration file, which overrides some or all of the default configuration:
-- ~/.config/dyreExample/dyreExample.hs -- import DyreExample main = dyreExample $ defaultConfig { message = "Dyre Example v0.1 (Modified)" }
When reading the above program, notice that the majority of the code is simply *program logic*. Dyre is designed to intelligently handle recompilation with a minimum of programmer work.
Some mention should be made of Dyre's defaults. The defaultParams
structure used in the example defines reasonable default values for
most configuration items. The three elements defined above are the
only elements that must be overridden. For documentation of the
parameters, consult the Params
module.
In the absence of any customization, Dyre will search for configuration
files in '$XDG_CONFIG_HOME/<appName>/<appName>.hs', and will store
cache files in '$XDG_CACHE_HOME/<appName>/' directory. The module
XDG
is used for this purpose, which also provides
analogous behaviour on Windows.
The above example can be tested by running Main.hs with runhaskell
,
and will detect custom configurations and recompile correctly even when
the library isn't installed, so long as it is in the current directory
when run.
- wrapMain :: Params cfgType -> cfgType -> IO ()
- data Params cfgType = Params {
- projectName :: String
- configCheck :: Bool
- configDir :: Maybe (IO FilePath)
- cacheDir :: Maybe (IO FilePath)
- realMain :: cfgType -> IO ()
- showError :: cfgType -> String -> cfgType
- hidePackages :: [String]
- ghcOpts :: [String]
- forceRecomp :: Bool
- statusOut :: String -> IO ()
- rtsOptsHandling :: RTSOptionHandling
- includeCurrentDirectory :: Bool
- defaultParams :: Params cfgType
Documentation
wrapMain :: Params cfgType -> cfgType -> IO ()Source
wrapMain
is how Dyre recieves control of the program. It is expected
that it will be partially applied with its parameters to yield a main
entry point, which will then be called by the main
function, as well
as by any custom configurations.
This structure is how all kinds of useful data is fed into Dyre. Of
course, only the projectName
, realMain
, and showError
fields
are really necessary. By using the set of default values provided
as defaultParams
, you can get all the benefits of
using Dyre to configure your program in only five or six lines of
code.
Params | |
|
defaultParams :: Params cfgTypeSource
A set of reasonable defaults for configuring Dyre. The fields that
have to be filled are projectName
, realMain
, and showError
.