{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
module Yi.Main (
main,
do_args,
ConsoleConfig(..),
) where
import Control.Monad
import Data.Char
import Data.Monoid
import qualified Data.Text as T
import Data.List (intercalate)
import Data.Version (showVersion)
import Lens.Micro.Platform (view)
import System.Console.GetOpt
import System.Exit
#ifndef HLINT
#include "ghcconfig.h"
#endif
import Yi.Buffer
import Yi.Config
import Yi.Core (startEditor)
import Yi.Debug
import Yi.Editor
import Yi.File
import Yi.Keymap
import Yi.Option (YiOption, OptionError(..), yiCustomOptions)
import Yi.Paths (getConfigDir)
import Paths_yi_core
data ConsoleConfig =
ConsoleConfig {
ConsoleConfig -> [String]
ghcOptions :: [String],
ConsoleConfig -> Bool
selfCheck :: Bool,
ConsoleConfig -> IO String
userConfigDir :: IO FilePath
}
defaultConsoleConfig :: ConsoleConfig
defaultConsoleConfig :: ConsoleConfig
defaultConsoleConfig =
ConsoleConfig :: [String] -> Bool -> IO String -> ConsoleConfig
ConsoleConfig {
ghcOptions :: [String]
ghcOptions = [],
selfCheck :: Bool
selfCheck = Bool
False,
userConfigDir :: IO String
userConfigDir = IO String
forall (m :: * -> *). MonadBase IO m => m String
Yi.Paths.getConfigDir
}
data Opts = Help
| Version
| LineNo String
| EditorNm String
| File String
| Frontend String
| ConfigFile String
| SelfCheck
| GhcOption String
| Debug
| OpenInTabs
| CustomNoArg YiOption
| CustomReqArg (String -> YiOption) String
| CustomOptArg (Maybe String -> YiOption) (Maybe String)
editors :: [(String,Config -> Config)]
editors :: [(String, Config -> Config)]
editors = []
builtinOptions :: [OptDescr Opts]
builtinOptions :: [OptDescr Opts]
builtinOptions =
[ String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"self-check"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
SelfCheck) String
"Run self-checks"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'f'] [String
"frontend"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
Frontend String
"FRONTEND") String
frontendHelp
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'y'] [String
"config-file"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
ConfigFile String
"PATH") String
"Specify a folder containing a configuration yi.hs file"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'V'] [String
"version"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Version) String
"Show version information"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'h'] [String
"help"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Help) String
"Show this help"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"debug"] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
Debug) String
"Write debug information in a log file"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
'l'] [String
"line"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
LineNo String
"NUM") String
"Start on line number"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"as"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
EditorNm String
"EDITOR") String
editorHelp
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [] [String
"ghc-option"] ((String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg String -> Opts
GhcOption String
"OPTION") String
"Specify option to pass to ghc when compiling configuration file"
, String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option [Char
openInTabsShort] [String
openInTabsLong] (Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg Opts
OpenInTabs) String
"Open files in tabs"
] where frontendHelp :: String
frontendHelp = String
"Select frontend"
editorHelp :: String
editorHelp = String
"Start with editor keymap, where editor is one of:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> ([(String, Config -> Config)] -> [String])
-> [(String, Config -> Config)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Config -> Config) -> String)
-> [(String, Config -> Config)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Config -> Config) -> String
forall a b. (a, b) -> a
fst) [(String, Config -> Config)]
editors
convertCustomOption :: OptDescr YiOption -> OptDescr Opts
convertCustomOption :: OptDescr YiOption -> OptDescr Opts
convertCustomOption (Option String
short [String]
long ArgDescr YiOption
desc String
help) = String -> [String] -> ArgDescr Opts -> String -> OptDescr Opts
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
short [String]
long ArgDescr Opts
desc' String
help
where desc' :: ArgDescr Opts
desc' = ArgDescr YiOption -> ArgDescr Opts
convertCustomArgDesc ArgDescr YiOption
desc
convertCustomArgDesc :: ArgDescr YiOption -> ArgDescr Opts
convertCustomArgDesc :: ArgDescr YiOption -> ArgDescr Opts
convertCustomArgDesc (NoArg YiOption
o) = Opts -> ArgDescr Opts
forall a. a -> ArgDescr a
NoArg (YiOption -> Opts
CustomNoArg YiOption
o)
convertCustomArgDesc (ReqArg String -> YiOption
f String
s) = (String -> Opts) -> String -> ArgDescr Opts
forall a. (String -> a) -> String -> ArgDescr a
ReqArg ((String -> YiOption) -> String -> Opts
CustomReqArg String -> YiOption
f) String
s
convertCustomArgDesc (OptArg Maybe String -> YiOption
f String
s) = (Maybe String -> Opts) -> String -> ArgDescr Opts
forall a. (Maybe String -> a) -> String -> ArgDescr a
OptArg ((Maybe String -> YiOption) -> Maybe String -> Opts
CustomOptArg Maybe String -> YiOption
f) String
s
customOptions :: Config -> [OptDescr Opts]
customOptions :: Config -> [OptDescr Opts]
customOptions = (OptDescr YiOption -> OptDescr Opts)
-> [OptDescr YiOption] -> [OptDescr Opts]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OptDescr YiOption -> OptDescr Opts
convertCustomOption ([OptDescr YiOption] -> [OptDescr Opts])
-> (Config -> [OptDescr YiOption]) -> Config -> [OptDescr Opts]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting [OptDescr YiOption] Config [OptDescr YiOption]
-> Config -> [OptDescr YiOption]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [OptDescr YiOption] Config [OptDescr YiOption]
Lens' Config [OptDescr YiOption]
yiCustomOptions
openInTabsShort :: Char
openInTabsShort :: Char
openInTabsShort = Char
'p'
openInTabsLong :: String
openInTabsLong :: String
openInTabsLong = String
"open-in-tabs"
usage :: [OptDescr Opts] -> T.Text
usage :: [OptDescr Opts] -> Text
usage [OptDescr Opts]
opts = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [OptDescr Opts] -> String
forall a. String -> [OptDescr a] -> String
usageInfo String
"Usage: yi [option...] [file]" [OptDescr Opts]
opts
versinfo :: T.Text
versinfo :: Text
versinfo = Text
"yi " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Version -> String
showVersion Version
version)
do_args :: Bool -> Config -> [String] -> Either OptionError (Config, ConsoleConfig)
do_args :: Bool
-> Config -> [String] -> Either OptionError (Config, ConsoleConfig)
do_args Bool
ignoreUnknown Config
cfg [String]
args = let options :: [OptDescr Opts]
options = Config -> [OptDescr Opts]
customOptions Config
cfg [OptDescr Opts] -> [OptDescr Opts] -> [OptDescr Opts]
forall a. [a] -> [a] -> [a]
++ [OptDescr Opts]
builtinOptions in
case ArgOrder Opts
-> [OptDescr Opts]
-> [String]
-> ([Opts], [String], [String], [String])
forall a.
ArgOrder a
-> [OptDescr a] -> [String] -> ([a], [String], [String], [String])
getOpt' ((String -> Opts) -> ArgOrder Opts
forall a. (String -> a) -> ArgOrder a
ReturnInOrder String -> Opts
File) [OptDescr Opts]
options [String]
args of
([Opts]
os, [], [], []) -> [OptDescr Opts]
-> [Opts] -> Either OptionError (Config, ConsoleConfig)
handle [OptDescr Opts]
options [Opts]
os
([Opts]
os, [String]
_, String
u:[String]
us, []) -> if Bool
ignoreUnknown
then [OptDescr Opts]
-> [Opts] -> Either OptionError (Config, ConsoleConfig)
handle [OptDescr Opts]
options [Opts]
os
else String -> Either OptionError (Config, ConsoleConfig)
forall a. HasCallStack => String -> a
Prelude.error (String -> Either OptionError (Config, ConsoleConfig))
-> String -> Either OptionError (Config, ConsoleConfig)
forall a b. (a -> b) -> a -> b
$ String
"unknown arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (String
uString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
us)
([Opts]
_os, [String]
_ex, [String]
_ey, [String]
errs) -> String -> Either OptionError (Config, ConsoleConfig)
forall a. HasCallStack => String -> a
Prelude.error ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
errs)
where
shouldOpenInTabs :: Bool
shouldOpenInTabs = (String
"--" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
openInTabsLong) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args
Bool -> Bool -> Bool
|| (Char
'-'Char -> String -> String
forall a. a -> [a] -> [a]
:[Char
openInTabsShort]) String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args
handle :: [OptDescr Opts]
-> [Opts] -> Either OptionError (Config, ConsoleConfig)
handle [OptDescr Opts]
options [Opts]
os = ((Config, ConsoleConfig)
-> Opts -> Either OptionError (Config, ConsoleConfig))
-> (Config, ConsoleConfig)
-> [Opts]
-> Either OptionError (Config, ConsoleConfig)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([OptDescr Opts]
-> Bool
-> (Config, ConsoleConfig)
-> Opts
-> Either OptionError (Config, ConsoleConfig)
getConfig [OptDescr Opts]
options Bool
shouldOpenInTabs) (Config
cfg, ConsoleConfig
defaultConsoleConfig) ([Opts] -> [Opts]
forall a. [a] -> [a]
reverse [Opts]
os)
getConfig :: [OptDescr Opts] -> Bool -> (Config, ConsoleConfig) -> Opts -> Either OptionError (Config, ConsoleConfig)
getConfig :: [OptDescr Opts]
-> Bool
-> (Config, ConsoleConfig)
-> Opts
-> Either OptionError (Config, ConsoleConfig)
getConfig [OptDescr Opts]
options Bool
shouldOpenInTabs (Config
cfg, ConsoleConfig
cfgcon) Opts
opt =
case Opts
opt of
Frontend String
_ -> String -> Either OptionError (Config, ConsoleConfig)
forall a. HasCallStack => String -> a
Prelude.error String
"Panic: frontend not found"
Opts
Help -> OptionError -> Either OptionError (Config, ConsoleConfig)
forall a b. a -> Either a b
Left (OptionError -> Either OptionError (Config, ConsoleConfig))
-> OptionError -> Either OptionError (Config, ConsoleConfig)
forall a b. (a -> b) -> a -> b
$ Text -> ExitCode -> OptionError
OptionError ([OptDescr Opts] -> Text
usage [OptDescr Opts]
options) ExitCode
ExitSuccess
Opts
Version -> OptionError -> Either OptionError (Config, ConsoleConfig)
forall a b. a -> Either a b
Left (OptionError -> Either OptionError (Config, ConsoleConfig))
-> OptionError -> Either OptionError (Config, ConsoleConfig)
forall a b. (a -> b) -> a -> b
$ Text -> ExitCode -> OptionError
OptionError Text
versinfo ExitCode
ExitSuccess
Opts
Debug -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg { debugMode :: Bool
debugMode = Bool
True }, ConsoleConfig
cfgcon)
LineNo String
l -> case Config -> [Action]
startActions Config
cfg of
Action
x : [Action]
xs -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg { startActions :: [Action]
startActions = Action
xAction -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:BufferM Int -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction (Int -> BufferM Int
gotoLn (String -> Int
forall a. Read a => String -> a
read String
l))Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
:[Action]
xs }, ConsoleConfig
cfgcon)
[] -> String -> Either OptionError (Config, ConsoleConfig)
forall a. HasCallStack => String -> a
Prelude.error String
"The `-l' option must come after a file argument"
File String
filename -> if Bool
shouldOpenInTabs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Action] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Config -> [Action]
startActions Config
cfg)) then
[Action] -> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a x.
(Monad m, YiAction a x, Show x) =>
[a] -> m (Config, ConsoleConfig)
prependActions [YiM () -> Action
forall a. Show a => YiM a -> Action
YiA (YiM () -> Action) -> YiM () -> Action
forall a b. (a -> b) -> a -> b
$ String -> YiM ()
openNewFile String
filename, EditorM () -> Action
forall a. Show a => EditorM a -> Action
EditorA EditorM ()
newTabE]
else
YiM () -> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a x.
(Monad m, YiAction a x, Show x) =>
a -> m (Config, ConsoleConfig)
prependAction (YiM () -> Either OptionError (Config, ConsoleConfig))
-> YiM () -> Either OptionError (Config, ConsoleConfig)
forall a b. (a -> b) -> a -> b
$ String -> YiM ()
openNewFile String
filename
EditorNm String
emul -> case String -> [(String, Config -> Config)] -> Maybe (Config -> Config)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ((Char -> Char) -> String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Char
toLower String
emul) [(String, Config -> Config)]
editors of
Just Config -> Config
modifyCfg -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config -> Config
modifyCfg Config
cfg, ConsoleConfig
cfgcon)
Maybe (Config -> Config)
Nothing -> String -> Either OptionError (Config, ConsoleConfig)
forall a. HasCallStack => String -> a
Prelude.error (String -> Either OptionError (Config, ConsoleConfig))
-> String -> Either OptionError (Config, ConsoleConfig)
forall a b. (a -> b) -> a -> b
$ String
"Unknown emulation: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
emul
GhcOption String
ghcOpt -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg, ConsoleConfig
cfgcon { ghcOptions :: [String]
ghcOptions = ConsoleConfig -> [String]
ghcOptions ConsoleConfig
cfgcon [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
ghcOpt] })
ConfigFile String
f -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg, ConsoleConfig
cfgcon { userConfigDir :: IO String
userConfigDir = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
f })
CustomNoArg YiOption
o -> do
Config
cfg' <- YiOption
o Config
cfg
(Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg', ConsoleConfig
cfgcon)
CustomReqArg String -> YiOption
f String
s -> do
Config
cfg' <- String -> YiOption
f String
s Config
cfg
(Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg', ConsoleConfig
cfgcon)
CustomOptArg Maybe String -> YiOption
f Maybe String
s -> do
Config
cfg' <- Maybe String -> YiOption
f Maybe String
s Config
cfg
(Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg', ConsoleConfig
cfgcon)
Opts
_ -> (Config, ConsoleConfig)
-> Either OptionError (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg, ConsoleConfig
cfgcon)
where
prependActions :: [a] -> m (Config, ConsoleConfig)
prependActions [a]
as = (Config, ConsoleConfig) -> m (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg { startActions :: [Action]
startActions = (a -> Action) -> [a] -> [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction [a]
as [Action] -> [Action] -> [Action]
forall a. [a] -> [a] -> [a]
++ Config -> [Action]
startActions Config
cfg }, ConsoleConfig
cfgcon)
prependAction :: a -> m (Config, ConsoleConfig)
prependAction a
a = (Config, ConsoleConfig) -> m (Config, ConsoleConfig)
forall (m :: * -> *) a. Monad m => a -> m a
return (Config
cfg { startActions :: [Action]
startActions = a -> Action
forall a x. (YiAction a x, Show x) => a -> Action
makeAction a
a Action -> [Action] -> [Action]
forall a. a -> [a] -> [a]
: Config -> [Action]
startActions Config
cfg}, ConsoleConfig
cfgcon)
main :: (Config, ConsoleConfig) -> Maybe Editor -> IO ()
main :: (Config, ConsoleConfig) -> Maybe Editor -> IO ()
main (Config
cfg, ConsoleConfig
_cfgcon) Maybe Editor
state = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
debugMode Config
cfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
initDebug String
".yi.dbg"
Config -> Maybe Editor -> IO ()
startEditor Config
cfg Maybe Editor
state