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
{ 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 a. MVar a -> a -> IO ()
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 a. STM a -> IO 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 a. MVar a -> a -> IO ()
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 a. MVar a -> IO 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 ()