{-# LANGUAGE NamedFieldPuns #-}
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
debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug env a = disableLogger $ do
runPluginProvider def { envVar = True } Nothing transitionHandler
where
transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case
Internal.Failure e ->
return $ Left e
Internal.InitSuccess -> do
res <- Internal.runNeovimInternal
return
(cfg { Internal.customConfig = env, Internal.pluginSettings = Nothing })
a
mapM_ cancel tids
return res
_ ->
return . Left $ "Unexpected transition state."
debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a)
debug' = debug ()
data NvimHSDebugInstance = NvimHSDebugInstance
{ threads :: [Async ()]
, neovimConfig :: NeovimConfig
, internalConfig :: Internal.Config RPCConfig
}
develMain
:: NeovimConfig
-> IO (Maybe NvimHSDebugInstance)
develMain neovimConfig = lookupStore 0 >>= \case
Nothing -> do
x <- disableLogger $ runPluginProvider
def{ envVar = True }
(Just neovimConfig)
transitionHandler
void $ newStore x
return x
Just x ->
readStore x
where
transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case
Internal.Failure e -> do
putDoc e
return Nothing
Internal.InitSuccess -> do
transitionHandlerThread <- async $ do
void $ transitionHandler (tids) cfg
return . Just $ NvimHSDebugInstance
{ threads = (transitionHandlerThread:tids)
, neovimConfig = neovimConfig
, internalConfig = cfg
}
Internal.Quit -> do
lookupStore 0 >>= \case
Nothing ->
return ()
Just x ->
deleteStore x
mapM_ cancel tids
putStrLn "Quit develMain"
return Nothing
_ -> do
putStrLn $ "Unexpected transition state for develMain."
return Nothing
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain NvimHSDebugInstance{internalConfig} =
putMVar (Internal.transitionTo internalConfig) Internal.Quit
restartDevelMain
:: NvimHSDebugInstance
-> IO (Maybe NvimHSDebugInstance)
restartDevelMain di = do
quitDevelMain di
develMain (neovimConfig di)
runNeovim' :: NFData a
=> NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
runNeovim' NvimHSDebugInstance{internalConfig} =
runNeovim (Internal.retypeConfig () (internalConfig))
printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
printGlobalFunctionMap NvimHSDebugInstance{internalConfig} = do
es <- fmap Map.toList . atomically $
readTMVar (Internal.globalFunctionMap internalConfig)
let header = "Printing global function map:"
funs = map (\(fname, (d, f)) ->
nest 3 (pretty fname
<> softline <> "->"
<> softline <> pretty d <+> ":"
<+> pretty f)) es
putDoc $
nest 2 $ vsep [header, vcat funs, mempty]