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

{- |
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 Prettyprinter (
    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 ()
transitionHandlerThread forall 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 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]