module Neovim.Main
where
import Neovim.Config
import qualified Neovim.Context.Internal as Internal
import Neovim.Log
import qualified Neovim.Plugin as P
import Neovim.RPC.Common as RPC
import Neovim.RPC.EventHandler
import Neovim.RPC.SocketReader
import Neovim.Util (oneLineErrorMessage)
import Control.Concurrent
import Control.Concurrent.STM (atomically, putTMVar)
import Control.Monad
import Data.Default
import Data.Maybe
import Data.Monoid
import Options.Applicative
import System.IO (stdin, stdout)
import UnliftIO.Async (Async, async)
import Prelude
logger :: String
logger :: String
logger = String
"Neovim.Main"
data CommandLineOptions =
Opt { CommandLineOptions -> Maybe String
providerName :: Maybe String
, CommandLineOptions -> Maybe (String, Int)
hostPort :: Maybe (String, Int)
, CommandLineOptions -> Maybe String
unix :: Maybe FilePath
, CommandLineOptions -> Bool
envVar :: Bool
, CommandLineOptions -> Maybe (String, Priority)
logOpts :: Maybe (FilePath, Priority)
}
instance Default CommandLineOptions where
def :: CommandLineOptions
def = Opt :: Maybe String
-> Maybe (String, Int)
-> Maybe String
-> Bool
-> Maybe (String, Priority)
-> CommandLineOptions
Opt
{ providerName :: Maybe String
providerName = Maybe String
forall a. Maybe a
Nothing
, hostPort :: Maybe (String, Int)
hostPort = Maybe (String, Int)
forall a. Maybe a
Nothing
, unix :: Maybe String
unix = Maybe String
forall a. Maybe a
Nothing
, envVar :: Bool
envVar = Bool
False
, logOpts :: Maybe (String, Priority)
logOpts = Maybe (String, Priority)
forall a. Maybe a
Nothing
}
optParser :: Parser CommandLineOptions
optParser :: Parser CommandLineOptions
optParser = Maybe String
-> Maybe (String, Int)
-> Maybe String
-> Bool
-> Maybe (String, Priority)
-> CommandLineOptions
Opt
(Maybe String
-> Maybe (String, Int)
-> Maybe String
-> Bool
-> Maybe (String, Priority)
-> CommandLineOptions)
-> Parser (Maybe String)
-> Parser
(Maybe (String, Int)
-> Maybe String
-> Bool
-> Maybe (String, Priority)
-> CommandLineOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod ArgumentFields String -> Parser String
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
(String -> Mod ArgumentFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
Mod ArgumentFields String
-> Mod ArgumentFields String -> Mod ArgumentFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod ArgumentFields String
forall (f :: * -> *) a. String -> Mod f a
help ([String] -> String
unlines
[ String
"Name that associates the plugin provider with neovim."
, String
"This option has only an effect if you start nvim-hs"
, String
"with rpcstart()/jobstart() and use the factory method approach."
, String
"Since it is extremely hard to figure that out inside"
, String
"nvim-hs, this option is assumed to used if the input"
, String
"and output is tied to standard in and standard out."
])))
Parser
(Maybe (String, Int)
-> Maybe String
-> Bool
-> Maybe (String, Priority)
-> CommandLineOptions)
-> Parser (Maybe (String, Int))
-> Parser
(Maybe String
-> Bool -> Maybe (String, Priority) -> CommandLineOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (String, Int) -> Parser (Maybe (String, Int))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,)
(String -> Int -> (String, Int))
-> Parser String -> Parser (Int -> (String, Int))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOSTNAME"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the specified host. (requires -p)")
Parser (Int -> (String, Int)) -> Parser Int -> Parser (String, Int)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int
forall a. Read a => ReadM a
auto
(String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the specified port. (requires -a)"))
Parser
(Maybe String
-> Bool -> Maybe (String, Priority) -> CommandLineOptions)
-> Parser (Maybe String)
-> Parser (Bool -> Maybe (String, Priority) -> CommandLineOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unix"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the given unix domain socket."))
Parser (Bool -> Maybe (String, Priority) -> CommandLineOptions)
-> Parser Bool
-> Parser (Maybe (String, Priority) -> CommandLineOptions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"environment"
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e'
Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Read connection information from $NVIM_LISTEN_ADDRESS.")
Parser (Maybe (String, Priority) -> CommandLineOptions)
-> Parser (Maybe (String, Priority)) -> Parser CommandLineOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (String, Priority) -> Parser (Maybe (String, Priority))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,)
(String -> Priority -> (String, Priority))
-> Parser String -> Parser (Priority -> (String, Priority))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
(String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-file"
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to log to.")
Parser (Priority -> (String, Priority))
-> Parser Priority -> Parser (String, Priority)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Priority -> Mod OptionFields Priority -> Parser Priority
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Priority
forall a. Read a => ReadM a
auto
(String -> Mod OptionFields Priority
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level"
Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Priority
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
Mod OptionFields Priority
-> Mod OptionFields Priority -> Mod OptionFields Priority
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Priority
forall (f :: * -> *) a. String -> Mod f a
help (String
"Log level. Must be one of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords ([String] -> String)
-> ([Priority] -> [String]) -> [Priority] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Priority -> String) -> [Priority] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Priority -> String
forall a. Show a => a -> String
show) [Priority]
logLevels)))
where
logLevels :: [Priority]
logLevels :: [Priority]
logLevels = [ Priority
DEBUG, Priority
INFO, Priority
NOTICE, Priority
WARNING, Priority
ERROR, Priority
CRITICAL, Priority
ALERT, Priority
EMERGENCY ]
opts :: ParserInfo CommandLineOptions
opts :: ParserInfo CommandLineOptions
opts = Parser CommandLineOptions
-> InfoMod CommandLineOptions -> ParserInfo CommandLineOptions
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (CommandLineOptions -> CommandLineOptions)
forall a. Parser (a -> a)
helper Parser (CommandLineOptions -> CommandLineOptions)
-> Parser CommandLineOptions -> Parser CommandLineOptions
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CommandLineOptions
optParser)
(InfoMod CommandLineOptions
forall a. InfoMod a
fullDesc
InfoMod CommandLineOptions
-> InfoMod CommandLineOptions -> InfoMod CommandLineOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CommandLineOptions
forall a. String -> InfoMod a
header String
"Start a neovim plugin provider for Haskell plugins."
InfoMod CommandLineOptions
-> InfoMod CommandLineOptions -> InfoMod CommandLineOptions
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod CommandLineOptions
forall a. String -> InfoMod a
progDesc String
"This is still work in progress. Feel free to contribute.")
neovim :: NeovimConfig -> IO ()
neovim :: NeovimConfig -> IO ()
neovim = TransitionHandler () -> NeovimConfig -> IO ()
forall a. TransitionHandler a -> NeovimConfig -> IO ()
realMain TransitionHandler ()
standalone
type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a
realMain :: TransitionHandler a
-> NeovimConfig
-> IO ()
realMain :: TransitionHandler a -> NeovimConfig -> IO ()
realMain TransitionHandler a
transitionHandler NeovimConfig
cfg = do
CommandLineOptions
os <- ParserInfo CommandLineOptions -> IO CommandLineOptions
forall a. ParserInfo a -> IO a
execParser ParserInfo CommandLineOptions
opts
(IO () -> IO ())
-> ((String, Priority) -> IO () -> IO ())
-> Maybe (String, Priority)
-> IO ()
-> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO () -> IO ()
forall a. IO a -> IO a
disableLogger ((String -> Priority -> IO () -> IO ())
-> (String, Priority) -> IO () -> IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Priority -> IO () -> IO ()
forall a. String -> Priority -> IO a -> IO a
withLogger) (CommandLineOptions -> Maybe (String, Priority)
logOpts CommandLineOptions
os Maybe (String, Priority)
-> Maybe (String, Priority) -> Maybe (String, Priority)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NeovimConfig -> Maybe (String, Priority)
logOptions NeovimConfig
cfg) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> String -> IO ()
debugM String
logger String
"Starting up neovim haskell plguin provider"
IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider CommandLineOptions
os (NeovimConfig -> Maybe NeovimConfig
forall a. a -> Maybe a
Just NeovimConfig
cfg) TransitionHandler a
transitionHandler
runPluginProvider
:: CommandLineOptions
-> Maybe NeovimConfig
-> TransitionHandler a
-> IO a
runPluginProvider :: CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider CommandLineOptions
os Maybe NeovimConfig
mcfg TransitionHandler a
transitionHandler = case (CommandLineOptions -> Maybe (String, Int)
hostPort CommandLineOptions
os, CommandLineOptions -> Maybe String
unix CommandLineOptions
os) of
(Just (String
h,Int
p), Maybe String
_) ->
SocketType -> IO Handle
forall (io :: * -> *).
(Functor io, MonadIO io) =>
SocketType -> io Handle
createHandle (Int -> String -> SocketType
TCP Int
p String
h) IO Handle -> (Handle -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Handle
s -> Handle -> Handle -> IO a
run Handle
s Handle
s
(Maybe (String, Int)
_, Just String
fp) ->
SocketType -> IO Handle
forall (io :: * -> *).
(Functor io, MonadIO io) =>
SocketType -> io Handle
createHandle (String -> SocketType
UnixSocket String
fp) IO Handle -> (Handle -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Handle
s -> Handle -> Handle -> IO a
run Handle
s Handle
s
(Maybe (String, Int), Maybe String)
_ | CommandLineOptions -> Bool
envVar CommandLineOptions
os ->
SocketType -> IO Handle
forall (io :: * -> *).
(Functor io, MonadIO io) =>
SocketType -> io Handle
createHandle SocketType
Environment IO Handle -> (Handle -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Handle
s -> Handle -> Handle -> IO a
run Handle
s Handle
s
(Maybe (String, Int), Maybe String)
_ ->
Handle -> Handle -> IO a
run Handle
stdout Handle
stdin
where
run :: Handle -> Handle -> IO a
run Handle
evHandlerHandle Handle
sockreaderHandle = do
let allPlugins :: [Neovim () NeovimPlugin]
allPlugins = [Neovim () NeovimPlugin]
-> (NeovimConfig -> [Neovim () NeovimPlugin])
-> Maybe NeovimConfig
-> [Neovim () NeovimPlugin]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NeovimConfig -> [Neovim () NeovimPlugin]
plugins Maybe NeovimConfig
mcfg
Config RPCConfig
conf <- IO (Maybe String) -> IO RPCConfig -> IO (Config RPCConfig)
forall env. IO (Maybe String) -> IO env -> IO (Config env)
Internal.newConfig (Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandLineOptions -> Maybe String
providerName CommandLineOptions
os)) IO RPCConfig
forall (io :: * -> *). (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig
Async ()
ehTid <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Handle -> Config RPCConfig -> IO ()
runEventHandler
Handle
evHandlerHandle
Config RPCConfig
conf { pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = Maybe (PluginSettings RPCConfig)
forall a. Maybe a
Nothing }
Async ()
srTid <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Handle -> Config RPCConfig -> IO ()
runSocketReader Handle
sockreaderHandle Config RPCConfig
conf
let startupConf :: Config ()
startupConf = () -> Config RPCConfig -> Config ()
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () Config RPCConfig
conf
Config ()
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
P.startPluginThreads Config ()
startupConf [Neovim () NeovimPlugin]
allPlugins IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
-> (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()])
-> IO a)
-> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Doc AnsiStyle
e -> do
String -> String -> IO ()
errorM String
logger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error initializing plugins: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show (Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e)
MVar StateTransition -> StateTransition -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) (StateTransition -> IO ()) -> StateTransition -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> StateTransition
Internal.Failure Doc AnsiStyle
e
TransitionHandler a
transitionHandler [Async ()
ehTid, Async ()
srTid] Config RPCConfig
conf
Right ([FunctionMapEntry]
funMapEntries, [Async ()]
pluginTids) -> do
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar FunctionMap -> FunctionMap -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar
(Config RPCConfig -> TMVar FunctionMap
forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
conf)
([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [FunctionMapEntry]
funMapEntries)
MVar StateTransition -> StateTransition -> IO ()
forall a. MVar a -> a -> IO ()
putMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) (StateTransition -> IO ()) -> StateTransition -> IO ()
forall a b. (a -> b) -> a -> b
$ StateTransition
Internal.InitSuccess
TransitionHandler a
transitionHandler (Async ()
srTidAsync () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
:Async ()
ehTidAsync () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
:[Async ()]
pluginTids) Config RPCConfig
conf
standalone :: TransitionHandler ()
standalone :: TransitionHandler ()
standalone [Async ()]
threads Config RPCConfig
cfg = MVar StateTransition -> IO StateTransition
forall a. MVar a -> IO a
takeMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) IO StateTransition -> (StateTransition -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
StateTransition
Internal.InitSuccess -> do
String -> String -> IO ()
debugM String
logger String
"Initialization Successful"
TransitionHandler ()
standalone [Async ()]
threads Config RPCConfig
cfg
StateTransition
Internal.Restart -> do
String -> String -> IO ()
errorM String
logger String
"Cannot restart"
TransitionHandler ()
standalone [Async ()]
threads Config RPCConfig
cfg
Internal.Failure Doc AnsiStyle
e ->
String -> String -> IO ()
errorM String
logger (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. Show a => a -> String
show (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e
StateTransition
Internal.Quit ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()