content: {- |
  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
  
  