{-# 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_LISTEN_ADDRESS@ 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 :: 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 :: Bool
envVar = Bool
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return
                (Config env
cfg { customConfig :: env
Internal.customConfig = env
env, pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings = Maybe (PluginSettings env)
forall a. Maybe a
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 (m :: * -> *) a. Monad m => a -> m a
return Either (Doc AnsiStyle) a
res

        StateTransition
_ ->
            Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) 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' :: 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 (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 :: Bool
envVar = Bool
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 (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 (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 (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 (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 :: [Async ()]
-> NeovimConfig -> Config RPCConfig -> NvimHSDebugInstance
NvimHSDebugInstance
              { threads :: [Async ()]
threads = (Async ()
transitionHandlerThreadAsync () -> [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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Maybe (Store Any)
Nothing ->
                    () -> IO ()
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe NvimHSDebugInstance
forall a. Maybe a
Nothing

        StateTransition
_ -> do
            String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected transition state for develMain."
            Maybe NvimHSDebugInstance -> IO (Maybe NvimHSDebugInstance)
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 :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> 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' :: NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
runNeovim' NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> 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 :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} = do
    [(NvimMethod, FunctionMapEntry)]
es <- (Map NvimMethod FunctionMapEntry
 -> [(NvimMethod, FunctionMapEntry)])
-> IO (Map NvimMethod FunctionMapEntry)
-> IO [(NvimMethod, FunctionMapEntry)]
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
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
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
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]