Main.hs

{-# LANGUAGE LambdaCase #-}
{- |
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
import qualified Neovim.Context.Internal as Internal
import           Neovim.Log
import           Neovim.Plugin           as P
import           Neovim.Plugin.Startup   (StartupConfig (..))
import           Neovim.RPC.Common       as RPC
import           Neovim.RPC.EventHandler
import           Neovim.RPC.SocketReader
import           Neovim.Util             (oneLineErrorMessage)

import qualified Config.Dyre             as Dyre
import qualified Config.Dyre.Relaunch    as Dyre
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           System.SetEnv

import           Prelude
import           System.Environment


logger :: String
logger = "Neovim.Main"


data CommandLineOptions =
    Opt { providerName :: Maybe String
        , hostPort     :: Maybe (String, Int)
        , unix         :: Maybe FilePath
        , env          :: Bool
        , logOpts      :: Maybe (FilePath, Priority)
        }


instance Default CommandLineOptions where
    def = Opt
            { providerName = Nothing
            , hostPort     = Nothing
            , unix         = Nothing
            , env          = False
            , logOpts      = Nothing
            }


optParser :: Parser CommandLineOptions
optParser = Opt
    <$> optional (strArgument
        (metavar "NAME"
        <> help (unlines
                [ "Name that associates the plugin provider with neovim."
                , "This option has only an effect if you start nvim-hs"
                , "with rpcstart()/jobstart() and use the factory method approach."
                , "Since it is extremely hard to figure that out inside"
                , "nvim-hs, this option is assumed to used if the input"
                , "and output is tied to standard in and standard out."
                ])))
    <*> optional ((,)
            <$> strOption
                (long "host"
                <> short 'a'
                <> metavar "HOSTNAME"
                <> help "Connect to the specified host. (requires -p)")
            <*> option auto
                (long "port"
                <> short 'p'
                <> metavar "PORT"
                <> help "Connect to the specified port. (requires -a)"))
    <*> optional (strOption
        (long "unix"
        <> short 'u'
        <> help "Connect to the given unix domain socket."))
    <*> switch
        ( long "environment"
        <> short 'e'
        <> help "Read connection information from $NVIM_LISTEN_ADDRESS.")
    <*> optional ((,)
        <$> strOption
            (long "log-file"
            <> short 'l'
            <> help "File to log to.")
        <*> option auto
            (long "log-level"
            <> short 'v'
            <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels)))
  where
    -- [minBound..maxBound] would have been nice here.
    logLevels :: [Priority]
    logLevels = [ DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY ]


opts :: ParserInfo CommandLineOptions
opts = info (helper <*> optParser)
    (fullDesc
    <> header "Start a neovim plugin provider for Haskell plugins."
    <> progDesc "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 =
    let params = Dyre.defaultParams
            { Dyre.showError   = \cfg errM -> cfg { errorMessage = Just errM }
            , Dyre.projectName = "nvim"
            , Dyre.realMain    = realMain finishDyre (Just params)
            , Dyre.statusOut   = debugM "Dyre"
            , Dyre.ghcOpts     = ["-threaded", "-rtsopts", "-with-rtsopts=-N"]
            }
    in Dyre.wrapMain params


-- | 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 = [ThreadId] -> 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
         -> Maybe (Dyre.Params NeovimConfig)
         -> NeovimConfig
         -> IO ()
realMain transitionHandler mParams cfg = do
    os <- execParser opts
    maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do
        debugM logger "Starting up neovim haskell plguin provider"
        void $ runPluginProvider os (Just cfg) transitionHandler mParams


-- | Generic main function. Most arguments are optional or have sane defaults.
runPluginProvider
    :: CommandLineOptions -- ^ See /nvim-hs/ executables --help function or 'optParser'
    -> Maybe NeovimConfig
    -> TransitionHandler a
    -> Maybe (Dyre.Params NeovimConfig)
    -> IO a
runPluginProvider os mcfg transitionHandler mDyreParams = case (hostPort os, unix os) of
    (Just (h,p), _) ->
        createHandle (TCP p h) >>= \s -> run s s

    (_, Just fp) ->
        createHandle (UnixSocket fp) >>= \s -> run s s

    _ | env os ->
        createHandle Environment >>= \s -> run s s

    _ ->
        run stdout stdin

  where
    run evHandlerHandle sockreaderHandle = do

        -- The plugins to register depend on the given arguments and may need
        -- special initialization methods.
        let allPlugins = maybe [] plugins mcfg

        conf <- Internal.newConfig (pure (providerName os)) newRPCConfig

        ehTid <- forkIO $ runEventHandler
                            evHandlerHandle
                            conf { Internal.pluginSettings = Nothing }

        srTid <- forkIO $ runSocketReader sockreaderHandle conf

        ghcEnv <- forM ["GHC_PACKAGE_PATH","CABAL_SANDBOX_CONFIG"] $ \var -> do
            val <- lookupEnv var
            unsetEnv var
            return (var, val)
        let startupConf = Internal.retypeConfig
                            (StartupConfig mDyreParams ghcEnv)
                            ()
                            conf
        startPluginThreads startupConf allPlugins >>= \case
            Left e -> do
                errorM logger $ "Error initializing plugins: " <> oneLineErrorMessage e
                putMVar (Internal.transitionTo conf) $ Internal.Failure e
                transitionHandler [ehTid, srTid] conf

            Right (funMapEntries, pluginTids) -> do
                atomically $ putTMVar
                                (Internal.globalFunctionMap conf)
                                (Internal.mkFunctionMap funMapEntries)
                putMVar (Internal.transitionTo conf) $ Internal.InitSuccess
                transitionHandler (srTid:ehTid:pluginTids) conf


-- | If the plugin provider is started with dyre, this handler is used to
-- handle a restart.
finishDyre :: TransitionHandler ()
finishDyre threads cfg = takeMVar (Internal.transitionTo cfg) >>= \case
    Internal.InitSuccess -> do
        debugM logger "Waiting for threads to finish."
        finishDyre threads cfg

    Internal.Restart -> do
        debugM logger "Trying to restart nvim-hs"
        mapM_ killThread threads
        Dyre.relaunchMaster Nothing

    Internal.Failure e ->
        errorM logger $ oneLineErrorMessage e

    Internal.Quit ->
        return ()