    {- |
    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 :: forall cfgType a. Params cfgType a
    defaultParams = Params
        { projectName :: String
    projectName  = String
    forall a. HasCallStack => a
    undefined
        , configCheck :: Bool
    configCheck  = Bool
    True
        , configDir :: Maybe (IO String)
    configDir    = Maybe (IO String)
    forall a. Maybe a
    Nothing
        , cacheDir :: Maybe (IO String)
    cacheDir     = Maybe (IO String)
    forall a. Maybe a
    Nothing
        , realMain :: cfgType -> IO a
    realMain     = cfgType -> IO a
    forall a. HasCallStack => a
    undefined
        , showError :: cfgType -> String -> cfgType
    showError    = cfgType -> String -> cfgType
    forall a. HasCallStack => a
    undefined
        , includeDirs :: [String]
    includeDirs  = []
        , hidePackages :: [String]
    hidePackages = []
        , ghcOpts :: [String]
    ghcOpts      = []
        , forceRecomp :: Bool
    forceRecomp  = Bool
    True
        , statusOut :: String -> IO ()
    statusOut    = Handle -> String -> IO ()
    hPutStrLn Handle
    stderr
        , rtsOptsHandling :: RTSOptionHandling
    rtsOptsHandling = [String] -> RTSOptionHandling
    RTSAppend []
        , includeCurrentDirectory :: Bool
    includeCurrentDirectory = Bool
    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 :: forall cfg a.
    String -> (cfg -> IO a) -> (cfg -> String -> cfg) -> Params cfg a
    newParams String
    name cfg -> IO a
    main cfg -> String -> cfg
    err =
      Params (ZonkAny 1) (ZonkAny 0)
    forall cfgType a. Params cfgType a
    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 :: forall cfgType a. Params cfgType a -> cfgType -> IO a
    wrapMain Params cfgType a
    params cfgType
    cfg = Params cfgType a -> IO a -> IO a
    forall c r a. Params c r -> IO a -> IO a
    withDyreOptions Params cfgType a
    params (IO a -> IO a) -> IO a -> IO a
    forall a b. (a -> b) -> a -> b
    $
        -- Allow the 'configCheck' parameter to disable all of Dyre's recompilation
        -- checks, in favor of simply proceeding ahead to the 'realMain' function.
        if Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Params cfgType a -> Bool
    forall cfgType a. Params cfgType a -> Bool
    configCheck Params cfgType a
    params
           then Params cfgType a -> cfgType -> IO a
    forall cfgType a. Params cfgType a -> cfgType -> IO a
    realMain Params cfgType a
    params cfgType
    cfg
           else do
            -- Get the important paths
            paths <- Params cfgType a -> IO PathsConfig
    forall cfg a. Params cfg a -> IO PathsConfig
    getPathsConfig Params cfgType a
    params
            let tempBinary = PathsConfig -> String
    customExecutable PathsConfig
    paths
                thisBinary = PathsConfig -> String
    runningExecutable PathsConfig
    paths

            confExists <- doesFileExist (configFile paths)

            denyReconf  <- getDenyReconf
            forceReconf <- getForceReconf

            doReconf <- case (confExists, denyReconf, forceReconf) of
              (Bool
    False, Bool
    _, Bool
    _) -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False  -- no config file
              (Bool
    _, Bool
    True, Bool
    _)  -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False  -- deny overrules force
              (Bool
    _, Bool
    _, Bool
    True)  -> Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True   -- avoid timestamp/hash checks
              (Bool
    _, Bool
    _, Bool
    False) -> PathsConfig -> IO Bool
    checkFilesModified PathsConfig
    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
              (Bool
    False, Bool
    _) ->
                -- There is no custom config.  Ignore custom binary if present.
                -- Run main binary and ignore errors file.
                Maybe String -> IO a
    enterMain Maybe String
    forall a. Maybe a
    Nothing
              (Bool
    True, Bool
    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' <- String -> IO String
    canonicalizePath String
    thisBinary
                   tempBinary' <- canonicalizePath tempBinary
                   if thisBinary' /= tempBinary'
                      then launchSub errorData tempBinary
                      else enterMain errorData
              (Bool
    True, Bool
    False) ->
                -- Config exists, but no custom binary.
                -- Looks like compile failed; run main binary with error data.
               Maybe String -> IO a
    enterMain Maybe String
    errorData
      where launchSub :: Maybe a -> String -> IO b
    launchSub Maybe a
    errorData String
    tempBinary = do
                Params cfgType a -> String -> IO ()
    forall cfgType a. Params cfgType a -> String -> IO ()
    statusOut Params cfgType a
    params (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Launching custom binary " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    tempBinary String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n"
                givenArgs <- RTSOptionHandling -> IO [String]
    handleRTSOptions (RTSOptionHandling -> IO [String])
    -> RTSOptionHandling -> IO [String]
    forall a b. (a -> b) -> a -> b
    $ Params cfgType a -> RTSOptionHandling
    forall cfgType a. Params cfgType a -> RTSOptionHandling
    rtsOptsHandling Params cfgType a
    params
                -- Deny reconfiguration if a compile already failed.
                let arguments = case Maybe a
    errorData of
                                  Maybe a
    Nothing -> [String]
    givenArgs
                                  Just a
    _  -> String
    "--deny-reconf"String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    givenArgs
                -- Execute
                customExec tempBinary $ Just arguments
            enterMain :: Maybe String -> IO a
    enterMain Maybe String
    errorData = do
                -- Show the error data if necessary
                let mainConfig :: cfgType
    mainConfig = case Maybe String
    errorData of
                                      Maybe String
    Nothing -> cfgType
    cfg
                                      Just String
    ed -> Params cfgType a -> cfgType -> String -> cfgType
    forall cfgType a. Params cfgType a -> cfgType -> String -> cfgType
    showError Params cfgType a
    params cfgType
    cfg String
    ed
                -- Enter the main program
                Params cfgType a -> cfgType -> IO a
    forall cfgType a. Params cfgType a -> cfgType -> IO a
    realMain Params cfgType a
    params cfgType
    mainConfig

    assertM :: Applicative f => Bool -> f ()
    assertM :: forall (f :: * -> *). Applicative f => Bool -> f ()
    assertM Bool
    b = Bool -> f () -> f ()
    forall a. HasCallStack => Bool -> a -> a
    assert Bool
    b (() -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())

    -- | Extract GHC runtime system arguments
    filterRTSArgs :: [String] -> [String]
    filterRTSArgs :: [String] -> [String]
    filterRTSArgs = Bool -> [String] -> [String]
    filt Bool
    False
      where
        filt :: Bool -> [String] -> [String]
    filt Bool
    _     []             = []
        filt Bool
    _     (String
    "--RTS":[String]
    _)    = []
        filt Bool
    False (String
    "+RTS" :[String]
    rest) = Bool -> [String] -> [String]
    filt Bool
    True  [String]
    rest
        filt Bool
    True  (String
    "-RTS" :[String]
    rest) = Bool -> [String] -> [String]
    filt Bool
    False [String]
    rest
        filt Bool
    False (String
    _      :[String]
    rest) = Bool -> [String] -> [String]
    filt Bool
    False [String]
    rest
        filt Bool
    True  (String
    arg    :[String]
    rest) = String
    argString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :Bool -> [String] -> [String]
    filt Bool
    True [String]
    rest
        --filt state args           = error $ "Error filtering RTS arguments in state " ++ show state ++ " remaining arguments: " ++ show args

    editRTSOptions :: [String] -> RTSOptionHandling -> [String]
    editRTSOptions :: [String] -> RTSOptionHandling -> [String]
    editRTSOptions [String]
    _ (RTSReplace [String]
    ls) = [String]
    ls
    editRTSOptions [String]
    opts (RTSAppend [String]
    ls)  = [String]
    opts [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    ls

    handleRTSOptions :: RTSOptionHandling -> IO [String]
    handleRTSOptions :: RTSOptionHandling -> IO [String]
    handleRTSOptions RTSOptionHandling
    h = do fargs <- IO [String]
    getFullArgs
                            args  <- getArgs
                            let rtsArgs = [String] -> RTSOptionHandling -> [String]
    editRTSOptions ([String] -> [String]
    filterRTSArgs [String]
    fargs) RTSOptionHandling
    h
                            assertM $ "--RTS" `notElem` rtsArgs
                            pure $ case rtsArgs of
                              [] | String
    "+RTS" String -> [String] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [String]
    args -> String
    "--RTS"String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args
                                 | Bool
    otherwise          -> [String]
    args  -- cleaner output
                              [String]
    _                       -> String
    "+RTS" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    rtsArgs [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ String
    "--RTS" String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    args