{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
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
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 = forall a. IO a -> IO a
disableLogger forall a b. (a -> b) -> a -> b
$ do
forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider forall a. Default a => a
def{envVar :: Bool
envVar = Bool
True} forall a. Maybe a
Nothing 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 =
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config env
cfg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Internal.Failure Doc AnsiStyle
e ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Doc AnsiStyle
e
StateTransition
Internal.InitSuccess -> do
Either (Doc AnsiStyle) a
res <-
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
Internal.runNeovimInternal
forall (m :: * -> *) a. Monad m => a -> m a
return
(Config env
cfg{customConfig :: env
Internal.customConfig = env
env, pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings = forall a. Maybe a
Nothing})
Neovim env a
a
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel t (Async a)
tids
forall (m :: * -> *) a. Monad m => a -> m a
return Either (Doc AnsiStyle) a
res
StateTransition
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Unexpected transition state."
debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a)
debug' :: forall a. Neovim () a -> IO (Either (Doc AnsiStyle) a)
debug' = forall env a. env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
debug ()
data NvimHSDebugInstance = NvimHSDebugInstance
{ NvimHSDebugInstance -> [Async ()]
threads :: [Async ()]
, NvimHSDebugInstance -> NeovimConfig
neovimConfig :: NeovimConfig
, NvimHSDebugInstance -> Config RPCConfig
internalConfig :: Internal.Config RPCConfig
}
develMain ::
NeovimConfig ->
IO (Maybe NvimHSDebugInstance)
develMain :: NeovimConfig -> IO (Maybe NvimHSDebugInstance)
develMain NeovimConfig
neovimConfig =
forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Store (Maybe NvimHSDebugInstance))
Nothing -> do
Maybe NvimHSDebugInstance
x <-
forall a. IO a -> IO a
disableLogger forall a b. (a -> b) -> a -> b
$
forall a.
CommandLineOptions
-> Maybe NeovimConfig -> TransitionHandler a -> IO a
runPluginProvider
forall a. Default a => a
def{envVar :: Bool
envVar = Bool
True}
(forall a. a -> Maybe a
Just NeovimConfig
neovimConfig)
[Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (Store a)
newStore Maybe NvimHSDebugInstance
x
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe NvimHSDebugInstance
x
Just Store (Maybe NvimHSDebugInstance)
x ->
forall a. Store a -> IO a
readStore Store (Maybe NvimHSDebugInstance)
x
where
transitionHandler :: [Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler [Async ()]
tids Config RPCConfig
cfg =
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
StateTransition
Internal.InitSuccess -> do
Async ()
transitionHandlerThread <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ [Async ()] -> Config RPCConfig -> IO (Maybe NvimHSDebugInstance)
transitionHandler [Async ()]
tids Config RPCConfig
cfg
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
NvimHSDebugInstance
{ threads :: [Async ()]
threads = Async ()
transitionHandlerThread forall a. a -> [a] -> [a]
: [Async ()]
tids
, neovimConfig :: NeovimConfig
neovimConfig = NeovimConfig
neovimConfig
, internalConfig :: Config RPCConfig
internalConfig = Config RPCConfig
cfg
}
StateTransition
Internal.Quit -> do
forall a. Word32 -> IO (Maybe (Store a))
lookupStore Word32
0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (Store Any)
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Store Any
x ->
forall a. Store a -> IO ()
deleteStore Store Any
x
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel [Async ()]
tids
String -> IO ()
putStrLn String
"Quit develMain"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
StateTransition
_ -> do
String -> IO ()
putStrLn String
"Unexpected transition state for develMain."
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain :: NvimHSDebugInstance -> IO ()
quitDevelMain NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} =
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
internalConfig) StateTransition
Internal.Quit
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)
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 :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} =
forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim (forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () Config RPCConfig
internalConfig)
printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
printGlobalFunctionMap NvimHSDebugInstance{Config RPCConfig
internalConfig :: Config RPCConfig
internalConfig :: NvimHSDebugInstance -> Config RPCConfig
internalConfig} = do
[(NvimMethod, FunctionMapEntry)]
es <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k a. Map k a -> [(k, a)]
Map.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
forall a. TMVar a -> STM a
readTMVar (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 =
forall a b. (a -> b) -> [a] -> [b]
map
( \(NvimMethod
fname, (FunctionalityDescription
d, FunctionType
f)) ->
forall ann. Int -> Doc ann -> Doc ann
nest
Int
3
( forall a ann. Pretty a => a -> Doc ann
pretty NvimMethod
fname
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"->"
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
softline
forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty FunctionalityDescription
d
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
":"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionType
f
)
)
[(NvimMethod, FunctionMapEntry)]
es
Doc AnsiStyle -> IO ()
putDoc forall a b. (a -> b) -> a -> b
$
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
forall ann. [Doc ann] -> Doc ann
vsep [Doc AnsiStyle
header, forall ann. [Doc ann] -> Doc ann
vcat forall {ann}. [Doc ann]
funs, forall a. Monoid a => a
mempty]