{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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.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 Data.Text.Prettyprint.Doc.Render.Terminal (putDoc)
import Prelude
debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug env a = disableLogger $ do
runPluginProvider def { envVar = 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 = 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' a = debug () a
develMain
:: Maybe NeovimConfig
-> IO (Either (Doc AnsiStyle) [Async ()])
develMain mcfg = lookupStore 0 >>= \case
Nothing -> do
x <- disableLogger $
runPluginProvider def { envVar = 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 <- async $ do
void $ transitionHandler (tids) cfg
return $ Right (transitionHandlerThread:tids)
Internal.Quit -> do
lookupStore 0 >>= \case
Nothing ->
return ()
Just x ->
deleteStore x
mapM_ cancel tids
return . Left $ "Quit develMain"
_ ->
return . Left $ "Unexpected transition state for develMain."
quitDevelMain :: Internal.Config env -> IO ()
quitDevelMain cfg = putMVar (Internal.transitionTo cfg) Internal.Quit
restartDevelMain
:: Internal.Config RPCConfig
-> Maybe NeovimConfig
-> IO (Either (Doc AnsiStyle) [Async ()])
restartDevelMain cfg mcfg = do
quitDevelMain cfg
develMain mcfg
runNeovim' :: NFData a
=> Internal.Config env -> Neovim () a -> IO (Either (Doc AnsiStyle) a)
runNeovim' cfg =
runNeovim (Internal.retypeConfig () cfg)
printGlobalFunctionMap :: Internal.Config env -> IO ()
printGlobalFunctionMap cfg = do
es <- fmap Map.toList . atomically $ readTMVar (Internal.globalFunctionMap cfg)
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]