{-# 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 = IO (Either (Doc AnsiStyle) a) -> IO (Either (Doc AnsiStyle) a)
forall a. IO a -> IO a
disableLogger (IO (Either (Doc AnsiStyle) a) -> IO (Either (Doc AnsiStyle) a))
-> IO (Either (Doc AnsiStyle) a) -> IO (Either (Doc AnsiStyle) a)
forall a b. (a -> b) -> a -> b
$ do
    CommandLineOptions
-> Maybe NeovimConfig
-> TransitionHandler (Either (Doc AnsiStyle) a)
-> IO (Either (Doc AnsiStyle) a)
forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider CommandLineOptions
forall a. Default a => a
def{envVar = True} Maybe NeovimConfig
forall a. Maybe a
Nothing TransitionHandler (Either (Doc AnsiStyle) a)
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 =
        MVar StateTransition -> IO StateTransition
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (Config env -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config env
cfg) IO StateTransition
-> (StateTransition -> IO (Either (Doc AnsiStyle) a))
-> IO (Either (Doc AnsiStyle) a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Internal.Failure Doc AnsiStyle
e ->
                Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a))
-> Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall a b. a -> Either a b
Left Doc AnsiStyle
e
            StateTransition
Internal.InitSuccess -> do
                Either (Doc AnsiStyle) a
res <-
                    (a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
Internal.runNeovimInternal
                        a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
                        (Config env
cfg{Internal.customConfig = env, Internal.pluginSettings = Nothing})
                        Neovim env a
a

                (Async a -> IO ()) -> t (Async a) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async a -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel t (Async a)
tids
                Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Doc AnsiStyle) a
res
            StateTransition
_ ->
                Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a))
-> (Doc AnsiStyle -> Either (Doc AnsiStyle) a)
-> Doc AnsiStyle
-> IO (Either (Doc AnsiStyle) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall a b. a -> Either a b
Left (Doc AnsiStyle -> IO (Either (Doc AnsiStyle) a))
-> Doc AnsiStyle -> IO (Either (Doc AnsiStyle) a)
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' = () -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
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 =
    Word32 -> IO (Maybe (Store (Maybe NvimHSDebugInstance)))
forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 IO (Maybe (Store (Maybe NvimHSDebugInstance)))
-> (Maybe (Store (Maybe NvimHSDebugInstance))
    -> IO (Maybe NvimHSDebugInstance))
-> IO (Maybe NvimHSDebugInstance)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe (Store (Maybe NvimHSDebugInstance))
Nothing -> do
            Maybe NvimHSDebugInstance
x <-
                IO (Maybe NvimHSDebugInstance) -> IO (Maybe NvimHSDebugInstance)
forall a. IO a -> IO a
disableLogger (IO (Maybe NvimHSDebugInstance) -> IO (Maybe NvimHSDebugInstance))
-> IO (Maybe NvimHSDebugInstance) -> IO (Maybe NvimHSDebugInstance)
forall a b. (a -> b) -> a -> b
$
                    CommandLineOptions
-> Maybe NeovimConfig
-> TransitionHandler (Maybe NvimHSDebugInstance)
-> IO (Maybe NvimHSDebugInstance)
forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider
                        CommandLineOptions
forall a. Default a => a
def{envVar = True}
                        (NeovimConfig -> Maybe NeovimConfig
forall a. a -> Maybe a
Just NeovimConfig
neovimConfig)
                        TransitionHandler (Maybe NvimHSDebugInstance)
transitionHandler
            IO (Store (Maybe NvimHSDebugInstance)) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Store (Maybe NvimHSDebugInstance)) -> IO ())
-> IO (Store (Maybe NvimHSDebugInstance)) -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe NvimHSDebugInstance -> IO (Store (Maybe NvimHSDebugInstance))
forall a. a -> IO (Store a)
newStore Maybe NvimHSDebugInstance
x
            Maybe NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NvimHSDebugInstance
x
        Just Store (Maybe NvimHSDebugInstance)
x ->
            Store (Maybe NvimHSDebugInstance) -> IO (Maybe NvimHSDebugInstance)
forall a. Store a -> IO a
readStore Store (Maybe NvimHSDebugInstance)
x
  where
    transitionHandler :: TransitionHandler (Maybe NvimHSDebugInstance)
transitionHandler [Async ()]
tids Config RPCConfig
cfg =
        MVar StateTransition -> IO StateTransition
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) IO StateTransition
-> (StateTransition -> IO (Maybe NvimHSDebugInstance))
-> IO (Maybe NvimHSDebugInstance)
forall a b. IO a -> (a -> IO b) -> IO b
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
                Maybe NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NvimHSDebugInstance
forall a. Maybe a
Nothing
            StateTransition
Internal.InitSuccess -> do
                Async ()
transitionHandlerThread <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
                    IO (Maybe NvimHSDebugInstance) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe NvimHSDebugInstance) -> IO ())
-> IO (Maybe NvimHSDebugInstance) -> IO ()
forall a b. (a -> b) -> a -> b
$ TransitionHandler (Maybe NvimHSDebugInstance)
transitionHandler [Async ()]
tids Config RPCConfig
cfg
                Maybe NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance))
-> (NvimHSDebugInstance -> Maybe NvimHSDebugInstance)
-> NvimHSDebugInstance
-> IO (Maybe NvimHSDebugInstance)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NvimHSDebugInstance -> Maybe NvimHSDebugInstance
forall a. a -> Maybe a
Just (NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance))
-> NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
forall a b. (a -> b) -> a -> b
$
                    NvimHSDebugInstance
                        { threads :: [Async ()]
threads = Async ()
transitionHandlerThread Async () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
: [Async ()]
tids
                        , neovimConfig :: NeovimConfig
neovimConfig = NeovimConfig
neovimConfig
                        , internalConfig :: Config RPCConfig
internalConfig = Config RPCConfig
cfg
                        }
            StateTransition
Internal.Quit -> do
                Word32 -> IO (Maybe (Store Any))
forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 IO (Maybe (Store Any)) -> (Maybe (Store Any) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                    Maybe (Store Any)
Nothing ->
                        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just Store Any
x ->
                        Store Any -> IO ()
forall a. Store a -> IO ()
deleteStore Store Any
x

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

-- | Quit a previously started plugin provider.
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain NvimHSDebugInstance{Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig} =
    MVar StateTransition -> StateTransition -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (Config RPCConfig -> MVar StateTransition
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 :: NvimHSDebugInstance -> Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig} =
    Config () -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim (() -> Config RPCConfig -> Config ()
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 :: NvimHSDebugInstance -> Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig} = do
    [(NvimMethod, FunctionMapEntry)]
es <-
        (Map NvimMethod FunctionMapEntry
 -> [(NvimMethod, FunctionMapEntry)])
-> IO (Map NvimMethod FunctionMapEntry)
-> IO [(NvimMethod, FunctionMapEntry)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map NvimMethod FunctionMapEntry -> [(NvimMethod, FunctionMapEntry)]
forall k a. Map k a -> [(k, a)]
Map.toList (IO (Map NvimMethod FunctionMapEntry)
 -> IO [(NvimMethod, FunctionMapEntry)])
-> (STM (Map NvimMethod FunctionMapEntry)
    -> IO (Map NvimMethod FunctionMapEntry))
-> STM (Map NvimMethod FunctionMapEntry)
-> IO [(NvimMethod, FunctionMapEntry)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Map NvimMethod FunctionMapEntry)
-> IO (Map NvimMethod FunctionMapEntry)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Map NvimMethod FunctionMapEntry)
 -> IO [(NvimMethod, FunctionMapEntry)])
-> STM (Map NvimMethod FunctionMapEntry)
-> IO [(NvimMethod, FunctionMapEntry)]
forall a b. (a -> b) -> a -> b
$
            TMVar (Map NvimMethod FunctionMapEntry)
-> STM (Map NvimMethod FunctionMapEntry)
forall a. TMVar a -> STM a
readTMVar (Config RPCConfig -> TMVar (Map NvimMethod FunctionMapEntry)
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 =
            ((NvimMethod, FunctionMapEntry) -> Doc ann)
-> [(NvimMethod, FunctionMapEntry)] -> [Doc ann]
forall a b. (a -> b) -> [a] -> [b]
map
                ( \(NvimMethod
fname, (FunctionalityDescription
d, FunctionType
f)) ->
                    Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest
                        Int
3
                        ( NvimMethod -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. NvimMethod -> Doc ann
pretty NvimMethod
fname
                            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softline
                            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"->"
                            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
softline
                            Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FunctionalityDescription -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FunctionalityDescription -> Doc ann
pretty FunctionalityDescription
d
                            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":"
                            Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionType -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. FunctionType -> Doc ann
pretty FunctionType
f
                        )
                )
                [(NvimMethod, FunctionMapEntry)]
es
    Doc AnsiStyle -> IO ()
putDoc (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
forall a b. (a -> b) -> a -> b
$
        Int -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> Doc AnsiStyle
forall a b. (a -> b) -> a -> b
$
            [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vsep [Doc AnsiStyle
header, [Doc AnsiStyle] -> Doc AnsiStyle
forall ann. [Doc ann] -> Doc ann
vcat [Doc AnsiStyle]
forall {ann}. [Doc ann]
funs, Doc AnsiStyle
forall a. Monoid a => a
mempty]