{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Main
Description :  Wrapper for the actual main function
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
-}
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
    -- [minBound..maxBound] would have been nice here.
    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."
        )

{- | This is essentially the main function for /nvim-hs/, at least if you want
 to use "Config.Dyre" for the configuration.
-}
neovim :: NeovimConfig -> IO ()
neovim :: NeovimConfig -> IO ()
neovim = forall a. TransitionHandler a -> NeovimConfig -> IO ()
realMain TransitionHandler ()
standalone

{- | A 'TransitionHandler' function receives the 'ThreadId's of all running
 threads which have been started by the plugin provider as well as the
 'Internal.Config' with the custom field set to 'RPCConfig'. These information
 can be used to properly clean up a session and then do something else.
 The transition handler is first called after the plugin provider has started.
-}
type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a

{- | This main functions can be used to create a custom executable without
 using the "Config.Dyre" library while still using the /nvim-hs/ specific
 configuration facilities.
-}
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

-- | Generic main function. Most arguments are optional or have sane defaults.
runPluginProvider ::
    -- | See /nvim-hs/ executables --help function or 'optParser'
    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
        -- The plugins to register depend on the given arguments and may need
        -- special initialization methods.
        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 ()