{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      :  Yi.Boot
-- License     :  GPL-2
-- Maintainer  :  yi-devel@googlegroups.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Boot process of Yi.
--
-- Uses Dyre to implement the XMonad-style dynamic reconfiguration.

module Yi.Boot (configMain, yi, yiDriver, yiDriver', reload) where

import qualified Config.Dyre as Dyre
import qualified Config.Dyre.Options as Dyre
import qualified Config.Dyre.Params as Dyre
import           Config.Dyre.Relaunch
import           Control.Monad.State hiding (modify, get)
import           Lens.Micro.Platform
import           Data.Text ()
import qualified Data.Text.IO as T (putStrLn)
import           System.Environment
import           System.Exit
import           Yi.Boot.Internal
import           Yi.Buffer.Misc (BufferId(..))
import           Yi.Config
import           Yi.Config.Simple.Types
import           Yi.Editor
import           Yi.Keymap
import           Yi.Main
import           Yi.Option (OptionError(..))
import           Yi.Paths (getCustomConfigPath)
import           Yi.Rope (fromString)

-- | Once the custom yi is compiled this restores the editor state (if
-- requested) then proceeds to run the editor.
realMain :: (Config, ConsoleConfig) -> IO ()
realMain :: (Config, ConsoleConfig) -> IO ()
realMain (Config, ConsoleConfig)
configs = Maybe Editor -> IO (Maybe Editor)
forall a. Binary a => a -> IO a
restoreBinaryState Maybe Editor
forall a. Maybe a
Nothing IO (Maybe Editor) -> (Maybe Editor -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Config, ConsoleConfig) -> Maybe Editor -> IO ()
main (Config, ConsoleConfig)
configs

-- | If the custom yi compile produces errors or warnings then the
-- messages are presented as a separate activity in the editor.
--
-- The use of a separate activity prevents any other initial actions
-- from immediately masking the output.
showErrorsInConf :: (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig)
showErrorsInConf :: (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig)
showErrorsInConf (Config, ConsoleConfig)
c String
errs = (Config, ConsoleConfig)
c (Config, ConsoleConfig)
-> ((Config, ConsoleConfig) -> (Config, ConsoleConfig))
-> (Config, ConsoleConfig)
forall a b. a -> (a -> b) -> b
& (Config -> Identity Config)
-> (Config, ConsoleConfig) -> Identity (Config, ConsoleConfig)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((Config -> Identity Config)
 -> (Config, ConsoleConfig) -> Identity (Config, ConsoleConfig))
-> (([Action] -> Identity [Action]) -> Config -> Identity Config)
-> ([Action] -> Identity [Action])
-> (Config, ConsoleConfig)
-> Identity (Config, ConsoleConfig)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Action] -> Identity [Action]) -> Config -> Identity Config
Lens' Config [Action]
initialActionsA (([Action] -> Identity [Action])
 -> (Config, ConsoleConfig) -> Identity (Config, ConsoleConfig))
-> ([Action] -> [Action])
-> (Config, ConsoleConfig)
-> (Config, ConsoleConfig)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (EditorM BufferRef -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction EditorM BufferRef
openErrBuf Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:)
  where
    openErrBuf :: EditorM BufferRef
openErrBuf = EditorM ()
splitE EditorM () -> EditorM BufferRef -> EditorM BufferRef
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BufferId -> YiString -> EditorM BufferRef
newBufferE (Text -> BufferId
MemBuffer Text
"*errors*") (String -> YiString
fromString String
errs)

-- | Starts with the given initial config, makes the described
-- modifications, then starts yi.
configMain :: Config -> ConfigM () -> IO ()
configMain :: Config -> ConfigM () -> IO ()
configMain Config
c ConfigM ()
m = Config -> IO ()
yi (Config -> IO ()) -> IO Config -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT Config IO () -> Config -> IO Config
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (ConfigM () -> StateT Config IO ()
forall a. ConfigM a -> StateT Config IO a
runConfigM ConfigM ()
m) Config
c

-- | Handy alias for 'yiDriver'.
yi :: Config -> IO ()
yi :: Config -> IO ()
yi = Config -> IO ()
yiDriver

-- | Called from the yi built with the user's configuration. Does not
-- ignore unknown arguments.
yiDriver :: Config -> IO ()
yiDriver :: Config -> IO ()
yiDriver = Bool -> Config -> IO ()
yiDriver' Bool
False

-- | Used by both the yi executable and the custom yi that is built
-- from the user's configuration. The yi executable uses a default
-- config.
yiDriver' :: Bool -> Config -> IO ()
yiDriver' :: Bool -> Config -> IO ()
yiDriver' Bool
ignoreUnknownArgs Config
cfg = do
  [String]
args <- Params Any -> IO [String] -> IO [String]
forall c a. Params c -> IO a -> IO a
Dyre.withDyreOptions Params Any
forall cfgType. Params cfgType
Dyre.defaultParams IO [String]
getArgs
  -- we do the arg processing before dyre, so we can extract
  -- '--ghc-option=' and '--help' and so on.
  case Bool
-> Config -> [String] -> Either OptionError (Config, ConsoleConfig)
do_args Bool
ignoreUnknownArgs Config
cfg [String]
args of
    Left (OptionError Text
err ExitCode
code) -> Text -> IO ()
T.putStrLn Text
err IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith ExitCode
code
    Right (Config
finalCfg, ConsoleConfig
cfgcon) -> do
      String
modules <- IO String -> String -> IO String
forall (m :: * -> *).
MonadBase IO m =>
m String -> String -> m String
getCustomConfigPath (ConsoleConfig -> IO String
userConfigDir ConsoleConfig
cfgcon) String
"modules"
      let yiParams :: Params (Config, ConsoleConfig)
yiParams = Params Any
forall cfgType. Params cfgType
Dyre.defaultParams
                      { projectName :: String
Dyre.projectName  = String
"yi"
                      , realMain :: (Config, ConsoleConfig) -> IO ()
Dyre.realMain     = (Config, ConsoleConfig) -> IO ()
realMain
                      , showError :: (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig)
Dyre.showError    = (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig)
showErrorsInConf
                      , configDir :: Maybe (IO String)
Dyre.configDir    = IO String -> Maybe (IO String)
forall a. a -> Maybe a
Just (IO String -> Maybe (IO String)) -> IO String -> Maybe (IO String)
forall a b. (a -> b) -> a -> b
$ ConsoleConfig -> IO String
userConfigDir ConsoleConfig
cfgcon
                      , ghcOpts :: [String]
Dyre.ghcOpts      = [String
"-threaded", String
"-O2", String
"-rtsopts"]
                                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-i" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
modules]
                                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
profilingParams
                                            [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ConsoleConfig -> [String]
ghcOptions ConsoleConfig
cfgcon
                      , includeCurrentDirectory :: Bool
Dyre.includeCurrentDirectory = Bool
False
                      , rtsOptsHandling :: RTSOptionHandling
Dyre.rtsOptsHandling = [String] -> RTSOptionHandling
Dyre.RTSAppend [String
"-I5"]
                      }
      Params (Config, ConsoleConfig) -> (Config, ConsoleConfig) -> IO ()
forall cfgType. Params cfgType -> cfgType -> IO ()
Dyre.wrapMain Params (Config, ConsoleConfig)
yiParams (Config
finalCfg, ConsoleConfig
cfgcon)

-- | CPP-guarded profiling params.
profilingParams :: [String]
profilingParams :: [String]
profilingParams =
#ifdef EVENTLOG
  ["-eventlog", "-rtsopts"] ++
#endif
#ifdef PROFILING
  ["-prof", "-auto-all", "-rtsopts"
  , "-osuf=p_o", "-hisuf=p_hi"] ++
#endif
  []