module Neovim.Debug (
debug,
debug',
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.Concurrent
import Control.Concurrent.STM
import Control.Monad
import qualified Data.Map as Map
import Foreign.Store
import System.IO (stdout)
import Text.PrettyPrint.ANSI.Leijen hiding ((<$>))
import qualified Text.PrettyPrint.ANSI.Leijen as Pretty
import Prelude
debug :: r -> st -> Internal.Neovim r st a -> IO (Either Doc (a, st))
debug r st a = disableLogger $ do
runPluginProvider def { env = True } Nothing transitionHandler Nothing
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 = r, Internal.pluginSettings = Nothing })
st
a
mapM_ killThread tids
return res
_ ->
return . Left $ text "Unexpected transition state."
debug' :: Internal.Neovim' a -> IO (Either Doc a)
debug' a = fmap fst <$> debug () () a
develMain
:: Maybe NeovimConfig
-> IO (Either Doc ([ThreadId], Internal.Config RPCConfig ()))
develMain mcfg = lookupStore 0 >>= \case
Nothing -> do
x <- disableLogger $
runPluginProvider def { env = True } mcfg transitionHandler Nothing
void $ newStore x
return x
Just x ->
readStore x
where
transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case
Internal.Failure e ->
return $ Left e
Internal.InitSuccess -> do
transitionHandlerThread <- forkIO $ do
myTid <- myThreadId
void $ transitionHandler (myTid:tids) cfg
return $ Right (transitionHandlerThread:tids, cfg)
Internal.Quit -> do
lookupStore 0 >>= \case
Nothing ->
return ()
Just x ->
deleteStore x
mapM_ killThread tids
return . Left $ text "Quit develMain"
_ ->
return . Left $ text "Unexpected transition state for develMain."
quitDevelMain :: Internal.Config r st -> IO ()
quitDevelMain cfg = putMVar (Internal.transitionTo cfg) Internal.Quit
restartDevelMain
:: Internal.Config RPCConfig ()
-> Maybe NeovimConfig
-> IO (Either Doc ([ThreadId], Internal.Config RPCConfig ()))
restartDevelMain cfg mcfg = do
quitDevelMain cfg
develMain mcfg
runNeovim' :: NFData a
=> Internal.Config r st -> Neovim' a -> IO (Either Doc a)
runNeovim' cfg =
fmap (fmap fst) . runNeovim (Internal.retypeConfig () () cfg) ()
printGlobalFunctionMap :: Internal.Config r st -> IO ()
printGlobalFunctionMap cfg = do
es <- fmap Map.toList . atomically $ readTMVar (Internal.globalFunctionMap cfg)
let header = text "Printing global function map:"
funs = map (\(fname, (d, f)) ->
nest 3 (pretty fname
</> text "->"
</> pretty d <+> text ":"
<+> pretty f)) es
displayIO stdout . renderPretty 0.4 80 $
nest 2 (header <$$> vcat funs)
<$$> Pretty.empty