{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

-- | This is the main module of Yi, called with configuration from the user.
-- Here we mainly process command line arguments.

module Yi.Main (
                -- * Static main
                main,
                -- * Command line processing
                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

-- | Configuration information which can be set in the command-line, but not
-- in the user's configuration file.
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
                }

-- ---------------------------------------------------------------------
-- | Argument parsing. Pretty standard.

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)

-- | List of editors for which we provide an emulation.
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 string.
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)

-- | Transform the config with options
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)

-- | Update the default configuration based on a command-line option.
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)

-- ---------------------------------------------------------------------
-- | Static main. This is the front end to the statically linked
-- application, and the real front end, in a sense. 'dynamic_main' calls
-- this after setting preferences passed from the boot loader.
--
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