dyre-0.9.2: Config/Dyre.hs
{- |
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 "Config.Dyre.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.
= Writing a program that uses Dyre
The following example program uses most of Dyre's major features:
@
-- DyreExample.hs --
module DyreExample
( Config(..)
, defaultConfig
, 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) <- 'Config.Dyre.Relaunch.restoreTextState' $ State []
case errorMsg of
Nothing -> return ()
Just em -> putStrLn $ "Error: " ++ em
putStrLn message
traverse putStrLn . reverse $ buffer
putStr "> " *> hFlush stdout
input <- getLine
case input of
"exit" -> return ()
"quit" -> return ()
other -> 'Config.Dyre.Relaunch.relaunchWithTextState' (State $ other:buffer) Nothing
dyreExample = Dyre.'Config.Dyre.wrapMain' $ Dyre.'Config.Dyre.newParams' "dyreExample" realMain showError
@
All of the program logic is contained in the @DyreExample@ module.
The module exports the 'Config' data type, a @defaultConfig@, and
the @dyreExample@ function which, when applied to a 'Config',
returns an @(IO a)@ value to be used as @main@.
The @Main@ module of the program is trivial. All that is required
is to apply @dyreExample@ to the default configuration:
@
-- Main.hs --
import DyreExample
main = dyreExample defaultConfig
@
= Custom program configuration
Users can create a custom configuration file that overrides some or
all of the default configuration:
@
-- ~\/.config\/dyreExample\/dyreExample.hs --
import DyreExample
main = dyreExample $ defaultConfig { message = "Dyre Example v0.1 (Modified)" }
@
When a program that uses Dyre starts, Dyre checks to see if a custom
configuration exists. If so, it runs a custom executable. Dyre
(re)compiles and caches the custom executable the first time it sees
the custom config or whenever the custom config has changed.
If a custom configuration grows large, you can extract parts of it
into one or more files under @lib/@. For example:
@
-- ~\/.config\/dyreExample\/dyreExample.hs --
import DyreExample
import Message
main = dyreExample $ defaultConfig { message = Message.msg }
@
@
-- ~\/.config\/dyreExample\/lib/Message.hs --
module Message where
msg = "Dyre Example v0.1 (Modified)"
@
== Working with the Cabal store
For a Dyre-enabled program to work when installed via @cabal
install@, it needs to add its library directory as an extra include
directory for compilation. The library /package name/ __must__
match the Dyre 'projectName' for this to work. For example:
@
import Paths_dyreExample (getLibDir)
dyreExample cfg = do
libdir <- getLibDir
let params = (Dyre.'Config.Dyre.newParams' "dyreExample" realMain showError)
{ Dyre.'Config.Dyre.includeDirs' = [libdir] }
Dyre.'Config.Dyre.wrapMain' params cfg
@
See also the Cabal
<https://cabal.readthedocs.io/en/3.2/developing-packages.html#accessing-data-files-from-package-code Paths_pkgname feature documentation>.
== Specifying the compiler
If the compiler that Dyre should use is not available as @ghc@, set
the @HC@ environment variable when running the main program:
@
export HC=\/opt\/ghc\/$GHC_VERSION\/bin\/ghc
dyreExample # Dyre will use $HC for recompilation
@
= Configuring Dyre
Program authors configure Dyre using the 'Params' type. This type
controls Dyre's behaviour, not the main program logic (the example
uses the @Config@ type for that).
Use 'newParams' to construct a 'Params' value. The three arguments are:
- /Application name/ (a @String@). This affects the names of files and directories
that Dyre uses for config, cache and logging.
- The /real main/ function of the program, which has type
@(cfgType -> IO a)@. @cfgType@ is the main program config type,
and @a@ is usually @()@.
- The /show error/ function, which has type @(cfgType -> String ->
cfgType)@. If compiling the custom program fails, Dyre uses this
function to set the compiler output in the main program's
configuration. The main program can then display the error string
to the user, or handle it however the author sees fit.
The 'Params' type has several other fields for modifying Dyre's
behaviour. 'newParams' uses reasonable defaults, but behaviours you
can change include:
- Where to look for custom configuration ('configDir'). By default
Dyre will look for @$XDG_CONFIG_HOME\/\<appName\>\/\<appName\>.hs@,
- Where to cache the custom executable and other files ('cacheDir').
By default Dyre will use @$XDG_CACHE_HOME\/\<appName\>\/@.
- Extra options to pass to GHC when compiling the custom executable
('ghcOpts'). Default: none.
See 'Params' for descriptions of all the fields.
-}
module Config.Dyre
(
wrapMain
, Params(..)
, newParams
, defaultParams
) where
import System.IO ( hPutStrLn, stderr )
import System.Directory ( doesFileExist, canonicalizePath )
import System.Environment (getArgs)
import GHC.Environment (getFullArgs)
import Control.Exception (assert)
import Control.Monad ( when )
import Config.Dyre.Params ( Params(..), RTSOptionHandling(..) )
import Config.Dyre.Compile ( customCompile, getErrorString )
import Config.Dyre.Compat ( customExec )
import Config.Dyre.Options ( getForceReconf, getDenyReconf
, withDyreOptions )
import Config.Dyre.Paths
( getPathsConfig, customExecutable, runningExecutable, configFile
, checkFilesModified
)
-- | A set of reasonable defaults for configuring Dyre. The fields that
-- have to be filled are 'projectName', 'realMain', and 'showError'
-- (because their initial value is @undefined@).
--
-- Deprecated in favour of 'newParams' which takes the required
-- fields as arguments.
--
defaultParams :: Params cfgType a
defaultParams = Params
{ projectName = undefined
, configCheck = True
, configDir = Nothing
, cacheDir = Nothing
, realMain = undefined
, showError = undefined
, includeDirs = []
, hidePackages = []
, ghcOpts = []
, forceRecomp = True
, statusOut = hPutStrLn stderr
, rtsOptsHandling = RTSAppend []
, includeCurrentDirectory = True
}
{-# DEPRECATED defaultParams "Use 'newParams' instead" #-}
-- | Construct a 'Params' with the required values as given, and
-- reasonable defaults for everything else.
--
newParams
:: String -- ^ 'projectName'
-> (cfg -> IO a) -- ^ 'realMain' function
-> (cfg -> String -> cfg) -- ^ 'showError' function
-> Params cfg a
newParams name main err =
defaultParams { projectName = name, realMain = main, showError = err }
-- | @wrapMain@ is how Dyre receives 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.
--
-- @wrapMain@ returns whatever value is returned by the @realMain@ function
-- in the @params@ (if it returns at all). In the common case this is @()@
-- but you can use Dyre with any @IO@ action.
--
wrapMain :: Params cfgType a -> cfgType -> IO a
wrapMain params cfg = withDyreOptions params $
-- Allow the 'configCheck' parameter to disable all of Dyre's recompilation
-- checks, in favor of simply proceeding ahead to the 'realMain' function.
if not $ configCheck params
then realMain params cfg
else do
-- Get the important paths
paths <- getPathsConfig params
let tempBinary = customExecutable paths
thisBinary = runningExecutable paths
confExists <- doesFileExist (configFile paths)
denyReconf <- getDenyReconf
forceReconf <- getForceReconf
doReconf <- case (confExists, denyReconf, forceReconf) of
(False, _, _) -> pure False -- no config file
(_, True, _) -> pure False -- deny overrules force
(_, _, True) -> pure True -- avoid timestamp/hash checks
(_, _, False) -> checkFilesModified paths
when doReconf (customCompile params)
-- If there's a custom binary and we're not it, run it. Otherwise
-- just launch the main function, reporting errors if appropriate.
-- Also we don't want to use a custom binary if the conf file is
-- gone.
errorData <- getErrorString params
customExists <- doesFileExist tempBinary
case (confExists, customExists) of
(False, _) ->
-- There is no custom config. Ignore custom binary if present.
-- Run main binary and ignore errors file.
enterMain Nothing
(True, True) -> do
-- Canonicalize the paths for comparison to avoid symlinks
-- throwing us off. We do it here instead of earlier because
-- canonicalizePath throws an exception when the file is
-- nonexistent.
thisBinary' <- canonicalizePath thisBinary
tempBinary' <- canonicalizePath tempBinary
if thisBinary' /= tempBinary'
then launchSub errorData tempBinary
else enterMain errorData
(True, False) ->
-- Config exists, but no custom binary.
-- Looks like compile failed; run main binary with error data.
enterMain errorData
where launchSub errorData tempBinary = do
statusOut params $ "Launching custom binary " ++ tempBinary ++ "\n"
givenArgs <- handleRTSOptions $ rtsOptsHandling params
-- Deny reconfiguration if a compile already failed.
let arguments = case errorData of
Nothing -> givenArgs
Just _ -> "--deny-reconf":givenArgs
-- Execute
customExec tempBinary $ Just arguments
enterMain errorData = do
-- Show the error data if necessary
let mainConfig = case errorData of
Nothing -> cfg
Just ed -> showError params cfg ed
-- Enter the main program
realMain params mainConfig
assertM :: Applicative f => Bool -> f ()
assertM b = assert b (pure ())
-- | Extract GHC runtime system arguments
filterRTSArgs :: [String] -> [String]
filterRTSArgs = filt False
where
filt _ [] = []
filt _ ("--RTS":_) = []
filt False ("+RTS" :rest) = filt True rest
filt True ("-RTS" :rest) = filt False rest
filt False (_ :rest) = filt False rest
filt True (arg :rest) = arg:filt True rest
--filt state args = error $ "Error filtering RTS arguments in state " ++ show state ++ " remaining arguments: " ++ show args
editRTSOptions :: [String] -> RTSOptionHandling -> [String]
editRTSOptions _ (RTSReplace ls) = ls
editRTSOptions opts (RTSAppend ls) = opts ++ ls
handleRTSOptions :: RTSOptionHandling -> IO [String]
handleRTSOptions h = do fargs <- getFullArgs
args <- getArgs
let rtsArgs = editRTSOptions (filterRTSArgs fargs) h
assertM $ "--RTS" `notElem` rtsArgs
pure $ case rtsArgs of
[] | "+RTS" `elem` args -> "--RTS":args
| otherwise -> args -- cleaner output
_ -> "+RTS" : rtsArgs ++ "--RTS" : args