{-# LANGUAGE NamedFieldPuns    #-}
{- |
Module      :  Neovim.Debug
Description :  Utilities to debug Neovim and nvim-hs functionality
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC

-}
module Neovim.Debug (
    debug,
    debug',

    NvimHSDebugInstance(..),
    develMain,
    quitDevelMain,
    restartDevelMain,

    printGlobalFunctionMap,

    runNeovim,
    runNeovim',
    module Neovim,
    ) where

import           Neovim
import           Neovim.Classes
import           Neovim.Context                            (runNeovim)
import qualified Neovim.Context.Internal                   as Internal
import           Neovim.Log                                (disableLogger)
import           Neovim.Main                               (CommandLineOptions (..),
                                                            runPluginProvider)
import           Neovim.RPC.Common                         (RPCConfig)

import           Control.Monad
import qualified Data.Map                                  as Map
import           Foreign.Store

import           UnliftIO.Async                            (Async, async,
                                                            cancel)
import           UnliftIO.Concurrent                       (putMVar, takeMVar)
import           UnliftIO.STM

import           Data.Text.Prettyprint.Doc                 (nest, softline,
                                                            vcat, vsep)

import           Prelude


-- | Run a 'Neovim' function.
--
-- This function connects to the socket pointed to by the environment variable
-- @$NVIM@ and executes the command. It does not register itself
-- as a real plugin provider, you can simply call neovim-functions from the
-- module "Neovim.API.String" this way.
--
-- Tip: If you run a terminal inside a neovim instance, then this variable is
-- automatically set.
debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug :: forall env a. env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug env
env Neovim env a
a = forall a. IO a -> IO a
disableLogger forall a b. (a -> b) -> a -> b
$ do
    forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider forall a. Default a => a
def { envVar :: Bool
envVar = Bool
True } forall a. Maybe a
Nothing forall {t :: * -> *} {a} {env}.
Foldable t =>
t (Async a) -> Config env -> IO (Either (Doc AnsiStyle) a)
transitionHandler
  where
    transitionHandler :: t (Async a) -> Config env -> IO (Either (Doc AnsiStyle) a)
transitionHandler t (Async a)
tids Config env
cfg = forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config env
cfg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Internal.Failure Doc AnsiStyle
e ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Doc AnsiStyle
e

        StateTransition
Internal.InitSuccess -> do
            Either (Doc AnsiStyle) a
res <- forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
Internal.runNeovimInternal
                forall (m :: * -> *) a. Monad m => a -> m a
return
                (Config env
cfg { customConfig :: env
Internal.customConfig = env
env, pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings = forall a. Maybe a
Nothing })
                Neovim env a
a

            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel t (Async a)
tids
            forall (m :: * -> *) a. Monad m => a -> m a
return Either (Doc AnsiStyle) a
res

        StateTransition
_ ->
            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Unexpected transition state."


-- | Run a 'Neovim'' function.
--
-- @
-- debug' = debug ()
-- @
--
-- See documentation for 'debug'.
debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a)
debug' :: forall a. Neovim () a -> IO (Either (Doc AnsiStyle) a)
debug' = forall env a. env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug ()

-- | Simple datatype storing neccessary information to start, stop and reload a
-- set of plugins. This is passed to most of the functions in this module for
-- storing state even when the ghci-session has been reloaded.
data NvimHSDebugInstance = NvimHSDebugInstance
  { NvimHSDebugInstance -> [Async ()]
threads        :: [Async ()]
  , NvimHSDebugInstance -> NeovimConfig
neovimConfig   :: NeovimConfig
  , NvimHSDebugInstance -> Config RPCConfig
internalConfig :: Internal.Config RPCConfig
  }

-- | This function is intended to be run _once_ in a ghci session that to
-- give a REPL based workflow when developing a plugin.
--
-- Note that the dyre-based reload mechanisms, i.e. the
-- "Neovim.Plugin.ConfigHelper" plugin, is not started this way.
--
-- To use this in ghci, you simply bind the results to some variables. After
-- each reload of ghci, you have to rebind those variables.
--
-- Example:
--
-- @
-- λ di <- 'develMain' 'Nothing'
--
-- λ 'runNeovim'' di \$ vim_call_function \"getqflist\" []
-- 'Right' ('Right' ('ObjectArray' []))
--
-- λ :r
--
-- λ di <- 'develMain' 'Nothing'
-- @
--
-- You can also create a GHCI alias to get rid of most the busy-work:
-- @
-- :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\"
-- @
--
develMain
    :: NeovimConfig
    -> IO (Maybe NvimHSDebugInstance)
develMain :: NeovimConfig -> IO (Maybe NvimHSDebugInstance)
develMain NeovimConfig
neovimConfig = forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (Store (Maybe NvimHSDebugInstance))
Nothing -> do
        Maybe NvimHSDebugInstance
x <- forall a. IO a -> IO a
disableLogger forall a b. (a -> b) -> a -> b
$ forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider
              forall a. Default a => a
def{ envVar :: Bool
envVar = Bool
True }
              (forall a. a -> Maybe a
Just NeovimConfig
neovimConfig)
              [Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (Store a)
newStore Maybe NvimHSDebugInstance
x
        forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NvimHSDebugInstance
x

    Just Store (Maybe NvimHSDebugInstance)
x ->
        forall a. Store a -> IO a
readStore Store (Maybe NvimHSDebugInstance)
x
  where
    transitionHandler :: [Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler [Async ()]
tids 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
        Internal.Failure Doc AnsiStyle
e -> do
            Doc AnsiStyle -> IO ()
putDoc Doc AnsiStyle
e
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

        StateTransition
Internal.InitSuccess -> do
            Async ()
transitionHandlerThread <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ do
                forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler ([Async ()]
tids) Config RPCConfig
cfg
            forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ NvimHSDebugInstance
              { threads :: [Async ()]
threads = (Async ()
transitionHandlerThreadforall a. a -> [a] -> [a]
:[Async ()]
tids)
              , neovimConfig :: NeovimConfig
neovimConfig = NeovimConfig
neovimConfig
              , internalConfig :: Config RPCConfig
internalConfig = Config RPCConfig
cfg
              }

        StateTransition
Internal.Quit -> do
            forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (Store Any)
Nothing ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return ()

                Just Store Any
x ->
                    forall a. Store a -> IO ()
deleteStore Store Any
x

            forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel [Async ()]
tids
            String -> IO ()
putStrLn String
"Quit develMain"
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

        StateTransition
_ -> do
            String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unexpected transition state for develMain."
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing


-- | Quit a previously started plugin provider.
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} =
  forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
internalConfig) StateTransition
Internal.Quit


-- | Restart the development plugin provider.
restartDevelMain
    :: NvimHSDebugInstance
    -> IO (Maybe NvimHSDebugInstance)
restartDevelMain :: NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
restartDevelMain NvimHSDebugInstance
di = do
    NvimHSDebugInstance -> IO ()
quitDevelMain NvimHSDebugInstance
di
    NeovimConfig -> IO (Maybe NvimHSDebugInstance)
develMain (NvimHSDebugInstance -> NeovimConfig
neovimConfig NvimHSDebugInstance
di)


-- | Convenience function to run a stateless 'Neovim' function.
runNeovim' :: NFData a
           => NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
runNeovim' :: forall a.
NFData a =>
NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
runNeovim' NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} =
    forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim (forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () (Config RPCConfig
internalConfig))


-- | Print the global function map to the console.
printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
printGlobalFunctionMap NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} = do
    [(NvimMethod, FunctionMapEntry)]
es <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
            forall a. TMVar a -> STM a
readTMVar (forall env. Config env -> TMVar (Map NvimMethod FunctionMapEntry)
Internal.globalFunctionMap Config RPCConfig
internalConfig)
    let header :: Doc AnsiStyle
header = Doc AnsiStyle
"Printing global function map:"
        funs :: [Doc ann]
funs   = forall a b. (a -> b) -> [a] -> [b]
map (\(NvimMethod
fname, (FunctionalityDescription
d, FunctionType
f)) ->
                    forall ann. Int -> Doc ann -> Doc ann
nest Int
3 (forall a ann. Pretty a => a -> Doc ann
pretty NvimMethod
fname
                    forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline forall a. Semigroup a => a -> a -> a
<> Doc ann
"->"
                    forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty FunctionalityDescription
d forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":"
                    forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionType
f)) [(NvimMethod, FunctionMapEntry)]
es
    Doc AnsiStyle -> IO ()
putDoc forall a b. (a -> b) -> a -> b
$
        forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$ forall ann. [Doc ann] -> Doc ann
vsep [Doc AnsiStyle
header, forall ann. [Doc ann] -> Doc ann
vcat forall {ann}. [Doc ann]
funs, forall a. Monoid a => a
mempty]