nvim-hs 2.3.1.0 → 2.3.2.0
raw patch · 24 files changed
+553/−405 lines, 24 files
Files
- library/Neovim.hs +7/−15
- library/Neovim/API/Parser.hs +27/−16
- library/Neovim/API/TH.hs +15/−14
- library/Neovim/Classes.hs +0/−1
- library/Neovim/Context.hs +35/−48
- library/Neovim/Context/Internal.hs +21/−17
- library/Neovim/Debug.hs +4/−4
- library/Neovim/Main.hs +4/−4
- library/Neovim/Plugin.hs +33/−31
- library/Neovim/Plugin/Classes.hs +38/−47
- library/Neovim/Plugin/IPC/Classes.hs +44/−21
- library/Neovim/Plugin/Internal.hs +6/−3
- library/Neovim/Quickfix.hs +6/−8
- library/Neovim/RPC/Common.hs +78/−75
- library/Neovim/RPC/EventHandler.hs +2/−4
- library/Neovim/RPC/SocketReader.hs +27/−23
- library/Neovim/Test.hs +132/−56
- nvim-hs.cabal +7/−1
- srcos/unix/Neovim/OS.hs +10/−0
- srcos/windows/Neovim/OS.hs +11/−0
- test-suite/AsyncFunctionSpec.hs +34/−0
- test-suite/Neovim/EmbeddedRPCSpec.hs +9/−12
- test-suite/Neovim/EventSubscriptionSpec.hs +2/−3
- test-suite/Neovim/Plugin/ClassesSpec.hs +1/−2
library/Neovim.hs view
@@ -128,17 +128,16 @@ import Neovim.Util (unlessM, whenM) import System.Log.Logger (Priority (..)) import Prettyprinter.Render.Terminal (putDoc)--- Installation {{{1+-- Installation {- $installation Installation instructions are in the README.md file that comes with the source of this package. It is also on the repositories front page. -}--- 1}}} --- Tutorial {{{1--- Overview {{{2+-- Tutorial+-- Overview {- $overview An @nvim-hs@ plugin is just a collection of haskell functions that can be called from neovim.@@ -157,8 +156,7 @@ -} --- 2}}}--- Combining Existing Plugins {{{2+-- Combining Existing Plugins {- $existingplugins The easiest way to start is to use the stack template as described in the @README.md@ of this package. If you initialize it in your neovim configuration@@ -204,8 +202,7 @@ } --- 2}}}--- Creating a plugin {{{2+-- Creating a plugin {- $creatingplugins Creating plugins isn't difficult either. You just have to follow and survive the compile time errors of seemingly valid code. This may sound scary, but it is not@@ -327,8 +324,7 @@ Afterwards, there is a plugin with state which uses the environment. -}--- 2}}}--- Creating a stateful plugin {{{2+-- Creating a stateful plugin {- $statefulplugin Now that we are a little bit comfortable with the interface provided by /nvim-hs/, we can start to write a more complicated plugin. Let's create a random number@@ -445,8 +441,7 @@ @ -}--- 2}}}--- Calling remote functions {{{2+-- Calling remote functions {- $remote Calling remote functions is only possible inside a 'Neovim' context. There are a few patterns of return values for the available functions. Let's start with@@ -478,7 +473,4 @@ That's pretty much all there is to it. -}--- 2}}}--- 1}}} --- vim: foldmethod=marker
library/Neovim/API/Parser.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {- | Module : Neovim.API.Parser Description : P.Parser for the msgpack output stram API@@ -16,17 +15,29 @@ ) where import Neovim.Classes+import Neovim.OS (isWindows) -import Control.Applicative-import Control.Monad.Except+import Control.Applicative (optional)+import Control.Monad.Except (MonadError (throwError), forM) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.Map (Map) import qualified Data.Map as Map-import Data.MessagePack ( Object )-import Data.Serialize ( decode )-import Neovim.Compat.Megaparsec as P-import System.Process.Typed ( proc, readProcessStdout_ )+import Data.MessagePack (Object)+import Data.Serialize (decode)+import Neovim.Compat.Megaparsec as P (+ MonadParsec (eof, try),+ Parser,+ char,+ noneOf,+ oneOf,+ parse,+ some,+ space,+ string,+ (<|>),+ )+import System.Process.Typed (proc, readProcessStdout_) import UnliftIO.Exception ( SomeException, catch,@@ -72,18 +83,16 @@ -- | Run @nvim --api-info@ and parse its output. parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)-parseAPI = either (Left . pretty) extractAPI <$> -#ifndef WINDOWS- (decodeAPI `catch` \(_ignored :: SomeException) -> readFromAPIFile)+parseAPI = either (Left . pretty) extractAPI <$> go+ where+ go+ | isWindows = readFromAPIFile+ | otherwise = decodeAPI `catch` \(_ignored :: SomeException) -> readFromAPIFile decodeAPI :: IO (Either String Object) decodeAPI = decode . LB.toStrict <$> readProcessStdout_ (proc "nvim" ["--api-info"]) -#else- readFromAPIFile-#endif- extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI extractAPI apiObj = fromObject apiObj >>= \apiMap ->@@ -152,8 +161,10 @@ pArray :: P.Parser NeovimType pArray =- NestedType <$> (P.try (string "ArrayOf(") *> pType)- <*> optional pNum <* char ')'+ NestedType+ <$> (P.try (string "ArrayOf(") *> pType)+ <*> optional pNum+ <* char ')' pNum :: P.Parser Int pNum = read <$> (P.try (char ',') *> space *> P.some (oneOf ['0' .. '9']))
library/Neovim/API/TH.hs view
@@ -49,7 +49,6 @@ import Control.Exception import Control.Monad import Data.ByteString (ByteString)-import Data.ByteString.UTF8 (fromString) import Data.Char (isUpper, toUpper) import Data.Data (Data, Typeable) import Data.Map (Map)@@ -64,6 +63,7 @@ import UnliftIO.Exception import Prelude+import qualified Data.Text as T {- | Generate the API types and functions provided by @nvim --api-info@. @@ -217,7 +217,7 @@ (map (varP . snd) vars) ( normalB ( callFn- `appE` ([|(F . fromString)|] `appE` (litE . stringL . name) nf)+ `appE` ([|(F . T.pack)|] `appE` (litE . stringL . name) nf) `appE` listE (map (toObjVar . snd) vars) ) )@@ -319,21 +319,24 @@ Example: @ $(function \"MyExportedFunction\" 'myDefinedFunction) 'Sync' @ -} function :: String -> Name -> Q Exp-function [] _ = error "Empty names are not allowed for exported functions."+function [] _ = fail "Empty names are not allowed for exported functions." function customName@(c : _) functionName- | (not . isUpper) c = error $ "Custom function name must start with a capiatl letter: " <> show customName+ | (not . isUpper) c = error $ "Custom function name must start with a capital letter: " <> show customName | otherwise = do (_, fun) <- functionImplementation functionName- [|\funOpts -> EF (Function (F (fromString $(litE (StringL customName)))) funOpts, $(return fun))|]+ [|\funOpts -> EF (Function (F (T.pack $(litE (StringL customName)))) funOpts, $(return fun))|] +uppercaseFirstCharacter :: Name -> String+uppercaseFirstCharacter name = case nameBase name of+ "" -> ""+ (c : cs) -> toUpper c : cs+ {- | Define an exported function. This function works exactly like 'function', but it generates the exported name automatically by converting the first letter to upper case. -} function' :: Name -> Q Exp-function' functionName =- let (c : cs) = nameBase functionName- in function (toUpper c : cs) functionName+function' functionName = function (uppercaseFirstCharacter functionName) functionName {- | Simply data type used to identify a string-ish type (e.g. 'String', 'Text', 'ByteString' for a value of type.@@ -427,7 +430,7 @@ \copts -> EF ( Command- (F (fromString $(litE (StringL customFunctionName))))+ (F (T.pack $(litE (StringL customFunctionName)))) (mkCommandOptions ($(nargs) : copts)) , $(return fun) )@@ -437,9 +440,7 @@ it generates the command name by converting the first letter to upper case. -} command' :: Name -> Q Exp-command' functionName =- let (c : cs) = nameBase functionName- in command (toUpper c : cs) functionName+command' functionName = command (uppercaseFirstCharacter functionName) functionName {- | This function generates an export for autocmd. Since this is a static registration, arguments are not allowed here. You can, of course, define a@@ -467,12 +468,12 @@ autocmd :: Name -> Q Exp autocmd functionName =- let (c : cs) = nameBase functionName+ let ~(c : cs) = nameBase functionName in do (as, fun) <- functionImplementation functionName case as of [] ->- [|\t sync acmdOpts -> EF (Autocmd t (F (fromString $(litE (StringL (toUpper c : cs))))) sync acmdOpts, $(return fun))|]+ [|\t sync acmdOpts -> EF (Autocmd t (F (T.pack $(litE (StringL (toUpper c : cs))))) sync acmdOpts, $(return fun))|] _ -> error "Autocmd functions have to be fully applied (i.e. they should not take any arguments)."
library/Neovim/Classes.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}
library/Neovim/Context.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {- | Module : Neovim.Context Description : The Neovim context@@ -7,13 +6,11 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -} module Neovim.Context ( newUniqueFunctionName,- Neovim,- NeovimException(..),+ NeovimException (..), exceptionToDoc, FunctionMap, FunctionMapEntry,@@ -25,74 +22,64 @@ quit, subscribe, unsubscribe,- ask, asks, get, gets, put, modify,- Doc, AnsiStyle, docToText,- throwError, module Control.Monad.IO.Class,-#if __GLASGOW_HASKELL__ <= 710- module Control.Applicative,-#endif- ) where---import Neovim.Classes-import Neovim.Context.Internal (FunctionMap, FunctionMapEntry,- Neovim, mkFunctionMap,- newUniqueFunctionName, runNeovim, subscribe, unsubscribe)-import Neovim.Exceptions (NeovimException (..), exceptionToDoc)--import qualified Neovim.Context.Internal as Internal+) where -#if __GLASGOW_HASKELL__ <= 710-import Control.Applicative-#endif+import Neovim.Classes+import Neovim.Context.Internal (+ FunctionMap,+ FunctionMapEntry,+ Neovim,+ mkFunctionMap,+ newUniqueFunctionName,+ runNeovim,+ subscribe,+ unsubscribe,+ )+import Neovim.Exceptions (NeovimException (..), exceptionToDoc) -import Control.Concurrent (putMVar)-import Control.Exception-import Control.Monad.Except-import Control.Monad.IO.Class-import Control.Monad.Reader-import Control.Monad.State-import Data.MessagePack (Object)+import qualified Neovim.Context.Internal as Internal +import Control.Concurrent (putMVar)+import Control.Exception+import Control.Monad.Except+import Control.Monad.IO.Class+import Control.Monad.Reader+import Control.Monad.State+import Data.MessagePack (Object) -- | @'throw'@ specialized to a 'Pretty' value. err :: Doc AnsiStyle -> Neovim env a err = throw . ErrorMessage --errOnInvalidResult :: (NvimObject o)- => Neovim env (Either NeovimException Object)- -> Neovim env o-errOnInvalidResult a = a >>= \case- Left o ->- (err . exceptionToDoc) o-- Right o -> case fromObject o of- Left e ->- err e-- Right x ->- return x--+errOnInvalidResult ::+ (NvimObject o) =>+ Neovim env (Either NeovimException Object) ->+ Neovim env o+errOnInvalidResult a =+ a >>= \case+ Left o ->+ (err . exceptionToDoc) o+ Right o -> case fromObject o of+ Left e ->+ err e+ Right x ->+ return x -- | Initiate a restart of the plugin provider. restart :: Neovim env () restart = liftIO . flip putMVar Internal.Restart =<< Internal.asks' Internal.transitionTo - -- | Initiate the termination of the plugin provider. quit :: Neovim env () quit = liftIO . flip putMVar Internal.Quit =<< Internal.asks' Internal.transitionTo-
library/Neovim/Context/Internal.hs view
@@ -18,36 +18,40 @@ -} module Neovim.Context.Internal where -import Neovim.Classes+import Neovim.Classes (+ AnsiStyle,+ Doc,+ NFData,+ Pretty (pretty),+ deepseq,+ ) import Neovim.Exceptions ( NeovimException (..), exceptionToDoc, ) import Neovim.Plugin.Classes-import Neovim.Plugin.IPC (SomeMessage)+import Neovim.Plugin.IPC -import Control.Applicative-import Control.Exception (- ArithException,- ArrayException,- ErrorCall,- PatternMatchFail,- )-import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.Trans.Resource-import qualified Data.ByteString.UTF8 as U (fromString) import Data.Map (Map) import qualified Data.Map as Map import Data.MessagePack (Object) import Data.Monoid (Ap (Ap))-import Data.Text (Text)-import System.Log.Logger+import Data.Text (Text, pack)+import System.Log.Logger (errorM) import UnliftIO import Prettyprinter (viaShow) +import Control.Exception (+ ArithException,+ ArrayException,+ ErrorCall,+ PatternMatchFail,+ ) import qualified Control.Monad.Fail as Fail+import Control.Monad.Reader+import Control.Monad.Trans.Resource (MonadResource (..), MonadThrow)+import UnliftIO.Resource import Prelude {- | This is the environment in which all plugins are initially started.@@ -74,7 +78,7 @@ (r{customConfig = f (customConfig r)}) instance MonadResource (Neovim env) where- liftResourceT m = Neovim $ liftResourceT m+ liftResourceT m = Neovim $ UnliftIO.Resource.liftResourceT m instance Fail.MonadFail (Neovim env) where fail = throwIO . ErrorMessage . pretty@@ -130,7 +134,7 @@ tu <- asks' uniqueCounter -- reverseing the integer string should distribute the first character more -- evently and hence cause faster termination for comparisons.- fmap (F . U.fromString . reverse . show) . liftIO . atomically $ do+ fmap (F . pack . reverse . show) . liftIO . atomically $ do u <- readTVar tu modifyTVar' tu succ return u
library/Neovim/Debug.hs view
@@ -157,10 +157,10 @@ return Nothing Internal.InitSuccess -> do transitionHandlerThread <- async $ do- void $ transitionHandler (tids) cfg+ void $ transitionHandler tids cfg return . Just $ NvimHSDebugInstance- { threads = (transitionHandlerThread : tids)+ { threads = transitionHandlerThread : tids , neovimConfig = neovimConfig , internalConfig = cfg }@@ -175,7 +175,7 @@ putStrLn "Quit develMain" return Nothing _ -> do- putStrLn $ "Unexpected transition state for develMain."+ putStrLn "Unexpected transition state for develMain." return Nothing -- | Quit a previously started plugin provider.@@ -198,7 +198,7 @@ Neovim () a -> IO (Either (Doc AnsiStyle) a) runNeovim' NvimHSDebugInstance{internalConfig} =- runNeovim (Internal.retypeConfig () (internalConfig))+ runNeovim (Internal.retypeConfig () internalConfig) -- | Print the global function map to the console. printGlobalFunctionMap :: NvimHSDebugInstance -> IO ()
library/Neovim/Main.hs view
@@ -143,9 +143,9 @@ using the "Config.Dyre" library while still using the /nvim-hs/ specific configuration facilities. -}-realMain ::- TransitionHandler a ->- NeovimConfig ->+realMain :: TransitionHandler a -- ^ + -> NeovimConfig -- ^ + -> IO () realMain transitionHandler cfg = do os <- execParser opts@@ -197,7 +197,7 @@ putTMVar (Internal.globalFunctionMap conf) (Internal.mkFunctionMap funMapEntries)- putMVar (Internal.transitionTo conf) $ Internal.InitSuccess+ putMVar (Internal.transitionTo conf) Internal.InitSuccess transitionHandler (srTid : ehTid : pluginTids) conf standalone :: TransitionHandler ()
library/Neovim/Plugin.hs view
@@ -19,6 +19,8 @@ CommandOption (..), addAutocmd, registerPlugin,+ registerFunctionality,+ getProviderName, ) where import Neovim.API.String@@ -36,13 +38,12 @@ import Control.Applicative import Control.Monad (foldM, void)-import Control.Monad.Trans.Resource hiding (register)-import Data.ByteString (ByteString) import Data.Foldable (forM_) import Data.Map (Map) import qualified Data.Map as Map-import Data.Maybe (catMaybes)+import Data.Either (rights) import Data.MessagePack+import Data.Text (Text) import Data.Traversable (forM) import System.Log.Logger import UnliftIO.Async (Async, async, race)@@ -71,7 +72,7 @@ return (es ++ es', tid : tids) -{- | Callthe vimL functions to define a function, command or autocmd on the+{- | Call the vimL functions to define a function, command or autocmd on the neovim side. Returns 'True' if registration was successful. Note that this does not have any effect on the side of /nvim-hs/.@@ -172,31 +173,19 @@ registerFunctionality :: FunctionalityDescription -> ([Object] -> Neovim env Object) ->- Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))-registerFunctionality d f =+ Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)+registerFunctionality d f = do Internal.asks' Internal.pluginSettings >>= \case Nothing -> do- liftIO $ errorM logger "Cannot register functionality in this context."- return Nothing+ let msg = "Cannot register functionality in this context."+ liftIO $ errorM logger msg+ return $ Left $ pretty msg Just (Internal.StatefulSettings reg q m) -> reg d f q m >>= \case Just e -> do- -- Redefine fields so that it gains a new type- cfg <- Internal.retypeConfig () <$> Internal.ask'- rk <- fst <$> allocate (return ()) (free cfg (fst e))- return $ Just (e, Right rk)+ pure $ Right e Nothing ->- return Nothing- where- freeFun = \case- Autocmd _ _ _ AutocmdOptions{} -> do- liftIO $ warningM logger "Free not implemented for autocmds."- Command{} ->- liftIO $ warningM logger "Free not implemented for commands."- Function{} ->- liftIO $ warningM logger "Free not implemented for functions."-- free cfg fd _ = void . runNeovimInternal return cfg $ freeFun fd+ pure $ Left "" registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env () registerInGlobalFunctionMap e = do@@ -233,16 +222,16 @@ -} addAutocmd :: -- | The event to register to (e.g. BufWritePost)- ByteString ->+ Text -> Synchronous -> AutocmdOptions -> -- | Fully applied function to register- (Neovim env ()) ->+ Neovim env () -> -- | A 'ReleaseKey' if the registration worked- Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))-addAutocmd event s (opts@AutocmdOptions{}) f = do+ Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)+addAutocmd event s opts@AutocmdOptions{} f = do n <- newUniqueFunctionName- fmap snd <$> registerFunctionality (Autocmd event n s opts) (\_ -> toObject <$> f)+ registerFunctionality (Autocmd event n s opts) (\_ -> toObject <$> f) {- | Create a listening thread for events and add update the 'FunctionMap' with the corresponding 'TQueue's (i.e. communication channels).@@ -271,7 +260,7 @@ registerFunctionality (getDescription f) (getFunction f) es <- case res of Left e -> err e- Right a -> return $ catMaybes a+ Right a -> return $ rights a let pluginThreadConfig = cfg@@ -287,7 +276,7 @@ tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do listeningThread messageQueue route subscribers - return (map fst es, tid) -- NB: dropping release functions/keys here+ return (es, tid) -- NB: dropping release functions/keys here where executeFunction :: ([Object] -> Neovim env Object) ->@@ -326,7 +315,20 @@ (timeoutAndLog 10 fun) (executeFunction f args) - forM_ (fromMessage msg) $ \notification -> do+ forM_ (fromMessage msg) $ \notification@(Notification (NeovimEventId methodName) args) -> do+ let method = NvimMethod methodName+ route' <- liftIO $ readTVarIO route+ forM_ (Map.lookup method route') $ \f ->+ void . async $ do+ result <- either Left id <$> race+ (timeoutAndLog 600 (F methodName))+ (executeFunction f args)+ case result of+ Left message ->+ nvim_err_writeln message+ Right _ ->+ return ()+ subscribers' <- liftIO $ readTVarIO subscribers forM_ subscribers' $ \subscriber -> async $ void $ race (subscriber notification) (killAfterSeconds 10)
library/Neovim/Plugin/Classes.hs view
@@ -32,30 +32,23 @@ import Neovim.Classes -import Control.Applicative hiding (empty)-import Control.Monad.Error.Class-import Data.ByteString (ByteString)+import Control.Monad.Error.Class (MonadError (throwError)) import Data.Char (isDigit)-import Data.Default+import Data.Default (Default (..)) import Data.List (groupBy, sort) import qualified Data.Map as Map-import Data.Maybe-import Data.MessagePack-import Data.String+import Data.Maybe (catMaybes, mapMaybe)+import Data.MessagePack (Object (..))+import Data.String (IsString (..)) import Data.Text (Text)-import Data.Text.Encoding (decodeUtf8)--import Prettyprinter+import Prettyprinter (cat, comma, lparen, rparen, viaShow) import Prelude hiding (sequence) -- | Essentially just a string.-newtype FunctionName = F ByteString+newtype FunctionName = F Text deriving (Eq, Ord, Show, Read, Generic)- deriving (NFData) via ByteString--instance Pretty FunctionName where- pretty (F n) = pretty $ decodeUtf8 n+ deriving (NFData, Pretty) via Text newtype NeovimEventId = NeovimEventId Text deriving (Eq, Ord, Show, Read, Generic)@@ -104,7 +97,7 @@ -- * Name for the function to call -- * Whether to use rpcrequest or rpcnotify -- * Options for the autocmd (use 'def' here if you don't want to change anything)- Autocmd ByteString FunctionName Synchronous AutocmdOptions+ Autocmd Text FunctionName Synchronous AutocmdOptions deriving (Show, Read, Eq, Ord, Generic) instance NFData FunctionalityDescription@@ -116,7 +109,8 @@ Command fname copts -> "Command" <+> pretty copts <+> pretty fname Autocmd t fname s aopts ->- "Autocmd" <+> pretty (decodeUtf8 t)+ "Autocmd"+ <+> pretty t <+> pretty s <+> pretty aopts <+> pretty fname@@ -318,22 +312,22 @@ attributes a command can take. -} data CommandArguments = CommandArguments- { -- | 'Nothing' means that the function was not defined to handle a bang,- -- otherwise it means that the bang was passed (@'Just' 'True'@) or that it- -- was not passed when called (@'Just' 'False'@).- bang :: Maybe Bool- , -- | Range passed from neovim. Only set if 'CmdRange' was used in the export- -- declaration of the command.- --- -- Example:- --- -- * @Just (1,12)@- range :: Maybe (Int, Int)- , -- | Count passed by neovim. Only set if 'CmdCount' was used in the export- -- declaration of the command.- count :: Maybe Int- , -- | Register that the command can\/should\/must use.- register :: Maybe String+ { bang :: Maybe Bool+ -- ^ 'Nothing' means that the function was not defined to handle a bang,+ -- otherwise it means that the bang was passed (@'Just' 'True'@) or that it+ -- was not passed when called (@'Just' 'False'@).+ , range :: Maybe (Int, Int)+ -- ^ Range passed from neovim. Only set if 'CmdRange' was used in the export+ -- declaration of the command.+ --+ -- Example:+ --+ -- * @Just (1,12)@+ , count :: Maybe Int+ -- ^ Count passed by neovim. Only set if 'CmdCount' was used in the export+ -- declaration of the command.+ , register :: Maybe String+ -- ^ Register that the command can\/should\/must use. } deriving (Eq, Ord, Show, Read, Generic) @@ -392,14 +386,14 @@ referenced neovim help-page from the fields of this data type. -} data AutocmdOptions = AutocmdOptions- { -- | Pattern to match on. (default: \"*\")- acmdPattern :: String- , -- | Nested autocmd. (default: False)- --- -- See @:h autocmd-nested@- acmdNested :: Bool- , -- | Group in which the autocmd should be registered.- acmdGroup :: Maybe String+ { acmdPattern :: String+ -- ^ Pattern to match on. (default: \"*\")+ , acmdNested :: Bool+ -- ^ Nested autocmd. (default: False)+ --+ -- See @:h autocmd-nested@+ , acmdGroup :: Maybe String+ -- ^ Group in which the autocmd should be registered. } deriving (Show, Read, Eq, Ord, Generic) @@ -435,13 +429,9 @@ throwError $ "Did not expect to receive an AutocmdOptions object: " <+> viaShow o -newtype NvimMethod = NvimMethod {nvimMethodName :: ByteString}+newtype NvimMethod = NvimMethod {nvimMethodName :: Text} deriving (Eq, Ord, Show, Read, Generic)--instance NFData NvimMethod--instance Pretty NvimMethod where- pretty (NvimMethod n) = pretty $ decodeUtf8 n+ deriving (Pretty, NFData) via Text -- | Conveniennce class to extract a name from some value. class HasFunctionName a where@@ -458,3 +448,4 @@ Function (F n) _ -> NvimMethod $ n <> ":function" Command (F n) _ -> NvimMethod $ n <> ":command" Autocmd _ (F n) _ _ -> NvimMethod n+
library/Neovim/Plugin/IPC/Classes.hs view
@@ -26,18 +26,33 @@ module Data.Int, ) where -import Neovim.Classes+import Neovim.Classes (+ Generic,+ Int64,+ NFData (..),+ Pretty (pretty),+ deepseq,+ (<+>),+ ) import Neovim.Plugin.Classes (FunctionName, NeovimEventId) -import Control.Concurrent.STM-import Control.Exception (evaluate)-import Control.Monad.IO.Class (MonadIO (..))-import Data.Data (Typeable, cast)+import Data.Data (cast) import Data.Int (Int64)-import Data.MessagePack+import Data.MessagePack (Object) import Data.Time (UTCTime, formatTime, getCurrentTime) import Data.Time.Locale.Compat (defaultTimeLocale) import Prettyprinter (hardline, nest, viaShow)+import UnliftIO (+ MonadIO (..),+ MonadUnliftIO,+ TMVar,+ TQueue,+ Typeable,+ atomically,+ evaluate,+ readTQueue,+ writeTQueue,+ ) import Prelude @@ -62,7 +77,7 @@ fromMessage :: SomeMessage -> Maybe message fromMessage (SomeMessage message) = cast message -writeMessage :: (MonadIO m, Message message) => TQueue SomeMessage -> message -> m ()+writeMessage :: (MonadUnliftIO m, Message message) => TQueue SomeMessage -> message -> m () writeMessage q message = liftIO $ do evaluate (rnf message) atomically $ writeTQueue q (SomeMessage message)@@ -84,12 +99,14 @@ instance Pretty FunctionCall where pretty (FunctionCall fname args _ t) = nest 2 $- "Function call for:" <+> pretty fname- <> hardline- <> "Arguments:" <+> viaShow args- <> hardline- <> "Timestamp:"- <+> (viaShow . formatTime defaultTimeLocale "%H:%M:%S (%q)") t+ "Function call for:"+ <+> pretty fname+ <> hardline+ <> "Arguments:"+ <+> viaShow args+ <> hardline+ <> "Timestamp:"+ <+> (viaShow . formatTime defaultTimeLocale "%H:%M:%S (%q)") t {- | A request is a data type containing the method to call, its arguments and an identifier used to map the result to the function that has been called.@@ -111,11 +128,15 @@ instance Pretty Request where pretty Request{..} = nest 2 $- "Request" <+> "#" <> pretty reqId- <> hardline- <> "Method:" <+> pretty reqMethod- <> hardline- <> "Arguments:" <+> viaShow reqArgs+ "Request"+ <+> "#"+ <> pretty reqId+ <> hardline+ <> "Method:"+ <+> pretty reqMethod+ <> hardline+ <> "Arguments:"+ <+> viaShow reqArgs {- | A notification is similar to a 'Request'. It essentially does the same thing, but the function is only called for its side effects. This type of@@ -139,6 +160,8 @@ nest 2 $ "Notification" <> hardline- <> "Event:" <+> pretty notEvent- <> hardline- <> "Arguments:" <+> viaShow notEvent+ <> "Event:"+ <+> pretty notEvent+ <> hardline+ <> "Arguments:"+ <+> viaShow notEvent
library/Neovim/Plugin/Internal.hs view
@@ -19,10 +19,13 @@ wrapPlugin, ) where -import Neovim.Context-import Neovim.Plugin.Classes+import Neovim.Context (Neovim)+import Neovim.Plugin.Classes (+ FunctionalityDescription,+ HasFunctionName (..),+ ) -import Data.MessagePack+import Data.MessagePack (Object) {- | This data type is used in the plugin registration to properly register the functions.
library/Neovim/Quickfix.hs view
@@ -136,12 +136,10 @@ , ("type", toObject errorType) , ("text", toObject text) ]- ++ concat- [ case col of- NoColumn -> []- ByteIndexColumn i -> [("col", toObject i), ("vcol", toObject False)]- VisualColumn i -> [("col", toObject i), ("vcol", toObject True)]- ]+ ++ case col of+ NoColumn -> []+ ByteIndexColumn i -> [("col", toObject i), ("vcol", toObject False)]+ VisualColumn i -> [("col", toObject i), ("vcol", toObject True)] fromObject objectMap@(ObjectMap _) = do m <- fromObject objectMap@@ -167,11 +165,11 @@ nr' -> return nr' c <- l' "col" v <- l' "vcol"- let col = maybe NoColumn id $ do+ let col = fromMaybe NoColumn $ do c' <- c v' <- v case (c', v') of- (0, _) -> return $ NoColumn+ (0, _) -> return NoColumn (_, True) -> return $ VisualColumn c' (_, False) -> return $ ByteIndexColumn c' text <- fromMaybe mempty <$> l' "text"
library/Neovim/RPC/Common.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE RankNTypes, CPP #-}+{-# LANGUAGE RankNTypes #-}+ {- | Module : Neovim.RPC.Common Description : Common functons for the RPC module@@ -7,36 +8,40 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -}-module Neovim.RPC.Common- where+module Neovim.RPC.Common where -import Neovim.Context+import Neovim.OS (getSocketUnix) -import Control.Applicative-import Control.Concurrent.STM-import Control.Monad-import Data.Int (Int64)-import Data.Map-import Data.MessagePack-import Data.Monoid-import Data.Streaming.Network-import Data.String-import Data.Time-import Network.Socket as N hiding (SocketType)-import System.IO (BufferMode (..), Handle, IOMode(ReadWriteMode),- hClose, hSetBuffering)-import System.Log.Logger-import Neovim.Compat.Megaparsec as P+import Control.Applicative (Alternative ((<|>)))+import Control.Monad (unless)+import Data.Int (Int64)+import Data.Map (Map)+import Data.MessagePack (Object)+import Data.Streaming.Network (getSocketTCP)+import Data.String (IsString (fromString))+import Data.Time (UTCTime)+import Neovim.Compat.Megaparsec as P (+ MonadParsec (eof, try),+ Parser,+ anySingle,+ anySingleBut,+ many,+ parse,+ single,+ some,+ )+import Network.Socket as N (socketToHandle)+import System.Log.Logger (errorM, warningM) -import Prelude-import UnliftIO.Environment (lookupEnv)-import Data.Maybe (catMaybes) import Data.List (intercalate) import qualified Data.List as List+import Data.Maybe (catMaybes) import qualified Text.Megaparsec.Char.Lexer as L+import UnliftIO.Environment (lookupEnv)+import UnliftIO +import Prelude -- | Things shared between the socket reader and the event handler. data RPCConfig = RPCConfig@@ -44,94 +49,92 @@ -- ^ A map from message identifiers (as per RPC spec) to a tuple with a -- timestamp and a 'TMVar' that is used to communicate the result back to -- the calling thread.- , nextMessageId :: TVar Int64 -- ^ Message identifier for the next message as per RPC spec. } --- | Create a new basic configuration containing a communication channel for--- remote procedure call events and an empty lookup table for functions to--- mediate.-newRPCConfig :: (Applicative io, MonadIO io) => io RPCConfig-newRPCConfig = RPCConfig- <$> liftIO (newTVarIO mempty)- <*> liftIO (newTVarIO 1)+{- | Create a new basic configuration containing a communication channel for+ remote procedure call events and an empty lookup table for functions to+ mediate.+-}+newRPCConfig :: (Applicative io, MonadUnliftIO io) => io RPCConfig+newRPCConfig =+ RPCConfig+ <$> liftIO (newTVarIO mempty)+ <*> liftIO (newTVarIO 1) -- | Simple data type defining the kind of socket the socket reader should use.-data SocketType = Stdout Handle- -- ^ Use the handle for receiving msgpack-rpc messages. This is- -- suitable for an embedded neovim which is used in test cases.- | Environment- -- ^ Read the connection information from the environment- -- variable @NVIM@.- | UnixSocket FilePath- -- ^ Use a unix socket.- | TCP Int String- -- ^ Use an IP socket. First argument is the port and the- -- second is the host name.+data SocketType+ = -- | Use the handle for receiving msgpack-rpc messages. This is+ -- suitable for an embedded neovim which is used in test cases.+ Stdout Handle+ | -- | Read the connection information from the environment+ -- variable @NVIM@.+ Environment+ | -- | Use a unix socket.+ UnixSocket FilePath+ | -- | Use an IP socket. First argument is the port and the+ -- second is the host name.+ TCP Int String --- | Create a 'Handle' from the given socket description.------ The handle is not automatically closed.-createHandle :: (Functor io, MonadIO io)- => SocketType- -> io Handle+{- | Create a 'Handle' from the given socket description.++ The handle is not automatically closed.+-}+createHandle ::+ (Functor io, MonadUnliftIO io) =>+ SocketType ->+ io Handle createHandle = \case Stdout h -> do liftIO $ hSetBuffering h (BlockBuffering Nothing) return h- UnixSocket f ->-#ifndef WINDOWS liftIO $ createHandle . Stdout =<< flip socketToHandle ReadWriteMode =<< getSocketUnix f-#else- error "Windows' named pipes are not supported"-#endif- TCP p h -> createHandle . Stdout =<< createTCPSocketHandle p h- Environment -> createHandle . Stdout =<< createSocketHandleFromEnvironment- where- createTCPSocketHandle :: (MonadIO io) => Int -> String -> io Handle- createTCPSocketHandle p h = liftIO $ getSocketTCP (fromString h) p- >>= flip socketToHandle ReadWriteMode . fst+ createTCPSocketHandle :: (MonadUnliftIO io) => Int -> String -> io Handle+ createTCPSocketHandle p h =+ liftIO $+ getSocketTCP (fromString h) p+ >>= flip socketToHandle ReadWriteMode . fst createSocketHandleFromEnvironment = liftIO $ do -- NVIM_LISTEN_ADDRESS is for backwards compatibility envValues <- catMaybes <$> mapM lookupEnv ["NVIM", "NVIM_LISTEN_ADDRESS"] listenAdresses <- mapM parseNvimEnvironmentVariable envValues case listenAdresses of- (s:_) -> createHandle s- _ -> do- let errMsg = unlines- [ "Unhandled socket type from environment variable: "- , "\t" <> intercalate ", " envValues- ]+ (s : _) -> createHandle s+ _ -> do+ let errMsg =+ unlines+ [ "Unhandled socket type from environment variable: "+ , "\t" <> intercalate ", " envValues+ ] liftIO $ errorM "createHandle" errMsg error errMsg parseNvimEnvironmentVariable :: MonadFail m => String -> m SocketType parseNvimEnvironmentVariable envValue =- either (fail . show) pure $ parse (P.try pTcpAddress <|> pUnixSocket) envValue envValue+ either (fail . show) pure $ parse (P.try pTcpAddress <|> pUnixSocket) envValue envValue pUnixSocket :: P.Parser SocketType pUnixSocket = UnixSocket <$> P.some anySingle <* P.eof pTcpAddress :: P.Parser SocketType pTcpAddress = do- prefixes <- P.some (P.try (P.many (P.anySingleBut ':') <* P.single ':'))- port <- L.lexeme P.eof L.decimal- P.eof- pure $ TCP port (List.intercalate ":" prefixes)-- -- fail $ "Unsupported format for $NVIM environment variable: " <> envValue+ prefixes <- P.some (P.try (P.many (P.anySingleBut ':') <* P.single ':'))+ port <- L.lexeme P.eof L.decimal+ P.eof+ pure $ TCP port (List.intercalate ":" prefixes) --- | Close the handle and print a warning if the conduit chain has been--- interrupted prematurely.-cleanUpHandle :: (MonadIO io) => Handle -> Bool -> io ()+{- | Close the handle and print a warning if the conduit chain has been+ interrupted prematurely.+-}+cleanUpHandle :: (MonadUnliftIO io) => Handle -> Bool -> io () cleanUpHandle h completed = liftIO $ do hClose h unless completed $
library/Neovim/RPC/EventHandler.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {- |@@ -26,7 +25,6 @@ import Control.Applicative import Control.Concurrent.STM hiding (writeTQueue) import Control.Monad.Reader-import Control.Monad.Trans.Resource import Data.ByteString (ByteString) import qualified Data.Map as Map import Data.Serialize (encode)@@ -46,7 +44,7 @@ runEventHandlerContext env . runConduit $ do eventHandlerSource .| eventHandler- .| (sinkHandleFlush writeableHandle)+ .| sinkHandleFlush writeableHandle -- | Convenient monad transformer stack for the event handler newtype EventHandler a@@ -91,7 +89,7 @@ ConduitM i EncodedResponse EventHandler () handleMessage = \case (Just (FunctionCall fn params reply time), _) -> do- cfg <- asks (Internal.customConfig)+ cfg <- asks Internal.customConfig messageId <- atomically' $ do i <- readTVar (nextMessageId cfg) modifyTVar' (nextMessageId cfg) succ
library/Neovim/RPC/SocketReader.hs view
@@ -44,8 +44,8 @@ import qualified Data.Serialize (get) import System.IO (Handle) import System.Log.Logger-import UnliftIO.Async (async, race)-import UnliftIO.Concurrent (threadDelay)+import UnliftIO (timeout)+import UnliftIO.Async (async) import Prelude @@ -94,26 +94,23 @@ atomically' . modifyTVar' answerMap $ Map.delete i atomically' $ putTMVar reply result +lookupFunction ::+ Internal.Config RPCConfig ->+ FunctionName ->+ IO (Maybe (FunctionalityDescription, Internal.FunctionType))+lookupFunction rpc (F functionName) = do+ functionMap <- atomically $ readTMVar (Internal.globalFunctionMap rpc)+ pure $ Map.lookup (NvimMethod functionName) functionMap+ handleRequest :: Int64 -> FunctionName -> [Object] -> ConduitT a Void SocketHandler ()-handleRequest requestId functionToCall@(F functionName) params = do+handleRequest requestId functionToCall params = do cfg <- lift Internal.ask'- void . liftIO . async $ race logTimeout (handle cfg)+ void . liftIO . async $ timeout (10 * 1000 * 1000) (handle cfg) return () where- lookupFunction ::- TMVar Internal.FunctionMap ->- STM (Maybe (FunctionalityDescription, Internal.FunctionType))- lookupFunction funMap = Map.lookup (NvimMethod functionName) <$> readTMVar funMap-- logTimeout :: IO ()- logTimeout = do- let seconds = 1000 * 1000- threadDelay (10 * seconds)- debugM logger "Cancelled another action before it was finished"- handle :: Internal.Config RPCConfig -> IO () handle rpc =- atomically (lookupFunction (Internal.globalFunctionMap rpc)) >>= \case+ lookupFunction rpc functionToCall >>= \case Nothing -> do let errM = "No provider for: " <> show functionToCall debugM logger errM@@ -128,13 +125,20 @@ writeMessage c $ Request functionToCall requestId (parseParams copts params) handleNotification :: NeovimEventId -> [Object] -> ConduitT a Void SocketHandler ()-handleNotification eventId args = do- subscriptions' <- lift $ Internal.asks' Internal.subscriptions- subscribers <- liftIO $- atomically $ do- s <- readTMVar subscriptions'- pure $ fromMaybe [] $ Map.lookup eventId (Internal.byEventId s)- forM_ subscribers $ \subscription -> liftIO $ subAction subscription args+handleNotification eventId@(NeovimEventId str) args = do+ cfg <- lift Internal.ask'+ liftIO (lookupFunction cfg (F str)) >>= \case+ Just (copts, Internal.Stateful c) -> liftIO $ do+ debugM logger $ "Executing function asynchronously: " <> show str+ writeMessage c $ Notification eventId (parseParams copts args)+ Nothing -> do+ liftIO $ debugM logger $ "Handling event: " <> show str+ subscriptions' <- lift $ Internal.asks' Internal.subscriptions+ subscribers <- liftIO $+ atomically $ do+ s <- readTMVar subscriptions'+ pure $ fromMaybe [] $ Map.lookup eventId (Internal.byEventId s)+ forM_ subscribers $ \subscription -> liftIO $ subAction subscription args parseParams :: FunctionalityDescription -> [Object] -> [Object] parseParams (Function _ _) args = case args of
library/Neovim/Test.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE RecordWildCards #-}+ {- | Module : Neovim.Test Description : Testing functions@@ -9,12 +11,16 @@ Portability : GHC -} module Neovim.Test (- testWithEmbeddedNeovim,+ runInEmbeddedNeovim,+ runInEmbeddedNeovim', Seconds (..),+ TestConfiguration (..),+ -- deprecated+ testWithEmbeddedNeovim, ) where import Neovim-import Neovim.API.Text+import Neovim.API.Text (nvim_command, vim_command) import qualified Neovim.Context.Internal as Internal import Neovim.RPC.Common (RPCConfig, newRPCConfig) import Neovim.RPC.EventHandler (runEventHandler)@@ -22,55 +28,74 @@ import Control.Monad.Reader (runReaderT) import Control.Monad.Trans.Resource (runResourceT)+import Data.Default (Default)+import Data.Text (pack) import GHC.IO.Exception (ioe_filename)-import Path-import Path.IO+import Neovim.Plugin (startPluginThreads)+import Neovim.Util (oneLineErrorMessage)+import Path (File, Path, toFilePath) import Prettyprinter (annotate, vsep) import Prettyprinter.Render.Terminal (Color (..), color)-import System.Process.Typed-import UnliftIO-import UnliftIO.Concurrent (threadDelay)+import System.Process.Typed (+ ExitCode (ExitFailure, ExitSuccess),+ Process,+ createPipe,+ getExitCode,+ getStdin,+ getStdout,+ proc,+ setStdin,+ setStdout,+ startProcess,+ stopProcess,+ waitExitCode,+ )+import UnliftIO (Handle, IOException, async, atomically, cancel, catch, newEmptyMVar, putMVar, putTMVar, throwIO, timeout)+import UnliftIO.Concurrent (takeMVar, threadDelay) -- | Type synonym for 'Word'. newtype Seconds = Seconds Word+ deriving (Show) microSeconds :: Integral i => Seconds -> i microSeconds (Seconds s) = fromIntegral s * 1000 * 1000 -{- | Run the given 'Neovim' action according to the given parameters.- The embedded neovim instance is started without a config (i.e. it is passed- @-u NONE@).+newtype TestConfiguration = TestConfiguration+ { cancelAfter :: Seconds+ }+ deriving (Show) - If you want to run your tests purely from haskell, you have to setup- the desired state of neovim with the help of the functions in- "Neovim.API.String".+instance Default TestConfiguration where+ def =+ TestConfiguration+ { cancelAfter = Seconds 2+ }++{- | Run a neovim process with @-n --clean --embed@ and execute the+ given action that will have access to the started instance.++The 'TestConfiguration' contains sensible defaults.++'env' is the state of your function that you want to test. -}-testWithEmbeddedNeovim ::- -- | Optional path to a file that should be opened- Maybe (Path b File) ->- -- | Maximum time (in seconds) that a test is allowed to run- Seconds ->- -- | Read-only configuration- env ->- -- | Test case- Neovim env a ->- IO ()-testWithEmbeddedNeovim file timeoutAfter r (Internal.Neovim a) =- runTest `catch` catchIfNvimIsNotOnPath+runInEmbeddedNeovim :: TestConfiguration -> Plugin env -> Neovim env a -> IO ()+runInEmbeddedNeovim TestConfiguration{..} plugin action =+ warnIfNvimIsNotOnPath runTest where runTest = do- (nvimProcess, cfg, cleanUp) <- startEmbeddedNvim file timeoutAfter-- let testCfg = Internal.retypeConfig r cfg-- result <- timeout (microSeconds timeoutAfter) $ do- runReaderT (runResourceT a) testCfg+ resultMVar <- newEmptyMVar+ let action' = do+ result <- action+ q <- Internal.asks' Internal.transitionTo+ putMVar q Internal.Quit+ -- vim_command isn't asynchronous, so we need to avoid waiting+ -- for the result of the operation by using 'async' since+ -- neovim cannot send a result if it has quit.+ _ <- async . void $ vim_command "qa!"+ putMVar resultMVar result+ (nvimProcess, cleanUp) <- startEmbeddedNvim cancelAfter plugin action' - -- vim_command isn't asynchronous, so we need to avoid waiting for the- -- result of the operation since neovim cannot send a result if it- -- has quit.- let Internal.Neovim q = vim_command "qa!"- testRunner <- async . void $ runReaderT (runResourceT q) testCfg+ result <- timeout (microSeconds cancelAfter) (takeMVar resultMVar) waitExitCode nvimProcess >>= \case ExitFailure i ->@@ -78,11 +103,53 @@ ExitSuccess -> case result of Nothing -> fail "Test timed out" Just _ -> pure ()- cancel testRunner cleanUp -catchIfNvimIsNotOnPath :: IOException -> IO ()-catchIfNvimIsNotOnPath e = case ioe_filename e of+type TransitionHandler a = Internal.Config RPCConfig -> IO a++testTransitionHandler :: IO a -> TransitionHandler ()+testTransitionHandler onInitAction cfg =+ takeMVar (Internal.transitionTo cfg) >>= \case+ Internal.InitSuccess -> do+ void onInitAction+ testTransitionHandler onInitAction cfg+ Internal.Restart -> do+ fail "Restart unexpected"+ Internal.Failure e -> do+ fail . show $ oneLineErrorMessage e+ Internal.Quit -> do+ return ()++runInEmbeddedNeovim' :: TestConfiguration -> Neovim () a -> IO ()+runInEmbeddedNeovim' testCfg = runInEmbeddedNeovim testCfg Plugin{environment = (), exports = []}++{-# DEPRECATED testWithEmbeddedNeovim "Use \"runInEmbeddedNeovim def env action\" and open files with nvim_command \"edit file\"" #-}++{- | The same as 'runInEmbeddedNeovim' with the given file opened via @nvim_command "edit file"@.+ - This method is kept for backwards compatibility.+-}+testWithEmbeddedNeovim ::+ -- | Optional path to a file that should be opened+ Maybe (Path b File) ->+ -- | Maximum time (in seconds) that a test is allowed to run+ Seconds ->+ -- | Read-only configuration+ env ->+ -- | Test case+ Neovim env a ->+ IO ()+testWithEmbeddedNeovim file timeoutAfter env action =+ runInEmbeddedNeovim+ def{cancelAfter = timeoutAfter}+ Plugin{environment = env, exports = []}+ (openTestFile <* action)+ where+ openTestFile = case file of+ Nothing -> pure ()+ Just f -> nvim_command $ pack $ "edit " ++ toFilePath f++warnIfNvimIsNotOnPath :: IO a -> IO ()+warnIfNvimIsNotOnPath test = void test `catch` \(e :: IOException) -> case ioe_filename e of Just "nvim" -> putDoc . annotate (color Red) $ vsep@@ -93,22 +160,16 @@ throwIO e startEmbeddedNvim ::- Maybe (Path b File) -> Seconds ->- IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())-startEmbeddedNvim file timeoutAfter = do- args <- case file of- Nothing ->- pure []- Just f -> do- unlessM (doesFileExist f) . fail $ "File not found: " ++ show f- pure [toFilePath f]-+ Plugin env ->+ Neovim env () ->+ IO (Process Handle Handle (), IO ())+startEmbeddedNvim timeoutAfter plugin (Internal.Neovim action) = do nvimProcess <- startProcess $ setStdin createPipe $ setStdout createPipe $- proc "nvim" (["-n", "--clean", "--embed"] ++ args)+ proc "nvim" ["-n", "--clean", "--embed"] cfg <- Internal.newConfig (pure Nothing) newRPCConfig @@ -124,15 +185,30 @@ (getStdin nvimProcess) (cfg{Internal.pluginSettings = Nothing}) - atomically $- putTMVar- (Internal.globalFunctionMap cfg)- (Internal.mkFunctionMap [])+ let actionCfg = Internal.retypeConfig (environment plugin) cfg+ action' = runReaderT (runResourceT action) actionCfg+ pluginHandlers <-+ startPluginThreads (Internal.retypeConfig () cfg) [wrapPlugin plugin] >>= \case+ Left e -> do+ putMVar (Internal.transitionTo cfg) $ Internal.Failure e+ pure []+ Right (funMapEntries, pluginTids) -> do+ atomically $+ putTMVar+ (Internal.globalFunctionMap cfg)+ (Internal.mkFunctionMap funMapEntries)+ putMVar (Internal.transitionTo cfg) Internal.InitSuccess+ pure pluginTids + transitionHandler <- async . void $ do+ testTransitionHandler action' cfg timeoutAsync <- async . void $ do threadDelay $ microSeconds timeoutAfter getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> pure ()) - let cleanUp = mapM_ cancel [socketReader, eventHandler, timeoutAsync]+ let cleanUp =+ mapM_ cancel $+ [socketReader, eventHandler, timeoutAsync, transitionHandler]+ ++ pluginHandlers - pure (nvimProcess, cfg, cleanUp)+ pure (nvimProcess, cleanUp)
nvim-hs.cabal view
@@ -1,5 +1,5 @@ name: nvim-hs-version: 2.3.1.0+version: 2.3.2.0 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write@@ -74,6 +74,7 @@ , Neovim.Plugin.IPC.Classes , Neovim.Log , Neovim.Main+ , Neovim.OS , Neovim.RPC.Classes , Neovim.RPC.Common , Neovim.RPC.EventHandler@@ -144,6 +145,10 @@ if os(windows) cpp-options: -DWINDOWS+ hs-source-dirs: srcos/windows+ else+ hs-source-dirs: srcos/unix+ test-suite hspec type: exitcode-stdio-1.0@@ -199,6 +204,7 @@ , Neovim.EmbeddedRPCSpec , Neovim.EventSubscriptionSpec , Neovim.Plugin.ClassesSpec+ , AsyncFunctionSpec , Neovim.RPC.SocketReaderSpec , Neovim.RPC.CommonSpec
+ srcos/unix/Neovim/OS.hs view
@@ -0,0 +1,10 @@+module Neovim.OS (+ isWindows,+ getSocketUnix+) where++import Data.Streaming.Network (getSocketUnix)++isWindows :: Bool+isWindows = False+
+ srcos/windows/Neovim/OS.hs view
@@ -0,0 +1,11 @@+module Neovim.OS (+ isWindows,+ getSocketUnix+) where+import Network.Socket (Socket)++isWindows :: Bool+isWindows = True++getSocketUnix :: FilePath -> IO Socket+getSocketUnix _ = fail "Windows' named pipes are no supported"
+ test-suite/AsyncFunctionSpec.hs view
@@ -0,0 +1,34 @@+module AsyncFunctionSpec where++import Neovim+import Neovim.API.Text+import Neovim.Plugin (registerFunctionality)+import Neovim.Plugin.Classes (FunctionName (..), FunctionalityDescription (..))+import Neovim.Plugin.Internal (ExportedFunctionality (..))+import Neovim.Test++import Test.Hspec++import Neovim.Log+import UnliftIO+import UnliftIO.Concurrent++spec :: Spec+spec = do+ describe "an asynchronous function" $ do+ it "is callable" $ do+ called <- newEmptyMVar+ let myAsyncTestFunction = do+ Plugin+ { environment = ()+ , exports =+ [ EF+ ( Function (F "MyAsyncTestFunction") Async+ , \args -> toObject <$> putMVar called ()+ )+ ]+ }+ runInEmbeddedNeovim def{cancelAfter = Seconds 3} myAsyncTestFunction $ do+ nvim_call_function "MyAsyncTestFunction" mempty++ liftIO $ readMVar called `shouldReturn` ()
test-suite/Neovim/EmbeddedRPCSpec.hs view
@@ -21,12 +21,13 @@ import Control.Monad.Reader (runReaderT) import Control.Monad.State (runStateT) import qualified Data.Map as Map+import qualified GHC.IO.Device as Path import Path import Path.IO import System.Exit (ExitCode (..)) import System.Process.Typed -{- | Tests in here should always be wrapped in 'withNeovimEmbedded' because they+{- | Tests in here should always be wrapped in 'runInEmbeddedNeovim' def' because they don't fail if neovim isn't installed. This is particularly helpful to run tests on stackage and be notified if non-neovim-dependent tests fail. Basically everybody else who runs these tests has neovim installed and would@@ -34,12 +35,8 @@ -} spec :: Spec spec = parallel $ do- let withNeovimEmbedded :: Maybe (Path.Path b File) -> Neovim () a -> IO ()- withNeovimEmbedded f = testWithEmbeddedNeovim f (Seconds 3) ()- describe "Read hello test file"- . it "should match 'Hello, World!'"- . withNeovimEmbedded Nothing- $ do+ describe "Read hello test file" $+ it "should match 'Hello, World!'" . runInEmbeddedNeovim' def $ do nvim_command "edit test-files/hello" bs <- vim_get_buffers l <- vim_get_current_line@@ -47,7 +44,7 @@ liftIO $ length bs `shouldBe` 1 describe "New empty buffer test" $ do- it "should contain the test text" . withNeovimEmbedded Nothing $ do+ it "should contain the test text" . runInEmbeddedNeovim' def $ do cl0 <- vim_get_current_line liftIO $ cl0 `shouldBe` "" bs <- vim_get_buffers@@ -58,7 +55,7 @@ cl1 <- vim_get_current_line liftIO $ cl1 `shouldBe` testContent - it "should create a new buffer" . withNeovimEmbedded Nothing $ do+ it "should create a new buffer" . runInEmbeddedNeovim' def $ do bs0 <- vim_get_buffers liftIO $ length bs0 `shouldBe` 1 vim_command "new"@@ -68,13 +65,13 @@ bs2 <- vim_get_buffers liftIO $ length bs2 `shouldBe` 3 - it "should set the quickfix list" . withNeovimEmbedded Nothing $ do+ it "should set the quickfix list" . runInEmbeddedNeovim' def $ do let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String setqflist [q] Replace q' <- vim_eval "getqflist()" liftIO $ fromObjectUnsafe q' `shouldBe` [q] - it "throws NeovimException with function that failed as Doc" . withNeovimEmbedded Nothing $ do+ it "throws NeovimException with function that failed as Doc" . runInEmbeddedNeovim' def $ do let getVariableValue = False <$ vim_get_var "notDefined" hasTrhownNeovimExceptionWithFunctionName <- getVariableValue `catchNeovimException` \case@@ -82,7 +79,7 @@ _ -> pure False liftIO $ hasTrhownNeovimExceptionWithFunctionName `shouldBe` True - it "catches" . withNeovimEmbedded Nothing $ do+ it "catches" . runInEmbeddedNeovim' def $ do let getUndefinedVariable = vim_get_var "notDefined" functionThatFailed <- getUndefinedVariable `catchNeovimException` \case
test-suite/Neovim/EventSubscriptionSpec.hs view
@@ -34,9 +34,8 @@ spec :: Spec spec = parallel $ do- let withNeovimEmbedded = testWithEmbeddedNeovim Nothing (Seconds 2) () describe "Attaching to a buffer" $ do- it "receives nvim_buf_lines_event" . withNeovimEmbedded $ do+ it "receives nvim_buf_lines_event" . runInEmbeddedNeovim' def $ do received <- newEmptyMVar subscribe "nvim_buf_lines_event" $ putMVar received . parseBufLinesEvent buf <- nvim_create_buf True False@@ -51,7 +50,7 @@ bleLines `shouldBe` [""] bleMore `shouldBe` False - it "receives nvim_buf_detach_event" . withNeovimEmbedded $ do+ it "receives nvim_buf_detach_event" . runInEmbeddedNeovim' def $ do received <- newEmptyMVar subscribe "nvim_buf_detach_event" $ putMVar received buf <- nvim_create_buf True False
test-suite/Neovim/Plugin/ClassesSpec.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-} module Neovim.Plugin.ClassesSpec where@@ -44,7 +43,7 @@ instance Arbitrary RandomCommandOptions where arbitrary = do l <- choose (0, 20)- (RCOs . mkCommandOptions . map getRandomCommandOption) <$> vectorOf l arbitrary+ RCOs . mkCommandOptions . map getRandomCommandOption <$> vectorOf l arbitrary spec :: Spec spec = do