{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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)
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
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)
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
yi :: Config -> IO ()
yi :: Config -> IO ()
yi = Config -> IO ()
yiDriver
yiDriver :: Config -> IO ()
yiDriver :: Config -> IO ()
yiDriver = Bool -> Config -> IO ()
yiDriver' Bool
False
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
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)
profilingParams :: [String]
profilingParams :: [String]
profilingParams =
#ifdef EVENTLOG
["-eventlog", "-rtsopts"] ++
#endif
#ifdef PROFILING
["-prof", "-auto-all", "-rtsopts"
, "-osuf=p_o", "-hisuf=p_hi"] ++
#endif
[]