{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Neovim.Main where
import Neovim.Config (
NeovimConfig (logOptions, plugins),
Priority (..),
)
import qualified Neovim.Context.Internal as Internal
import Neovim.Log (debugM, disableLogger, errorM, withLogger)
import qualified Neovim.Plugin as P
import Neovim.RPC.Common as RPC (
RPCConfig,
SocketType (Environment, TCP, UnixSocket),
createHandle,
newRPCConfig,
)
import Neovim.RPC.EventHandler (runEventHandler)
import Neovim.RPC.SocketReader (runSocketReader)
import Neovim.Util (oneLineErrorMessage)
import Control.Monad (void)
import Data.Default (Default (..))
import Options.Applicative (
Parser,
ParserInfo,
auto,
execParser,
fullDesc,
header,
help,
helper,
info,
long,
metavar,
option,
optional,
progDesc,
short,
strArgument,
strOption,
switch,
)
import System.IO (stdin, stdout)
import UnliftIO (Async, async, putMVar, atomically, putTMVar, takeMVar)
import Control.Applicative ((<|>))
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
{ providerName :: Maybe String
providerName = forall a. Maybe a
Nothing
, hostPort :: Maybe (String, Int)
hostPort = forall a. Maybe a
Nothing
, unix :: Maybe String
unix = forall a. Maybe a
Nothing
, envVar :: Bool
envVar = Bool
False
, logOpts :: Maybe (String, Priority)
logOpts = 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
( forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME"
forall a. Semigroup a => a -> a -> a
<> 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."
]
)
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"host"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"HOSTNAME"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the specified host. (requires -p)"
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"port"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'p'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PORT"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the specified port. (requires -a)"
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"unix"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'u'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Connect to the given unix domain socket."
)
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
switch
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"environment"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Read connection information from $NVIM."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
( (,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-file"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"File to log to."
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option
forall a. Read a => ReadM a
auto
( forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"log-level"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help (String
"Log level. Must be one of: " forall a. [a] -> [a] -> [a]
++ ([String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map 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 =
forall a. Parser a -> InfoMod a -> ParserInfo a
info
(forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser CommandLineOptions
optParser)
( forall a. InfoMod a
fullDesc
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Start a neovim plugin provider for Haskell plugins."
forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
"This is still work in progress. Feel free to contribute."
)
neovim :: NeovimConfig -> IO ()
neovim :: NeovimConfig -> IO ()
neovim = forall a. TransitionHandler a -> NeovimConfig -> IO ()
realMain TransitionHandler ()
standalone
type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a
realMain ::
TransitionHandler a ->
NeovimConfig ->
IO ()
realMain :: forall a. TransitionHandler a -> NeovimConfig -> IO ()
realMain TransitionHandler a
transitionHandler NeovimConfig
cfg = do
CommandLineOptions
os <- forall a. ParserInfo a -> IO a
execParser ParserInfo CommandLineOptions
opts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. IO a -> IO a
disableLogger (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. String -> Priority -> IO a -> IO a
withLogger) (CommandLineOptions -> Maybe (String, Priority)
logOpts CommandLineOptions
os forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NeovimConfig -> Maybe (String, Priority)
logOptions NeovimConfig
cfg) forall a b. (a -> b) -> a -> b
$ do
String -> String -> IO ()
debugM String
logger String
"Starting up neovim haskell plguin provider"
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider CommandLineOptions
os (forall a. a -> Maybe a
Just NeovimConfig
cfg) TransitionHandler a
transitionHandler
runPluginProvider ::
CommandLineOptions ->
Maybe NeovimConfig ->
TransitionHandler a ->
IO a
runPluginProvider :: forall a.
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
_) ->
forall (io :: * -> *).
(Functor io, MonadUnliftIO io) =>
SocketType -> io Handle
createHandle (Int -> String -> SocketType
TCP Int
p String
h) 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) ->
forall (io :: * -> *).
(Functor io, MonadUnliftIO io) =>
SocketType -> io Handle
createHandle (String -> SocketType
UnixSocket String
fp) 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 ->
forall (io :: * -> *).
(Functor io, MonadUnliftIO io) =>
SocketType -> io Handle
createHandle SocketType
Environment 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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NeovimConfig -> [Neovim () NeovimPlugin]
plugins Maybe NeovimConfig
mcfg
Config RPCConfig
conf <- forall env. IO (Maybe String) -> IO env -> IO (Config env)
Internal.newConfig (forall (f :: * -> *) a. Applicative f => a -> f a
pure (CommandLineOptions -> Maybe String
providerName CommandLineOptions
os)) forall (io :: * -> *).
(Applicative io, MonadUnliftIO io) =>
io RPCConfig
newRPCConfig
Async ()
ehTid <-
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$
Handle -> Config RPCConfig -> IO ()
runEventHandler
Handle
evHandlerHandle
Config RPCConfig
conf{pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = forall a. Maybe a
Nothing}
Async ()
srTid <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ Handle -> Config RPCConfig -> IO ()
runSocketReader Handle
sockreaderHandle Config RPCConfig
conf
let startupConf :: Config ()
startupConf = 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 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 forall a b. (a -> b) -> a -> b
$ String
"Error initializing plugins: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e)
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) 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
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
forall a. TMVar a -> a -> STM ()
putTMVar
(forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
conf)
([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [FunctionMapEntry]
funMapEntries)
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) StateTransition
Internal.InitSuccess
TransitionHandler a
transitionHandler (Async ()
srTid forall a. a -> [a] -> [a]
: Async ()
ehTid forall a. a -> [a] -> [a]
: [Async ()]
pluginTids) Config RPCConfig
conf
standalone :: TransitionHandler ()
standalone :: TransitionHandler ()
standalone [Async ()]
threads Config RPCConfig
cfg =
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e
StateTransition
Internal.Quit ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()