nvim-hs 2.1.0.7 → 2.3.2.4
raw patch · 85 files changed
Files
- CHANGELOG.md +28/−0
- README.md +10/−1
- Setup.hs +1/−1
- api binary
- apiblobs/0.10.4.msgpack binary
- apiblobs/0.11.0-nightly.msgpack binary
- apiblobs/0.4.3.msgpack binary
- apiblobs/0.5.0.msgpack binary
- apiblobs/0.6.1.msgpack binary
- apiblobs/0.8.0.msgpack binary
- library/Neovim.hs +0/−475
- library/Neovim/API/ByteString.hs +0/−23
- library/Neovim/API/Parser.hs +0/−153
- library/Neovim/API/String.hs +0/−26
- library/Neovim/API/TH.hs +0/−576
- library/Neovim/API/Text.hs +0/−23
- library/Neovim/Classes.hs +0/−470
- library/Neovim/Compat/Megaparsec.hs +0/−30
- library/Neovim/Config.hs +0/−33
- library/Neovim/Context.hs +0/−96
- library/Neovim/Context/Internal.hs +0/−272
- library/Neovim/Debug.hs +0/−211
- library/Neovim/Exceptions.hs +0/−50
- library/Neovim/Log.hs +0/−60
- library/Neovim/Main.hs +0/−203
- library/Neovim/Plugin.hs +0/−333
- library/Neovim/Plugin/Classes.hs +0/−473
- library/Neovim/Plugin/IPC.hs +0/−20
- library/Neovim/Plugin/IPC/Classes.hs +0/−142
- library/Neovim/Plugin/Internal.hs +0/−65
- library/Neovim/Quickfix.hs +0/−206
- library/Neovim/RPC/Classes.hs +0/−114
- library/Neovim/RPC/Common.hs +0/−117
- library/Neovim/RPC/EventHandler.hs +0/−107
- library/Neovim/RPC/FunctionCall.hs +0/−135
- library/Neovim/RPC/SocketReader.hs +0/−220
- library/Neovim/Test.hs +0/−133
- library/Neovim/Util.hs +0/−36
- nvim-hs-devel.sh +0/−34
- nvim-hs.cabal +70/−94
- src/Neovim.hs +476/−0
- src/Neovim/API/ByteString.hs +21/−0
- src/Neovim/API/Parser.hs +173/−0
- src/Neovim/API/String.hs +25/−0
- src/Neovim/API/TH.hs +582/−0
- src/Neovim/API/Text.hs +21/−0
- src/Neovim/Classes.hs +454/−0
- src/Neovim/Compat/Megaparsec.hs +30/−0
- src/Neovim/Config.hs +31/−0
- src/Neovim/Context.hs +86/−0
- src/Neovim/Context/Internal.hs +348/−0
- src/Neovim/Debug.hs +229/−0
- src/Neovim/Exceptions.hs +53/−0
- src/Neovim/Log.hs +58/−0
- src/Neovim/Main.hs +242/−0
- src/Neovim/Plugin.hs +381/−0
- src/Neovim/Plugin/Classes.hs +453/−0
- src/Neovim/Plugin/IPC.hs +18/−0
- src/Neovim/Plugin/IPC/Classes.hs +167/−0
- src/Neovim/Plugin/Internal.hs +63/−0
- src/Neovim/Quickfix.hs +212/−0
- src/Neovim/RPC/Classes.hs +103/−0
- src/Neovim/RPC/Common.hs +142/−0
- src/Neovim/RPC/EventHandler.hs +125/−0
- src/Neovim/RPC/FunctionCall.hs +109/−0
- src/Neovim/RPC/SocketReader.hs +210/−0
- src/Neovim/Test.hs +214/−0
- src/Neovim/Util.hs +32/−0
- srcos/unix/Neovim/OS.hs +10/−0
- srcos/windows/Neovim/OS.hs +11/−0
- test-suite/Neovim/API/THSpec.hs +0/−117
- test-suite/Neovim/API/THSpecFunctions.hs +0/−22
- test-suite/Neovim/EmbeddedRPCSpec.hs +0/−67
- test-suite/Neovim/Plugin/ClassesSpec.hs +0/−71
- test-suite/Neovim/RPC/SocketReaderSpec.hs +0/−67
- test-suite/Spec.hs +0/−1
- tests/API/THSpec.hs +118/−0
- tests/API/THSpecFunctions.hs +21/−0
- tests/AsyncFunctionSpec.hs +32/−0
- tests/EmbeddedRPCSpec.hs +72/−0
- tests/EventSubscriptionSpec.hs +65/−0
- tests/Plugin/ClassesSpec.hs +64/−0
- tests/RPC/CommonSpec.hs +20/−0
- tests/RPC/SocketReaderSpec.hs +77/−0
- tests/Spec.hs +1/−0
CHANGELOG.md view
@@ -1,3 +1,31 @@+# 2.3.1.0++* Add `subscribe` and `unsubscribe` function. Neovim doesn't automatically send+ event notifications to nvim-hs (or any other remote plugin) and for the+ callback of the `subscribe` funtion to trigger, you have to call a specific+ function before (e.g. `nvim_buf_attach`). In any case, if you want to subscribe + to a specific event, you have to read the documentation of the neovim + documentation. Some events are still better handled with autocommands.++# 2.3.0.0++* Windows is now rudimentarily supported. Since I couldn't find a library to+ connect to named pipes on windows and I didn't want to extend or write one,+ you have to use TCP sockets or Standard in and out to communicate with+ neovim. If you start neovim with `nvim --listen localhost:`, it will set the+ `NVIM` environment variable, so that nvim-hs can automatically connect to the+ neovim instance without passing any arguments.++# 2.2.0.0++* NeovimException are now thrown from (synchronous) remote functions and are no+ longer suppressed with an `error` call that also had a terrible error message.+ A function `catchNeovimException` (specialized `catch`) has been added that + catches these errors. +* The return type of asynchronous functions is now alwas + `STM (Either NeovimException result)` and errors have to be handled by the + caller explicitly.+ # 2.1.0.2 * Exported functions and commands now can have the same name.
README.md view
@@ -9,7 +9,6 @@ to generate the neovim bindings and to avoid some of the boilerplate handy work, some exotic operating systems and architectures may not work. -[](https://travis-ci.org/neovimhaskell/nvim-hs) [](https://hackage.haskell.org/package/nvim-hs) [](http://stackage.org/lts/package/nvim-hs) [](http://stackage.org/nightly/package/nvim-hs)@@ -17,6 +16,16 @@ # What do I have to expect if I were to use it now? Check the issue list here on github.++## For Windows users++Named pipes are not supported at the momend #103. You therefore have to start+`nvim-hs` instances by connecting to STDIN and STDOUT or TCP. By default `nvim-hs`+connects to the listen socket pointed to by the `NVIM` environment variable and +the functions in the module `Neovim.Debug` rely on that. If you want to be able to +run these functions, start Neovim with `nvim --listen localhost:` or similar+(This example command starts neovim with a socket listening on `localhost` and +random a random TCP port.) # How do I start using this?
Setup.hs view
@@ -1,3 +1,3 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
api view
binary file changed (25287 → 32007 bytes)
+ apiblobs/0.10.4.msgpack view
binary file changed (absent → 32007 bytes)
+ apiblobs/0.11.0-nightly.msgpack view
binary file changed (absent → 31782 bytes)
+ apiblobs/0.4.3.msgpack view
binary file changed (absent → 25287 bytes)
+ apiblobs/0.5.0.msgpack view
binary file changed (absent → 27983 bytes)
+ apiblobs/0.6.1.msgpack view
binary file changed (absent → 28544 bytes)
+ apiblobs/0.8.0.msgpack view
binary file changed (absent → 30761 bytes)
− library/Neovim.hs
@@ -1,475 +0,0 @@-{- |-Module : Neovim-Description : API for the neovim plugin provider /nvim-hs/-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC (due to Template Haskell)--This module should contain all the things you need to write neovim plugins in-your favorite language! @:-)@--The documentation in this module should provide every information you need to start-writing plugins.--}-module Neovim (- -- * Installation- -- $installation-- -- * Tutorial- -- ** Motivation- -- $overview- -- ** Combining existing plugins- -- $existingplugins- Neovim,- neovim,- NeovimConfig(..),- defaultConfig,- def,--- -- ** Creating a plugin- -- $creatingplugins- NeovimPlugin(..),- Plugin(..),- NvimObject(..),- (+:),- Dictionary,- Object(..),- wrapPlugin,- function,- function',- command,- command',- autocmd,- Synchronous(..),- CommandOption(..),- RangeSpecification(..),- CommandArguments(..),- AutocmdOptions(..),- addAutocmd,-- ask,- asks,-- -- ** Creating a stateful plugin- -- $statefulplugin-- -- ** Calling remote functions- -- $remote- wait,- wait',- err,- errOnInvalidResult,- NeovimException(..),-- -- * Unsorted exports- -- This section contains just a bunch of more or less useful functions which- -- were not introduced in any of the previous sections.- liftIO,- whenM,- unlessM,- docToObject,- docFromObject,- Doc,- AnsiStyle,- Pretty(..),- putDoc,- exceptionToDoc,- Priority(..),- module Control.Monad,- module Control.Applicative,- module Data.Monoid,- module Data.Int,- module Data.Word,-- ) where--import Control.Applicative-import Control.Monad (void)-import Control.Monad.IO.Class (liftIO)-import Data.Default (def)-import Data.Int (Int16, Int32, Int64, Int8)-import Data.MessagePack (Object (..))-import Data.Monoid-import Data.Word (Word, Word16, Word32, Word8)-import Neovim.API.TH (autocmd, command, command',- function, function')-import Neovim.Classes (Dictionary, NvimObject (..),- Doc, AnsiStyle, Pretty(..),- docFromObject, docToObject, (+:))-import Neovim.Config (NeovimConfig (..))-import Neovim.Context (Neovim,- NeovimException(..),- exceptionToDoc,- ask, asks, err,- errOnInvalidResult)-import Neovim.Main (neovim)-import Neovim.Plugin (addAutocmd)-import Neovim.Plugin.Classes (AutocmdOptions (..),- CommandArguments (..),- CommandOption (CmdBang, CmdCount, CmdRange, CmdRegister, CmdSync),- RangeSpecification (..),- Synchronous (..))-import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..),- wrapPlugin)-import Neovim.RPC.FunctionCall (wait, wait')-import Neovim.Util (unlessM, whenM)-import System.Log.Logger (Priority (..))-import Data.Text.Prettyprint.Doc.Render.Terminal (putDoc)--- Installation {{{1-{- $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-{- $overview-An @nvim-hs@ plugin is just a collection of haskell functions that can be-called from neovim.--As a user of plugins, you basically have two choices. You can start every-plugin in a separate process and use normal vim plugin management strategies-such as <https://github.com/junegunn/vim-plug vim-plug>-or <https://github.com/tpope/vim-pathogen pathogen>.-Alternatively, you can create a haskell project and depend on the plugins-you want to use and plumb them together. This plumbing is equivalent to-writing a plugin.--Since you are reading haddock documentation, you probably want the latter, so-just keep reading. @:-)@---}----- 2}}}--- Combining Existing Plugins {{{2-{- $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-directory (@~\/.config\/nvim@ on linux-based systems), it should automatically be-compiled and run with two simple example plugins.--You have to define a haskell project that depends on this package and-contains an executable secion within a main file that looks something like this:--@-import TestPlugin.ExamplePlugin (examplePlugin)--main = 'neovim' 'def'- { 'plugins' = [ examplePlugin ] ++ 'plugins' 'defaultConfig'- }-@---/nvim-hs/ is all about importing and creating plugins. This is done following a-concise API. Let's start by making a given plugin available inside-our plugin provider. Assuming that we have installed a cabal package that exports-an @examplePlugin@ from the module @TestPlugin.ExamplePlugin@, a minimal-main file would look something like this:--That's all you have to do! Multiple plugins are simply imported and put in a-list.---}---- | Default configuration options for /nvim-hs/. If you want to keep the--- default plugins enabled, you can define your config like this:------ @--- main = 'neovim' 'defaultConfig'--- { plugins = plugins defaultConfig ++ myPlugins--- }--- @----defaultConfig :: NeovimConfig-defaultConfig = Config- { plugins = []- , logOptions = Nothing- }----- 2}}}--- Creating a plugin {{{2-{- $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-so bad. We will cover most pitfalls in the following paragraphs and if there-isn't a solution for your error, you can always ask any friendly Haskeller in-\#haskell on @irc.freenode.net@!--Enough scary stuff said for now, let's write a plugin!-Due to a stage restriction in GHC when using Template Haskell-(i.e. code generation), we must define-our functions in a different module than @\$XDG_CONFIG_HOME\/nvim\/nvim.hs@.-(I'm assuming here, that you use @\$XDG_CONFIG_HOME\/nvim\/@ as the base-directory for historical reasons and because it might be an appropriate place.)-This is a bit unfortunate, but it will save you a lot of boring boilerplate and-it will present you with helpful error messages if your plugin's functions do-not work together with neovim.--So, let\'s write a plugin that calculates the @n@th Fibonacci number. Don\'t we all-love those!--File @\~\/.config\/nvim\/lib\/Fibonacci\/Plugin.hs@:--@-module Fibonacci.Plugin (fibonacci) where--import "Neovim"--\-\- \| Neovim is not really good with big numbers, so we return a 'String' here.-fibonacci :: 'Int' -> 'Neovim' env 'String'-fibonacci n = 'return' . 'show' \$ fibs !! n- where- fibs :: [Integer]- fibs = 0:1:'scanl1' (+) fibs-@--File @\~\/.config\/nvim\/lib\/Fibonacci.hs@:--@-\{\-\# LANGUAGE TemplateHaskell \#\-\}-module Fibonacci (plugin) where--import "Neovim"-import Fibonacci.Plugin (fibonacci)--plugin :: 'Neovim' () 'NeovimPlugin'-plugin = 'wrapPlugin' Plugin- { 'environment' = ()- , 'exports' = [ $('function'' 'fibonacci) 'Sync' ]- }-@--File @~\/.config\/nvim\/nvim.hs@:--@-import "Neovim"--import qualified Fibonacci as Fibonacci--main :: 'IO' ()-main = 'neovim' 'defaultConfig'- { 'plugins' = 'plugins' 'defaultConfig' ++ [ Fibonacci.plugin ]- }-@--Let's analyze how it works. The module @Fibonacci.Plugin@ simply defines a function-that takes the @n@th element of the infinite list of Fibonacci numbers. Even though-the definition is very concise and asthetically pleasing, the important part is the-type signature for @fibonacci@. Similarly how @main :: IO ()@ works in normal Haskell-programs, 'Neovim' is the environment we need for plugins. Internally, it stores a-few things that are needed to communicate with neovim, but that shouldn't bother you-too much. Simply remember that every plugin function must have a function signature-whose last element is of type @'Neovim' env something@. The result of @fibonacci@-is 'String' because neovim cannot handle big numbers so well. :-)-You can use any argument or result type as long as it is an instance of 'NvimObject'.--The second part of of the puzzle, which is the definition of @plugin@-in @~\/.config\/nvim\/lib\/Fibonacci.hs@, shows what a plugin is. It is essentially-an empty environment and a list of functions, commands or autocommands in the context of vim-terminology. In the end, all of those things map to a function at the side-of /nvim-hs/. If you really want to know what the distinction between those is, you-have to consult the @:help@ pages of neovim (e.g. @:help :function@, @:help :command@-and @:help :autocmd@). What's relevant from the side of /nvim-hs/ is the environment.-The environment is a data type that is avaiable to all exported functions of your-plugin. This example does not make use of anything of that environment, so-we used '()', also known as unit, as our environment. The definition of-@fibonacci@ uses a type variable @env@ as it does not access the environment and-can handle any environment. If you want to access the environment, you can call-'ask' or 'asks' if you are inside a 'Neovim' environment. An example that shows-you how to use it can be found in a later chapter.--Now to the magical part: @\$('function'' 'fibonacci)@. This is a so called-Template Haskell splice and this is why you need-@\{\-\# LANGUAGE TemplateHaskell \#\-\}@ at the top of your Haskell file. This-splice simply generates Haskell code that, in this case, still needs a value-of type 'Synchronous' which indicates whether calling the function will make-neovim wait for its result or not. Internally, the expression-@\$('function'' 'fibonacci) 'Sync'@ creates a value that contains all the-necessary information to properly register the function with neovim. Note the-prime symbol before the function name! This would have probably caused you-some trouble if I haven't mentioned it here! Template Haskell simply requires-you to put that in front of function names that are passed in a splice.--If you compile this and restart the plugin, you can calculate the 2000th Fibonacci-number like as if it were a normal vim-script function:--@-:echo Fibonacci(2000)-@--You can also directly insert the result inside any text file opened with neovim-by using the evaluation register by pressing the following key sequence in insert-mode:--@-\<C-r\>=Fibonacci(2000)-@--The haddock documentation will now list all the things we have used up until now.-Afterwards, there is a plugin with state which uses the environment.---}--- 2}}}--- Creating a stateful plugin {{{2-{- $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-generator!--File @~\/.config\/nvim\/lib\/Random\/Plugin.hs@:--@-module Random.Plugin (nextRandom, setNextRandom) where--import "Neovim"--import System.Random (newStdGen, randoms)-import UnliftIO.STM (TVar, atomically, readTVar, modifyTVar, newTVarIO)---- You may want to define a type alias for your plugin, so that if you change--- your environment, you don't have to change all type signatures.------ If I were to write a real plugin, I would probably also create a data type--- instead of directly using a TVar here.----type MyNeovim a = Neovim ('TVar' ['Int16']) a---- This function will create an initial environment for our random number--- generator. Note that the return type is the type of our environment.-randomNumbers :: Neovim startupEnv (TVar [Int16])-randomNumbers = do- g <- liftIO newStdGen -- Create a new seed for a pseudo random number generator- newTVarIO (randoms g) -- Put an infinite list of random numbers into a TVar---- | Get the next random number and update the state of the list.-nextRandom :: MyNeovim 'Int16'-nextRandom = do- tVarWithRandomNumbers <- 'ask'- atomically $ do- -- pick the head of our list of random numbers- r \<- 'head' <$> 'readTVar' tVarWithRandomNumbers-- -- Since we do not want to return the same number all over the place- -- remove the head of our list of random numbers- modifyTVar tVarWithRandomNumbers 'tail'-- 'return' r----- | You probably don't want this in a random number generator, but this shows--- hoy you can edit the state of a stateful plugin.-setNextRandom :: 'Int16' -> MyNeovim ()-setNextRandom n = do- tVarWithRandomNumbers <- 'ask'-- -- cons n to the front of the infinite list- atomically $ modifyTVar tVarWithRandomNumbers (n:)-@--File @~\/.config\/nvim\/lib\/Random.hs@:--@-\{\-\# LANGUAGE TemplateHaskell \#\-\}-module Random (plugin) where--import "Neovim"-import Random.Plugin (nextRandom, setNextRandom)-import "System.Random" ('newStdGen', 'randoms')--plugin :: 'Neovim' ('StartupConfig' 'NeovimConfig') () 'NeovimPlugin'-plugin = do- env <- randomNumbers- 'wrapPlugin' 'Plugin'- { environment = env- , 'exports' =- [ $('function'' 'nextRandom) 'Sync'- , $('function' \"SetNextRandom\" 'setNextRandom) 'Async'- ]- }-@--File @~\/.config\/nvim\/nvim.hs@:--@-import "Neovim"--import qualified Fibonacci as Fibonacci-import qualified Random as Random--main :: 'IO' ()-main = 'neovim' 'defaultConfig'- { 'plugins' = 'plugins' 'defaultConfig' ++ [ Fibonacci.plugin, Random.plugin ]- }-@---That wasn't too hard, was it? The definition is very similar to the previous-example, we just were able to mutate our state and share that with other-functions. Another noteworthy detail, in case you-are not familiar with it, is the use of 'liftIO' in front of 'newStdGen'. You-have to do this, because 'newStdGen' has type @'IO' 'StdGen'@ but the actions-inside the startup code are of type-@'Neovim' () something@. 'liftIO' lifts an-'IO' function so that it can be run inside the 'Neovim' context (or more-generally, any monad that implements the 'MonadIO' type class).--After you have saved these files (and removed any typos @:-)@), you can restart-/nvim-hs/ with @:RestartNvimhs@ and insert random numbers in your text files!--@-\<C-r\>=NextRandom()-@--You can also cheat and pretend you know the next number:--@-:call SetNextRandom(42)-@---}--- 2}}}--- Calling remote functions {{{2-{- $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-getting some abstract 'Buffer' object, test whether it is valid and then try-to rename it.--@-inspectBuffer :: 'Neovim' env ()-inspectBuffer = do- cb <- 'vim_get_current_buffer'- isValid <- 'buffer_is_valid' cb- when isValid $ do- let newName = "magic"- cbName \<- 'wait'' $ 'buffer_set_name' cb newName- case () of- _ | cbName == newName -> 'return' ()- _ -> 'err' $ "Renaming the current buffer failed!"-@--You may have noticed the 'wait'' function in there. Some functions have a return-type with 'STM' in it. This means that the function call is asynchronous. We can-'wait' (or 'wait'') for the result at the point at which we actually need it. In-this short example, we put the 'wait'' directly in front of the remote function-call because we want to inspect the result immediately, though. The other-functions either returned a result directly or they returned-@'Either' 'Object' something@ whose result we inspected ourselves. The 'err'-function directly terminates the current thread and sends the given error-message to neovim which the user immediately notices.--That's pretty much all there is to it.--}--- 2}}}--- 1}}}---- vim: foldmethod=marker
− library/Neovim/API/ByteString.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{- |-Module : Neovim.API.ByteString-Description : ByteString based API-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.API.ByteString- where--import Neovim.API.TH--$(generateAPI bytestringVectorTypeMap)-
− library/Neovim/API/Parser.hs
@@ -1,153 +0,0 @@-{- |-Module : Neovim.API.Parser-Description : P.Parser for the msgpack output stram API-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental--}-module Neovim.API.Parser (- NeovimAPI (..),- NeovimFunction (..),- NeovimType (..),- parseAPI,-) where--import Neovim.Classes--import Control.Applicative-import Control.Monad.Except-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-import Data.Serialize-import Neovim.Compat.Megaparsec as P-import System.Process.Typed-import UnliftIO.Exception (- SomeException,- catch,- )--import Prelude--data NeovimType- = SimpleType String- | NestedType NeovimType (Maybe Int)- | Void- deriving (Show, Eq)--{- | This data type contains simple information about a function as received- throudh the @nvim --api-info@ command.--}-data NeovimFunction = NeovimFunction- { -- | function name- name :: String- , -- | A list of type name and variable name.- parameters :: [(NeovimType, String)]- , -- | Indicator whether the function can fail/throws exceptions.- canFail :: Bool- , -- | Indicator whether the this function is asynchronous.- async :: Bool- , -- | Functions return type.- returnType :: NeovimType- }- deriving (Show)--{- | This data type represents the top-level structure of the @nvim --api-info@- output.--}-data NeovimAPI = NeovimAPI- { -- | The error types are defined by a name and an identifier.- errorTypes :: [(String, Int64)]- , -- | Extension types defined by neovim.- customTypes :: [(String, Int64)]- , -- | The remotely executable functions provided by the neovim api.- functions :: [NeovimFunction]- }- deriving (Show)---- | Run @nvim --api-info@ and parse its output.-parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)-parseAPI = either (Left . pretty) extractAPI <$> (decodeAPI `catch` readFromAPIFile)--extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI-extractAPI apiObj =- fromObject apiObj >>= \apiMap ->- NeovimAPI- <$> extractErrorTypes apiMap- <*> extractCustomTypes apiMap- <*> extractFunctions apiMap--readFromAPIFile :: SomeException -> IO (Either String Object)-readFromAPIFile _ = (decode <$> B.readFile "api") `catch` returnPreviousExceptionAsText- where- returnPreviousExceptionAsText :: SomeException -> IO (Either String Object)- returnPreviousExceptionAsText _ =- return . Left $- "The 'nvim' process could not be started and there is no file named\- \ 'api' in the working directory as a substitute."--decodeAPI :: IO (Either String Object)-decodeAPI =- decode . LB.toStrict <$> readProcessStdout_ (proc "nvim" ["--api-info"])--oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o-oLookup qry = maybe throwErrorMessage fromObject . Map.lookup qry- where- throwErrorMessage = throwError $ "No entry for:" <+> pretty qry--oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o-oLookupDefault d qry m = maybe (return d) fromObject $ Map.lookup qry m--extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]-extractErrorTypes objAPI = extractTypeNameAndID =<< oLookup "error_types" objAPI--extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)]-extractTypeNameAndID m = do- types <- Map.toList <$> fromObject m- forM types $ \(errName, idMap) -> do- i <- oLookup "id" idMap- return (errName, i)--extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]-extractCustomTypes objAPI = extractTypeNameAndID =<< oLookup "types" objAPI--extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]-extractFunctions objAPI = mapM extractFunction =<< oLookup "functions" objAPI--toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]-toParameterlist ps = forM ps $ \(t, n) -> do- t' <- parseType t- return (t', n)--extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction-extractFunction funDefMap =- NeovimFunction- <$> oLookup "name" funDefMap- <*> (oLookup "parameters" funDefMap >>= toParameterlist)- <*> oLookupDefault True "can_fail" funDefMap- <*> oLookupDefault False "async" funDefMap- <*> (oLookup "return_type" funDefMap >>= parseType)--parseType :: String -> Either (Doc AnsiStyle) NeovimType-parseType s = either (throwError . pretty . show) return $ parse (pType <* eof) s s--pType :: P.Parser NeovimType-pType = pArray P.<|> pVoid P.<|> pSimple--pVoid :: P.Parser NeovimType-pVoid = Void <$ (P.try (string "void") <* eof)--pSimple :: P.Parser NeovimType-pSimple = SimpleType <$> P.some (noneOf [',', ')'])--pArray :: P.Parser NeovimType-pArray =- 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/String.hs
@@ -1,26 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{- |-Module : Neovim.API.String-Description : String based API-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental--Note that this module is completely generated. If you're reading this on-hackage, the actual functions of this module may be different from what is-available to you. All the functions in this module depend on the neovim version-that was used when this package was compiled.--}-module Neovim.API.String- where--import Neovim.API.TH--$(generateAPI stringListTypeMap)-
− library/Neovim/API/TH.hs
@@ -1,576 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE TemplateHaskell #-}--{- |-Module : Neovim.API.TH-Description : Template Haskell API generation module-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental--}-module Neovim.API.TH (- generateAPI,- function,- function',- command,- command',- autocmd,- stringListTypeMap,- textVectorTypeMap,- bytestringVectorTypeMap,- module UnliftIO.Exception,- module Neovim.Classes,- module Data.Data,- module Data.MessagePack,-) where--import Neovim.API.Parser-import Neovim.Classes-import Neovim.Context-import Neovim.Plugin.Classes (- CommandArguments (..),- CommandOption (..),- FunctionName (..),- FunctionalityDescription (..),- mkCommandOptions,- )-import Neovim.Plugin.Internal (ExportedFunctionality (..))-import Neovim.RPC.FunctionCall--import Language.Haskell.TH hiding (dataD, instanceD)-import TemplateHaskell.Compat.V0208--import Control.Applicative-import Control.Arrow (first)-import Control.Concurrent.STM (STM)-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)-import qualified Data.Map as Map-import Data.Maybe-import Data.MessagePack-import Data.Monoid-import qualified Data.Set as Set-import Data.Text (Text)-import Data.Text.Prettyprint.Doc (viaShow)-import Data.Vector (Vector)-import UnliftIO.Exception--import Prelude--{- | Generate the API types and functions provided by @nvim --api-info@.-- The provided map allows the use of different Haskell types for the types- defined in the API. The types must be an instance of 'NvimObject' and they- must form an isomorphism with the sent messages types. Currently, it- provides a Convenient way to replace the /String/ type with 'Text',- 'ByteString' or 'String'.--}-generateAPI :: TypeMap -> Q [Dec]-generateAPI typeMap = do- api <- either (fail . show) return =<< runIO parseAPI- let exceptionName = mkName "NeovimExceptionGen"- exceptions = (\(n, i) -> (mkName ("Neovim" <> n), i)) `map` errorTypes api- customTypesN = first mkName `map` customTypes api- join- <$> sequence- [ join . pure <$> createDataTypeWithByteStringComponent exceptionName (map fst exceptions)- , exceptionInstance exceptionName- , customTypeInstance exceptionName exceptions- , fmap join (mapM ((\n -> createDataTypeWithByteStringComponent n [n]) . fst) customTypesN)- , join <$> mapM (\(n, i) -> customTypeInstance n [(n, i)]) customTypesN- , fmap join . mapM (createFunction typeMap) $ functions api- ]---- | Maps type identifiers from the neovim API to Haskell types.-data TypeMap = TypeMap- { typesOfAPI :: Map String (Q Type)- , list :: Q Type- }--stringListTypeMap :: TypeMap-stringListTypeMap =- TypeMap- { typesOfAPI =- Map.fromList- [ ("Boolean", [t|Bool|])- , ("Integer", [t|Int64|])- , ("LuaRef", [t|Int64|])- , ("Float", [t|Double|])- , ("String", [t|String|])- , ("Array", [t|[Object]|])- , ("Dictionary", [t|Map String Object|])- , ("void", [t|()|])- ]- , list = listT- }--textVectorTypeMap :: TypeMap-textVectorTypeMap =- stringListTypeMap- { typesOfAPI = adjustTypeMapForText $ typesOfAPI stringListTypeMap- , list = [t|Vector|]- }- where- adjustTypeMapForText =- Map.insert "String" [t|Text|]- . Map.insert "Array" [t|Vector Object|]- . Map.insert "Dictionary" [t|Map Text Object|]--bytestringVectorTypeMap :: TypeMap-bytestringVectorTypeMap =- textVectorTypeMap- { typesOfAPI = adjustTypeMapForByteString $ typesOfAPI textVectorTypeMap- }- where- adjustTypeMapForByteString =- Map.insert "String" [t|ByteString|]- . Map.insert "Array" [t|Vector Object|]- . Map.insert "Dictionary" [t|Map ByteString Object|]--apiTypeToHaskellType :: TypeMap -> NeovimType -> Q Type-apiTypeToHaskellType typeMap@TypeMap{typesOfAPI, list} at = case at of- Void -> [t|()|]- NestedType t Nothing ->- appT list $ apiTypeToHaskellType typeMap t- NestedType t (Just n) ->- foldl appT (tupleT n) . replicate n $ apiTypeToHaskellType typeMap t- SimpleType t ->- fromMaybe ((conT . mkName) t) $ Map.lookup t typesOfAPI--{- | This function will create a wrapper function with neovim's function name- as its name.-- Synchronous function:- @- buffer_get_number :: Buffer -> Neovim Int64- buffer_get_number buffer = scall "buffer_get_number" [toObject buffer]- @-- Asynchronous function:- @- vim_eval :: String -> Neovim (TMVar Object)- vim_eval str = acall "vim_eval" [toObject str]- @-- Asynchronous function without a return value:- @- vim_feed_keys :: String -> String -> Bool -> Neovim ()- vim_feed_keys keys mode escape_csi =- acallVoid "vim_feed_keys" [ toObject keys- , toObject mode- , toObject escape_csi- ]- @--}-createFunction :: TypeMap -> NeovimFunction -> Q [Dec]-createFunction typeMap nf = do- let withDeferred- | async nf = appT [t|STM|]- | otherwise = id-- callFn- | async nf = [|acall'|]- | otherwise = [|scall'|]-- functionName = mkName $ name nf- toObjVar v = [|toObject $(varE v)|]-- retType <-- let env = mkName "env"- in forallT [specifiedPlainTV env] (return [])- . appT [t|Neovim $(varT env)|]- . withDeferred- . apiTypeToHaskellType typeMap- $ returnType nf-- -- prefix with arg0_, arg1_ etc. to prevent generated code from crashing due- -- to keywords being used.- -- see https://github.com/neovimhaskell/nvim-hs/issues/65- let prefixWithNumber i n = "arg" ++ show i ++ "_" ++ n- applyPrefixWithNumber =- zipWith- (\i (t, n) -> (t, prefixWithNumber i n))- [0 :: Int ..]- . parameters- vars <-- mapM- ( \(t, n) ->- (,) <$> apiTypeToHaskellType typeMap t- <*> newName n- )- $ applyPrefixWithNumber nf-- sequence- [ (sigD functionName . return) (foldr ((AppT . AppT ArrowT) . fst) retType vars)- , funD- functionName- [ clause- (map (varP . snd) vars)- ( normalB- ( callFn- `appE` ([|(F . fromString)|] `appE` (litE . stringL . name) nf)- `appE` listE (map (toObjVar . snd) vars)- )- )- []- ]- ]--{- | @ createDataTypeWithObjectComponent SomeName [Foo,Bar]@- will create this:- @- data SomeName = Foo !Object- | Bar !Object- deriving (Typeable, Eq, Show)- @--}-createDataTypeWithByteStringComponent :: Name -> [Name] -> Q [Dec]-createDataTypeWithByteStringComponent nme cs = do- tObject <- [t|ByteString|]-- let strictNess = (Bang NoSourceUnpackedness SourceStrict, tObject)-- pure- [ dataD- []- nme- []- (map (\n -> NormalC n [strictNess]) cs)- (mkName <$> ["Typeable", "Eq", "Show", "Generic"])- , instanceD [] (AppT (ConT (mkName "NFData")) (ConT nme)) []- ]--{- | If the first parameter is @mkName NeovimException@, this function will- generate @instance Exception NeovimException@.--}-exceptionInstance :: Name -> Q [Dec]-exceptionInstance exceptionName = do- tException <- [t|Exception|]- pure [instanceD [] (tException `AppT` ConT exceptionName) []]--{- | @customTypeInstance Foo [(Bar, 1), (Quz, 2)]@- will create this:- @- instance Serializable Foo where- toObject (Bar bs) = ObjectExt 1 bs- toObject (Quz bs) = ObjectExt 2 bs- fromObject (ObjectExt 1 bs) = return $ Bar bs- fromObject (ObjectExt 2 bs) = return $ Quz bs- fromObject o = Left $ "Object is not convertible to: Foo Received: " <> show o- @--}-customTypeInstance :: Name -> [(Name, Int64)] -> Q [Dec]-customTypeInstance typeName nis = do- let fromObjectClause :: Name -> Int64 -> Q Clause- fromObjectClause n i =- newName "bs" >>= \bs ->- clause- [ conP- (mkName "ObjectExt")- [(litP . integerL . fromIntegral) i, varP bs]- ]- (normalB [|return $ $(conE n) $(varE bs)|])- []- fromObjectErrorClause :: Q Clause- fromObjectErrorClause = do- o <- newName "o"- let n = nameBase typeName- clause- [varP o]- ( normalB- [|- throwError $- pretty "Object is not convertible to:"- <+> viaShow n- <+> pretty "Received:"- <+> viaShow $(varE o)- |]- )- []-- toObjectClause :: Name -> Int64 -> Q Clause- toObjectClause n i =- newName "bs" >>= \bs ->- clause- [conP n [varP bs]]- (normalB [|ObjectExt $((litE . integerL . fromIntegral) i) $(varE bs)|])- []-- tNvimObject <- [t|NvimObject|]- fToObject <- funD (mkName "toObject") $ map (uncurry toObjectClause) nis- fFromObject <- funD (mkName "fromObject") $ map (uncurry fromObjectClause) nis <> [fromObjectErrorClause]- pure [instanceD [] (tNvimObject `AppT` ConT typeName) [fToObject, fFromObject]]--{- | Define an exported function by providing a custom name and referencing the- function you want to export.-- Note that the name must start with an upper case letter.-- Example: @ $(function \"MyExportedFunction\" 'myDefinedFunction) 'Sync' @--}-function :: String -> Name -> Q Exp-function [] _ = error "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- | otherwise = do- (_, fun) <- functionImplementation functionName- [|\funOpts -> EF (Function (F (fromString $(litE (StringL customName)))) funOpts, $(return fun))|]--{- | 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--{- | Simply data type used to identify a string-ish type (e.g. 'String', 'Text',- 'ByteString' for a value of type.--}-data ArgType- = StringyType- | ListOfStringyTypes- | Optional ArgType- | CommandArgumentsType- | OtherType- deriving (Eq, Ord, Show, Read)--{- | Given a value of type 'Type', test whether it can be classified according- to the constructors of "ArgType".--}-classifyArgType :: Type -> Q ArgType-classifyArgType t = do- set <- genStringTypesSet- maybeType <- [t|Maybe|]- cmdArgsType <- [t|CommandArguments|]- case t of- AppT ListT (ConT str)- | str `Set.member` set ->- return ListOfStringyTypes- AppT m mt@(ConT _)- | m == maybeType ->- Optional <$> classifyArgType mt- ConT str- | str `Set.member` set ->- return StringyType- cmd- | cmd == cmdArgsType ->- return CommandArgumentsType- _ -> return OtherType- where- genStringTypesSet = do- types <- sequence [[t|String|], [t|ByteString|], [t|Text|]]- return $ Set.fromList [n | ConT n <- types]--{- | Similarly to 'function', this function is used to export a command with a- custom name.-- Note that commands must start with an upper case letter.-- Due to limitations on the side of (neo)vim, commands can only have one of the- following five signatures, where you can replace 'String' with 'ByteString'- or 'Text' if you wish:-- * 'CommandArguments' -> 'Neovim' r st ()-- * 'CommandArguments' -> 'Maybe' 'String' -> 'Neovim' r st ()-- * 'CommandArguments' -> 'String' -> 'Neovim' r st ()-- * 'CommandArguments' -> ['String'] -> 'Neovim' r st ()-- * 'CommandArguments' -> 'String' -> ['String'] -> 'Neovim' r st ()-- Example: @ $(command \"RememberThePrime\" 'someFunction) ['CmdBang'] @-- Note that the list of command options (i.e. the last argument) removes- duplicate options by means of some internally convenient sorting. You should- simply not define the same option twice.--}-command :: String -> Name -> Q Exp-command [] _ = error "Empty names are not allowed for exported commands."-command customFunctionName@(c : _) functionName- | (not . isUpper) c = error $ "Custom command name must start with a capital letter: " <> show customFunctionName- | otherwise = do- (argTypes, fun) <- functionImplementation functionName- -- See :help :command-nargs for what the result strings mean- case argTypes of- (CommandArgumentsType : _) -> return ()- _ -> error "First argument for a function exported as a command must be CommandArguments!"- let nargs = case tail argTypes of- [] -> [|CmdNargs "0"|]- [StringyType] -> [|CmdNargs "1"|]- [Optional StringyType] -> [|CmdNargs "?"|]- [ListOfStringyTypes] -> [|CmdNargs "*"|]- [StringyType, ListOfStringyTypes] -> [|CmdNargs "+"|]- _ ->- error $- unlines- [ "Trying to generate a command without compatible types."- , "Due to a limitation burdened on us by vimL, we can only"- , "use a limited amount type signatures for commands. See"- , "the documentation for 'command' for a more thorough"- , "explanation."- ]- [|- \copts ->- EF- ( Command- (F (fromString $(litE (StringL customFunctionName))))- (mkCommandOptions ($(nargs) : copts))- , $(return fun)- )- |]--{- | Define an exported command. This function works exactly like 'command', but- 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--{- | This function generates an export for autocmd. Since this is a static- registration, arguments are not allowed here. You can, of course, define a- fully applied function and pass it as an argument. If you have to add- autocmds dynamically, it can be done with 'addAutocmd'.-- Example:-- @- someFunction :: a -> b -> c -> d -> Neovim r st res- someFunction = ...-- theFunction :: Neovim r st res- theFunction = someFunction 1 2 3 4--}--{- $(autocmd 'theFunction) def- @-- @def@ is of type 'AutocmdOptions'.-- Note that you have to define @theFunction@ in a different module due to- the use of Template Haskell.--}--autocmd :: Name -> Q Exp-autocmd 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))|]- _ ->- error "Autocmd functions have to be fully applied (i.e. they should not take any arguments)."--{- | Generate a function of type @[Object] -> Neovim' Object@ from the argument- function.-- The function- @- add :: Int -> Int -> Int- add = (+)- @- will be converted to- @- \args -> case args of- [x,y] -> case pure add <*> fromObject x <*> fromObject y of- Left e -> err $ "Wrong type of arguments for add: " ++ e- Right action -> toObject <$> action- _ -> err $ "Wrong number of arguments for add: " ++ show xs- @--}-functionImplementation :: Name -> Q ([ArgType], Exp)-functionImplementation functionName = do- fInfo <- reify functionName- nargs <- mapM classifyArgType $ case fInfo of- VarI _ functionType _ ->- determineNumberOfArguments functionType- x ->- error $ "Value given to function is (likely) not the name of a function.\n" <> show x-- e <- topLevelCase nargs- return (nargs, e)- where- determineNumberOfArguments :: Type -> [Type]- determineNumberOfArguments ft = case ft of- ForallT _ _ t -> determineNumberOfArguments t- AppT (AppT ArrowT t) r -> t : determineNumberOfArguments r- _ -> []- -- \args -> case args of ...- topLevelCase :: [ArgType] -> Q Exp- topLevelCase ts = do- let n = length ts- minLength = length [() | Optional _ <- reverse ts]- args <- newName "args"- lamE- [varP args]- ( caseE- (varE args)- (zipWith matchingCase [n, n -1 ..] [0 .. minLength] ++ [errorCase])- )-- -- _ -> err "Wrong number of arguments"- errorCase :: Q Match- errorCase =- match- wildP- ( normalB- [|- throw . ErrorMessage . pretty $- "Wrong number of arguments for function: "- ++ $(litE (StringL (nameBase functionName)))- |]- )- []-- -- [x,y] -> case pure add <*> fromObject x <*> fromObject y of ...- matchingCase :: Int -> Int -> Q Match- matchingCase n x = do- vars <- mapM (\_ -> Just <$> newName "x") [1 .. n]- let optVars = replicate x (Nothing :: Maybe Name)- match- ((listP . map varP . catMaybes) vars)- ( normalB- ( caseE- ( foldl- genArgumentCast- [|pure $(varE functionName)|]- (zip (vars ++ optVars) (repeat [|(<*>)|]))- )- [successfulEvaluation, failedEvaluation]- )- )- []-- genArgumentCast :: Q Exp -> (Maybe Name, Q Exp) -> Q Exp- genArgumentCast e = \case- (Just v, op) ->- infixE (Just e) op (Just [|fromObject $(varE v)|])- (Nothing, op) ->- infixE (Just e) op (Just [|pure Nothing|])-- successfulEvaluation :: Q Match- successfulEvaluation =- newName "action" >>= \action ->- match- (conP (mkName "Right") [varP action])- (normalB [|toObject <$> $(varE action)|])- []- failedEvaluation :: Q Match- failedEvaluation =- newName "e" >>= \e ->- match- (conP (mkName "Left") [varP e])- (normalB [|err ($(varE e) :: Doc AnsiStyle)|])- []
− library/Neovim/API/Text.hs
@@ -1,23 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}-{- |-Module : Neovim.API.Text-Description : Text based API-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.API.Text- where--import Neovim.API.TH--$(generateAPI textVectorTypeMap)-
− library/Neovim/Classes.hs
@@ -1,470 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#endif-{- |-Module : Neovim.Classes-Description : Type classes used for conversion of msgpack and Haskell types-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.Classes- ( NvimObject(..)- , Dictionary- , (+:)- , Generic- , docToObject- , docFromObject- , docToText-- , Doc- , AnsiStyle- , Pretty(..)- , (<+>)- , module Data.Int- , module Data.Word- , module Control.DeepSeq- ) where--import Neovim.Exceptions (NeovimException (..))--import Control.Applicative-import Control.Arrow ((***))-import Control.DeepSeq-import Control.Monad.Except-import Data.ByteString (ByteString)-import Data.Int- ( Int16- , Int32- , Int64- , Int8- )-import qualified Data.Map.Strict as SMap-import Data.MessagePack-import Data.Monoid-import Data.Text as Text (Text)-import Data.Text.Prettyprint.Doc- ( Doc- , Pretty (..)- , defaultLayoutOptions- , layoutPretty- , viaShow- , (<+>)- )-import qualified Data.Text.Prettyprint.Doc as P-import Data.Text.Prettyprint.Doc.Render.Terminal- ( AnsiStyle- , renderStrict- )-import Data.Traversable hiding (forM, mapM)-import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.Word- ( Word- , Word16- , Word32- , Word64- , Word8- )-import GHC.Generics (Generic)--import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import UnliftIO.Exception (throwIO)--import Prelude---infixr 5 +:---- | Convenient operator to create a list of 'Object' from normal values.--- @--- values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []--- @-(+:) :: (NvimObject o) => o -> [Object] -> [Object]-o +: os = toObject o : os----- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience--- method to transport error message from and to neovim. It generally does not--- hold that 'docToObject . docFromObject' = 'id'.-docToObject :: Doc AnsiStyle -> Object-docToObject = ObjectString . encodeUtf8 . docToText----- | See 'docToObject'.-docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle)-docFromObject o = (P.viaShow :: Text -> Doc AnsiStyle) <$> fromObject o---docToText :: Doc AnsiStyle -> Text-docToText = renderStrict . layoutPretty defaultLayoutOptions----- | A generic vim dictionary is a simply a map from strings to objects. This--- type alias is sometimes useful as a type annotation especially if the--- OverloadedStrings extension is enabled.-type Dictionary = SMap.Map ByteString Object----- | Conversion from 'Object' files to Haskell types and back with respect--- to neovim's interpretation.------ The 'NFData' constraint has been added to allow forcing results of function--- evaluations in order to catch exceptions from pure code. This adds more--- stability to the plugin provider and seems to be a cleaner approach.-class NFData o => NvimObject o where- toObject :: o -> Object-- fromObjectUnsafe :: Object -> o- fromObjectUnsafe o = case fromObject o of- Left e -> error . show $- "Not the expected object:" <+> P.viaShow o- <+> P.lparen <> e <> P.rparen- Right obj -> obj-- fromObject :: Object -> Either (Doc AnsiStyle) o- fromObject = return . fromObjectUnsafe-- fromObject' :: (MonadIO io) => Object -> io o- fromObject' = either (throwIO . ErrorMessage) return . fromObject-- {-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-}----- Instances for NvimObject {{{1-instance NvimObject () where- toObject _ = ObjectNil-- fromObject ObjectNil = return ()- fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o----- We may receive truthy values from neovim, so we should be more forgiving--- here.-instance NvimObject Bool where- toObject = ObjectBool-- fromObject (ObjectBool o) = return o- fromObject (ObjectInt 0) = return False- fromObject (ObjectUInt 0) = return False- fromObject ObjectNil = return False- fromObject (ObjectBinary "0") = return False- fromObject (ObjectBinary "") = return False- fromObject (ObjectString "0") = return False- fromObject (ObjectString "") = return False- fromObject _ = return True---instance NvimObject Double where- toObject = ObjectDouble-- fromObject (ObjectDouble o) = return o- fromObject (ObjectFloat o) = return $ realToFrac o- fromObject (ObjectInt o) = return $ fromIntegral o- fromObject (ObjectUInt o) = return $ fromIntegral o- fromObject o = throwError $ "Expected ObjectDouble, but got"- <+> viaShow o---instance NvimObject Integer where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt o) = return $ toInteger o- fromObject (ObjectUInt o) = return $ toInteger o- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o---instance NvimObject Int64 where- toObject = ObjectInt-- fromObject (ObjectInt i) = return i- fromObject (ObjectUInt o) = return $ fromIntegral o- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Int32 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Int16 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Int8 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Word where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Word64 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Word32 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Word16 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Word8 where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance NvimObject Int where- toObject = ObjectInt . fromIntegral-- fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i- fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o---instance {-# OVERLAPPING #-} NvimObject [Char] where- toObject = ObjectBinary . UTF8.fromString-- fromObject (ObjectBinary o) = return $ UTF8.toString o- fromObject (ObjectString o) = return $ UTF8.toString o- fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o---instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where- toObject = ObjectArray . map toObject-- fromObject (ObjectArray os) = mapM fromObject os- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance NvimObject o => NvimObject (Maybe o) where- toObject = maybe ObjectNil toObject-- fromObject ObjectNil = return Nothing- fromObject o = either throwError (return . Just) $ fromObject o---instance NvimObject o => NvimObject (Vector o) where- toObject = ObjectArray . V.toList . V.map toObject-- fromObject (ObjectArray os) = V.fromList <$> mapM fromObject os- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o----- | Right-biased instance for toObject.-instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where- toObject = either toObject toObject-- fromObject o = case fromObject o of- Right r ->- return $ Right r-- Left e1 -> case fromObject o of- Right l ->- return $ Left l-- Left e2 ->- throwError $ e1 <+> "--" <+> e2---instance (Ord key, NvimObject key, NvimObject val)- => NvimObject (SMap.Map key val) where- toObject = ObjectMap- . SMap.fromList . map (toObject *** toObject) . SMap.toList-- fromObject (ObjectMap om) = SMap.fromList <$>- (sequenceA- . map (uncurry (liftA2 (,))- . (fromObject *** fromObject))- . SMap.toList) om-- fromObject o = throwError $ "Expected ObjectMap, but got" <+> viaShow o---instance NvimObject Text where- toObject = ObjectBinary . encodeUtf8-- fromObject (ObjectBinary o) = return $ decodeUtf8 o- fromObject (ObjectString o) = return $ decodeUtf8 o- fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o---instance NvimObject ByteString where- toObject = ObjectBinary-- fromObject (ObjectBinary o) = return o- fromObject (ObjectString o) = return o- fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o---instance NvimObject Object where- toObject = id-- fromObject = return- fromObjectUnsafe = id----- By the magic of vim, i will create these.-instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where- toObject (o1, o2) = ObjectArray $ [toObject o1, toObject o2]-- fromObject (ObjectArray [o1, o2]) = (,)- <$> fromObject o1- <*> fromObject o2- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o--instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where- toObject (o1, o2, o3) = ObjectArray $ [toObject o1, toObject o2, toObject o3]-- fromObject (ObjectArray [o1, o2, o3]) = (,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where- toObject (o1, o2, o3, o4) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4]-- fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where- toObject (o1, o2, o3, o4, o5) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5]-- fromObject (ObjectArray [o1, o2, o3, o4, o5]) = (,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where- toObject (o1, o2, o3, o4, o5, o6) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6]-- fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) = (,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) where- toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7]-- fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) = (,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8) where- toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8]-- fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) = (,,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7- <*> fromObject o8- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o---instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8, NvimObject o9) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) where- toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8, toObject o9]-- fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) = (,,,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7- <*> fromObject o8- <*> fromObject o9- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o----- 1}}}
− library/Neovim/Compat/Megaparsec.hs
@@ -1,30 +0,0 @@-{-# LANGUAGE CPP #-}-module Neovim.Compat.Megaparsec- ( Parser- , module X-#if MIN_VERSION_megaparsec(7,0,0)- , anyChar-#endif- ) where---import Text.Megaparsec as X--#if MIN_VERSION_megaparsec(6,0,0)--import Data.Void-import Text.Megaparsec.Char as X--type Parser = Parsec Void String--#else--import Text.Megaparsec.String as X--#endif--#if MIN_VERSION_megaparsec(7,0,0)-anyChar :: Parser Char-anyChar = anySingle-#endif-
− library/Neovim/Config.hs
@@ -1,33 +0,0 @@-{- |-Module : Neovim.Config-Description : The user editable and compilable configuration-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.Config (- NeovimConfig(..),- module System.Log,- ) where--import Neovim.Context (Neovim)-import Neovim.Plugin.Internal (NeovimPlugin)--import System.Log (Priority (..))---- | This data type contains information about the configuration of neovim. See--- the fields' documentation for what you possibly want to change. Also, the--- tutorial in the "Neovim" module should get you started.-data NeovimConfig = Config- { plugins :: [Neovim () NeovimPlugin]- -- ^ The list of plugins. The IO type inside the list allows the plugin- -- author to run some arbitrary startup code before creating a value of- -- type 'NeovimPlugin'.-- , logOptions :: Maybe (FilePath, Priority)- -- ^ Set the general logging options.- }-
− library/Neovim/Context.hs
@@ -1,96 +0,0 @@-{-# LANGUAGE CPP #-}-{- |-Module : Neovim.Context-Description : The Neovim context-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.Context (- newUniqueFunctionName,-- Neovim,- NeovimException(..),- exceptionToDoc,- FunctionMap,- FunctionMapEntry,- mkFunctionMap,- runNeovim,- err,- errOnInvalidResult,- restart,- quit,-- 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)-import Neovim.Exceptions (NeovimException (..), exceptionToDoc)--import qualified Neovim.Context.Internal as Internal--#if __GLASGOW_HASKELL__ <= 710-import Control.Applicative-#endif--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------ | 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
@@ -1,272 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{- |-Module : Neovim.Context.Internal-Description : Abstract description of the plugin provider's internal context-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC--To shorten function and data type names, import this qualfied as @Internal@.--}-module Neovim.Context.Internal- where--import Neovim.Classes-import Neovim.Exceptions (NeovimException (..),- exceptionToDoc)-import Neovim.Plugin.Classes-import Neovim.Plugin.IPC (SomeMessage)--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 System.Log.Logger-import UnliftIO--import Data.Text.Prettyprint.Doc (viaShow)--import qualified Control.Monad.Fail as Fail-import Prelude----- | This is the environment in which all plugins are initially started.------ Functions have to run in this transformer stack to communicate with neovim.--- If parts of your own functions dont need to communicate with neovim, it is--- good practice to factor them out. This allows you to write tests and spot--- errors easier. Essentially, you should treat this similar to 'IO' in general--- haskell programs.-newtype Neovim env a = Neovim- { unNeovim :: ResourceT (ReaderT (Config env) IO) a }-- deriving (Functor, Applicative, Monad, MonadIO- , MonadThrow, MonadUnliftIO)----- | User facing instance declaration for the reader state.-instance MonadReader env (Neovim env) where- ask = Neovim $ asks customConfig- local f (Neovim a) = do- r <- Neovim ask- liftIO $ runReaderT (runResourceT a)- (r { customConfig = f (customConfig r)})---instance MonadResource (Neovim env) where- liftResourceT m = Neovim $ liftResourceT m---instance Fail.MonadFail (Neovim env) where- fail = throwIO . ErrorMessage . pretty----- | Same as 'ask' for the 'InternalConfig'.-ask' :: Neovim env (Config env)-ask' = Neovim ask----- | Same as 'asks' for the 'InternalConfig'.-asks' :: (Config env -> a) -> Neovim env a-asks' = Neovim . asks---exceptionHandlers :: [Handler IO (Either (Doc ann) a)]-exceptionHandlers =- [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)"- , Handler $ \(_ :: ArrayException) -> ret "ArrayException"- , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error"- , Handler $ \(_ :: PatternMatchFail) -> ret "Pattern match failure"- , Handler $ \(_ :: SomeException) -> ret "Unhandled exception"- ]- where- ret = return . Left---- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.-runNeovim :: NFData a- => Config env- -> Neovim env a- -> IO (Either (Doc AnsiStyle) a)-runNeovim = runNeovimInternal (\a -> a `deepseq` return a)--runNeovimInternal :: (a -> IO a)- -> Config env- -> Neovim env a- -> IO (Either (Doc AnsiStyle) a)-runNeovimInternal f r (Neovim a) =- (try . runReaderT (runResourceT a)) r >>= \case- Left e -> case fromException e of- Just e' ->- return . Left . exceptionToDoc $ (e' :: NeovimException)-- Nothing -> do- liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e- (return . Left . viaShow) e- Right res ->- (Right <$> f res) `catches` exceptionHandlers----- | Create a new unique function name. To prevent possible name clashes, digits--- are stripped from the given suffix.-newUniqueFunctionName :: Neovim env FunctionName-newUniqueFunctionName = do- 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- u <- readTVar tu- modifyTVar' tu succ- return u----- | This data type is used to dispatch a remote function call to the appopriate--- recipient.-newtype FunctionType = Stateful (TQueue SomeMessage)- -- ^ 'Stateful' functions are handled within a special thread, the 'TQueue'- -- is the communication endpoint for the arguments we have to pass.---instance Pretty FunctionType where- pretty = \case- Stateful _ -> "\\os -> Neovim env o"----- | Type of the values stored in the function map.-type FunctionMapEntry = (FunctionalityDescription, FunctionType)----- | A function map is a map containing the names of functions as keys and some--- context dependent value which contains all the necessary information to--- execute that function in the intended way.------ This type is only used internally and handles two distinct cases. One case--- is a direct function call, wich is simply a function that accepts a list of--- 'Object' values and returns a result in the 'Neovim' context. The second--- case is calling a function that has a persistent state. This is mediated to--- a thread that reads from a 'TQueue'. (NB: persistent currently means, that--- state is stored for as long as the plugin provider is running and not--- restarted.)-type FunctionMap = Map NvimMethod FunctionMapEntry----- | Create a new function map from the given list of 'FunctionMapEntry' values.-mkFunctionMap :: [FunctionMapEntry] -> FunctionMap-mkFunctionMap = Map.fromList . map (\e -> (nvimMethod (fst e), e))----- | A wrapper for a reader value that contains extra fields required to--- communicate with the messagepack-rpc components and provide necessary data to--- provide other globally available operations.------ Note that you most probably do not want to change the fields prefixed with an--- underscore.-data Config env = Config- -- Global settings; initialized once- { eventQueue :: TQueue SomeMessage- -- ^ A queue of messages that the event handler will propagate to- -- appropriate threads and handlers.-- , transitionTo :: MVar StateTransition- -- ^ The main thread will wait for this 'MVar' to be filled with a value- -- and then perform an action appropriate for the value of type- -- 'StateTransition'.-- , providerName :: TMVar (Either String Int)- -- ^ Since nvim-hs must have its "Neovim.RPC.SocketReader" and- -- "Neovim.RPC.EventHandler" running to determine the actual channel id- -- (i.e. the 'Int' value here) this field can only be set properly later.- -- Hence, the value of this field is put in an 'TMVar'.- -- Name that is used to identify this provider. Assigning such a name is- -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).-- , uniqueCounter :: TVar Integer- -- ^ This 'TVar' is used to generate uniqe function names on the side of- -- /nvim-hs/. This is useful if you don't want to overwrite existing- -- functions or if you create autocmd functions.-- , globalFunctionMap :: TMVar FunctionMap- -- ^ This map is used to dispatch received messagepack function calls to- -- it's appropriate targets.-- -- Local settings; intialized for each stateful component- , pluginSettings :: Maybe (PluginSettings env)- -- ^ In a registered functionality this field contains a function (and- -- possibly some context dependent values) to register new functionality.-- , customConfig :: env- -- ^ Plugin author supplyable custom configuration. Queried on the- -- user-facing side with 'ask' or 'asks'.- }----- | Convenient helper to create a new config for the given state and read-only--- config.------ Sets the 'pluginSettings' field to 'Nothing'.-retypeConfig :: env -> Config anotherEnv -> Config env-retypeConfig r cfg = cfg { pluginSettings = Nothing, customConfig = r }----- | This GADT is used to share information between stateless and stateful--- plugin threads since they work fundamentally in the same way. They both--- contain a function to register some functionality in the plugin provider--- as well as some values which are specific to the one or the other context.-data PluginSettings env where- StatefulSettings- :: (FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env (Maybe FunctionMapEntry))- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> PluginSettings env----- | Create a new 'InternalConfig' object by providing the minimal amount of--- necessary information.------ This function should only be called once per /nvim-hs/ session since the--- arguments are shared across processes.-newConfig :: IO (Maybe String) -> IO env -> IO (Config env)-newConfig ioProviderName r = Config- <$> newTQueueIO- <*> newEmptyMVar- <*> (maybe (atomically newEmptyTMVar) (newTMVarIO . Left) =<< ioProviderName)- <*> newTVarIO 100- <*> atomically newEmptyTMVar- <*> pure Nothing- <*> r----- | The state that the plugin provider wants to transition to.-data StateTransition- = Quit- -- ^ Quit the plugin provider.-- | Restart- -- ^ Restart the plugin provider.-- | Failure (Doc AnsiStyle)- -- ^ The plugin provider failed to start or some other error occured.-- | InitSuccess- -- ^ The plugin provider started successfully.-- deriving (Show)-
− library/Neovim/Debug.hs
@@ -1,211 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{- |-Module : Neovim.Debug-Description : Utilities to debug Neovim and nvim-hs functionality-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-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----- | Run a 'Neovim' function.------ This function connects to the socket pointed to by the environment variable--- @$NVIM_LISTEN_ADDRESS@ and executes the command. It does not register itself--- as a real plugin provider, you can simply call neovim-functions from the--- module "Neovim.API.String" this way.------ Tip: If you run a terminal inside a neovim instance, then this variable is--- automatically set.-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."----- | Run a 'Neovim'' function.------ @--- debug' = debug ()--- @------ See documentation for 'debug'.-debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a)-debug' = debug ()---- | Simple datatype storing neccessary information to start, stop and reload a--- set of plugins. This is passed to most of the functions in this module for--- storing state even when the ghci-session has been reloaded.-data NvimHSDebugInstance = NvimHSDebugInstance- { threads :: [Async ()]- , neovimConfig :: NeovimConfig- , internalConfig :: Internal.Config RPCConfig- }---- | This function is intended to be run _once_ in a ghci session that to--- give a REPL based workflow when developing a plugin.------ Note that the dyre-based reload mechanisms, i.e. the--- "Neovim.Plugin.ConfigHelper" plugin, is not started this way.------ To use this in ghci, you simply bind the results to some variables. After--- each reload of ghci, you have to rebind those variables.------ Example:------ @--- λ di <- 'develMain' 'Nothing'------ λ 'runNeovim'' di \$ vim_call_function \"getqflist\" []--- 'Right' ('Right' ('ObjectArray' []))------ λ :r------ λ di <- 'develMain' 'Nothing'--- @------ You can also create a GHCI alias to get rid of most the busy-work:--- @--- :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\"--- @----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----- | Quit a previously started plugin provider.-quitDevelMain :: NvimHSDebugInstance -> IO ()-quitDevelMain NvimHSDebugInstance{internalConfig} =- putMVar (Internal.transitionTo internalConfig) Internal.Quit----- | Restart the development plugin provider.-restartDevelMain- :: NvimHSDebugInstance- -> IO (Maybe NvimHSDebugInstance)-restartDevelMain di = do- quitDevelMain di- develMain (neovimConfig di)----- | Convenience function to run a stateless 'Neovim' function.-runNeovim' :: NFData a- => NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)-runNeovim' NvimHSDebugInstance{internalConfig} =- runNeovim (Internal.retypeConfig () (internalConfig))----- | Print the global function map to the console.-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]--
− library/Neovim/Exceptions.hs
@@ -1,50 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{- |-Module : Neovim.Exceptions-Description : General Exceptions-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Exceptions- ( NeovimException(..)- , exceptionToDoc- ) where--import Control.Exception (Exception)-import Data.MessagePack (Object (..))-import Data.String (IsString (..))-import Data.Text.Prettyprint.Doc (Doc, (<+>), viaShow)-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)-import Data.Typeable (Typeable)---- | Exceptions specific to /nvim-hs/.-data NeovimException- = ErrorMessage (Doc AnsiStyle)- -- ^ Simply error message that is passed to neovim. It should currently only- -- contain one line of text.- | ErrorResult Object- -- ^ Error that can be returned by a remote API call. A call of 'fromObject'- -- on this value could be converted to a value of 'NeovimExceptionGen'.- deriving (Typeable, Show)---instance Exception NeovimException---instance IsString NeovimException where- fromString = ErrorMessage . fromString---exceptionToDoc :: NeovimException -> Doc AnsiStyle-exceptionToDoc = \case- ErrorMessage e ->- "Error message:" <+> e-- ErrorResult o ->- "Result representing an error:" <+> viaShow o-
− library/Neovim/Log.hs
@@ -1,60 +0,0 @@-{- |-Module : Neovim.Log-Description : Logging utilities and reexports-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Log (- disableLogger,- withLogger,-- module System.Log.Logger,- ) where--import Control.Exception-import System.Log.Formatter (simpleLogFormatter)-import System.Log.Handler (setFormatter)-import System.Log.Handler.Simple-import System.Log.Logger---- | Disable logging to stderr.-disableLogger :: IO a -> IO a-disableLogger action = do- updateGlobalLogger rootLoggerName removeHandler- action---- | Initialize the root logger to avoid stderr and set it to log the given--- file instead. Simply wrap the main entry point with this function to--- initialze the logger.------ @--- main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do--- 'putStrLn' "Hello, World!"--- @-withLogger :: FilePath -> Priority -> IO a -> IO a-withLogger fp p action = bracket- setupRootLogger- (\fh -> closeFunc fh (privData fh))- (const action)- where- setupRootLogger = do- -- We shouldn't log to stderr or stdout as it is not unlikely that our- -- messagepack communication is handled via those channels.- disableLogger (return ())- -- Log to the given file instead- fh <- fileHandler fp p- -- Adjust logging format- let fh' = setFormatter fh (simpleLogFormatter "[$loggername : $prio] $msg")- -- Adjust the log level as well- updateGlobalLogger rootLoggerName (setLevel p . addHandler fh')- -- For good measure, log some debug information- logM "Neovim.Debug" DEBUG $- unwords ["Initialized root looger with priority", show p, "and file: ", fp]- return fh'--
− library/Neovim/Main.hs
@@ -1,203 +0,0 @@-{- |-Module : Neovim.Main-Description : Wrapper for the actual main function-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.Main- where--import Neovim.Config-import qualified Neovim.Context.Internal as Internal-import Neovim.Log-import qualified Neovim.Plugin as P-import Neovim.RPC.Common as RPC-import Neovim.RPC.EventHandler-import Neovim.RPC.SocketReader-import Neovim.Util (oneLineErrorMessage)--import Control.Concurrent-import Control.Concurrent.STM (atomically, putTMVar)-import Control.Monad-import Data.Default-import Data.Maybe-import Data.Monoid-import Options.Applicative-import System.IO (stdin, stdout)-import UnliftIO.Async (Async, async)--import Prelude---logger :: String-logger = "Neovim.Main"---data CommandLineOptions =- Opt { providerName :: Maybe String- , hostPort :: Maybe (String, Int)- , unix :: Maybe FilePath- , envVar :: Bool- , logOpts :: Maybe (FilePath, Priority)- }---instance Default CommandLineOptions where- def = Opt- { providerName = Nothing- , hostPort = Nothing- , unix = Nothing- , envVar = False- , logOpts = Nothing- }---optParser :: Parser CommandLineOptions-optParser = Opt- <$> optional (strArgument- (metavar "NAME"- <> help (unlines- [ "Name that associates the plugin provider with neovim."- , "This option has only an effect if you start nvim-hs"- , "with rpcstart()/jobstart() and use the factory method approach."- , "Since it is extremely hard to figure that out inside"- , "nvim-hs, this option is assumed to used if the input"- , "and output is tied to standard in and standard out."- ])))- <*> optional ((,)- <$> strOption- (long "host"- <> short 'a'- <> metavar "HOSTNAME"- <> help "Connect to the specified host. (requires -p)")- <*> option auto- (long "port"- <> short 'p'- <> metavar "PORT"- <> help "Connect to the specified port. (requires -a)"))- <*> optional (strOption- (long "unix"- <> short 'u'- <> help "Connect to the given unix domain socket."))- <*> switch- ( long "environment"- <> short 'e'- <> help "Read connection information from $NVIM_LISTEN_ADDRESS.")- <*> optional ((,)- <$> strOption- (long "log-file"- <> short 'l'- <> help "File to log to.")- <*> option auto- (long "log-level"- <> short 'v'- <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels)))- where- -- [minBound..maxBound] would have been nice here.- logLevels :: [Priority]- logLevels = [ DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY ]---opts :: ParserInfo CommandLineOptions-opts = info (helper <*> optParser)- (fullDesc- <> header "Start a neovim plugin provider for Haskell plugins."- <> progDesc "This is still work in progress. Feel free to contribute.")----- | This is essentially the main function for /nvim-hs/, at least if you want--- to use "Config.Dyre" for the configuration.-neovim :: NeovimConfig -> IO ()-neovim = realMain standalone----- | A 'TransitionHandler' function receives the 'ThreadId's of all running--- threads which have been started by the plugin provider as well as the--- 'Internal.Config' with the custom field set to 'RPCConfig'. These information--- can be used to properly clean up a session and then do something else.--- The transition handler is first called after the plugin provider has started.-type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a----- | This main functions can be used to create a custom executable without--- using the "Config.Dyre" library while still using the /nvim-hs/ specific--- configuration facilities.-realMain :: TransitionHandler a- -> NeovimConfig- -> IO ()-realMain transitionHandler cfg = do- os <- execParser opts- maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do- debugM logger "Starting up neovim haskell plguin provider"- void $ runPluginProvider os (Just cfg) transitionHandler----- | Generic main function. Most arguments are optional or have sane defaults.-runPluginProvider- :: CommandLineOptions -- ^ See /nvim-hs/ executables --help function or 'optParser'- -> Maybe NeovimConfig- -> TransitionHandler a- -> IO a-runPluginProvider os mcfg transitionHandler = case (hostPort os, unix os) of- (Just (h,p), _) ->- createHandle (TCP p h) >>= \s -> run s s-- (_, Just fp) ->- createHandle (UnixSocket fp) >>= \s -> run s s-- _ | envVar os ->- createHandle Environment >>= \s -> run s s-- _ ->- run stdout stdin-- where- run evHandlerHandle sockreaderHandle = do-- -- The plugins to register depend on the given arguments and may need- -- special initialization methods.- let allPlugins = maybe [] plugins mcfg-- conf <- Internal.newConfig (pure (providerName os)) newRPCConfig-- ehTid <- async $ runEventHandler- evHandlerHandle- conf { Internal.pluginSettings = Nothing }-- srTid <- async $ runSocketReader sockreaderHandle conf-- let startupConf = Internal.retypeConfig () conf- P.startPluginThreads startupConf allPlugins >>= \case- Left e -> do- errorM logger $ "Error initializing plugins: " <> show (oneLineErrorMessage e)- putMVar (Internal.transitionTo conf) $ Internal.Failure e- transitionHandler [ehTid, srTid] conf-- Right (funMapEntries, pluginTids) -> do- atomically $ putTMVar- (Internal.globalFunctionMap conf)- (Internal.mkFunctionMap funMapEntries)- putMVar (Internal.transitionTo conf) $ Internal.InitSuccess- transitionHandler (srTid:ehTid:pluginTids) conf---standalone :: TransitionHandler ()-standalone threads cfg = takeMVar (Internal.transitionTo cfg) >>= \case- Internal.InitSuccess -> do- debugM logger "Initialization Successful"- standalone threads cfg-- Internal.Restart -> do- errorM logger "Cannot restart"- standalone threads cfg-- Internal.Failure e ->- errorM logger . show $ oneLineErrorMessage e-- Internal.Quit ->- return ()-
− library/Neovim/Plugin.hs
@@ -1,333 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RecordWildCards #-}-{- |-Module : Neovim.Plugin-Description : Plugin and functionality registration code-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}--module Neovim.Plugin (- startPluginThreads,- wrapPlugin,- NeovimPlugin,- Plugin(..),- Synchronous(..),- CommandOption(..),-- addAutocmd,-- registerPlugin,- ) where--import Neovim.API.String-import Neovim.Classes-import Neovim.Context-import Neovim.Context.Internal (FunctionType (..),- runNeovimInternal)-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes hiding (register)-import Neovim.Plugin.Internal-import Neovim.Plugin.IPC.Classes-import Neovim.RPC.FunctionCall--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.MessagePack-import Data.Traversable (forM)-import System.Log.Logger-import UnliftIO.Async (Async, async, race)-import UnliftIO.Concurrent (threadDelay)-import UnliftIO.Exception (SomeException, try, catch)-import UnliftIO.STM--import Prelude---logger :: String-logger = "Neovim.Plugin"---startPluginThreads :: Internal.Config ()- -> [Neovim () NeovimPlugin]- -> IO (Either (Doc AnsiStyle) ([FunctionMapEntry],[Async ()]))-startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], [])- where- go :: ([FunctionMapEntry], [Async ()])- -> Neovim () NeovimPlugin- -> Neovim () ([FunctionMapEntry], [Async ()])- go (es, tids) iop = do- NeovimPlugin p <- iop- (es', tid) <- registerStatefulFunctionality p-- return $ (es ++ es', tid:tids)----- | Callthe 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/.-registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool-registerWithNeovim = \case- func@(Function (F functionName) s) -> do- pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#FunctionOnHost", toObject n))- (\c -> ("remote#define#FunctionOnChannel", toObject c))- pName- reportError (e :: NeovimException) = do- liftIO . errorM logger $- "Failed to register function: " ++ show functionName ++ show e- return False- logSuccess = do- liftIO . debugM logger $- "Registered function: " ++ show functionName- return True-- flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: []- logSuccess-- cmd@(Command (F functionName) copts) -> do- let sync = case getCommandOptions copts of- -- This works because CommandOptions are sorted and CmdSync is- -- the smallest element in the sorting- (CmdSync s:_) -> s- _ -> Sync-- pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#CommandOnHost", toObject n))- (\c -> ("remote#define#CommandOnChannel", toObject c))- pName- reportError (e :: NeovimException) = do- liftIO . errorM logger $- "Failed to register command: " ++ show functionName ++ show e- return False- logSuccess = do- liftIO . debugM logger $- "Registered command: " ++ show functionName- return True- flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: []- logSuccess-- Autocmd acmdType (F functionName) sync opts -> do- pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#AutocmdOnHost", toObject n))- (\c -> ("remote#define#AutocmdOnChannel", toObject c))- pName- reportError (e :: NeovimException) = do- liftIO . errorM logger $- "Failed to register autocmd: " ++ show functionName ++ show e- return False- logSuccess = do- liftIO . debugM logger $- "Registered autocmd: " ++ show functionName- return True- flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: functionName +: sync +: acmdType +: opts +: []- logSuccess----- | Return or retrive the provider name that the current instance is associated--- with on the neovim side.-getProviderName :: Neovim env (Either String Int)-getProviderName = do- mp <- Internal.asks' Internal.providerName- (liftIO . atomically . tryReadTMVar) mp >>= \case- Just p ->- return p-- Nothing -> do- api <- nvim_get_api_info- case api of- [] -> err "empty nvim_get_api_info"- (i:_) -> do- case fromObject i :: Either (Doc AnsiStyle) Int of- Left _ ->- err $ "Expected an integral value as the first"- <+> "argument of nvim_get_api_info"- Right channelId -> do- liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId- return . Right $ fromIntegral channelId---registerFunctionality :: FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))-registerFunctionality d f = Internal.asks' Internal.pluginSettings >>= \case- Nothing -> do- liftIO $ errorM logger "Cannot register functionality in this context."- return Nothing-- 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)-- 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---registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()-registerInGlobalFunctionMap e = do- liftIO . debugM logger $ "Adding function to global function map." ++ show (fst e)- funMap <- Internal.asks' Internal.globalFunctionMap- liftIO . atomically $ do- m <- takeTMVar funMap- putTMVar funMap $ Map.insert ((nvimMethod . fst) e) e m- liftIO . debugM logger $ "Added function to global function map." ++ show (fst e)--registerPlugin- :: (FunctionMapEntry -> Neovim env ())- -> FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env (Maybe FunctionMapEntry)-registerPlugin reg d f q tm = registerWithNeovim d >>= \case- True -> do- let n = nvimMethod d- e = (d, Stateful q)- liftIO . atomically . modifyTVar tm $ Map.insert n f- reg e- return (Just e)-- False ->- return Nothing----- | Register an autocmd in the current context. This means that, if you are--- currently in a stateful plugin, the function will be called in the current--- thread and has access to the configuration and state of this thread. .------ Note that the function you pass must be fully applied.----addAutocmd :: ByteString- -- ^ The event to register to (e.g. BufWritePost)- -> Synchronous- -> AutocmdOptions- -> (Neovim env ())- -- ^ Fully applied function to register- -> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))- -- ^ A 'ReleaseKey' if the registration worked-addAutocmd event s (opts@AutocmdOptions{}) f = do- n <- newUniqueFunctionName- fmap snd <$> 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).-registerStatefulFunctionality- :: Plugin env- -> Neovim anyEnv ([FunctionMapEntry], Async ())-registerStatefulFunctionality (Plugin { environment = env, exports = fs }) = do- messageQueue <- liftIO newTQueueIO- route <- liftIO $ newTVarIO Map.empty-- cfg <- Internal.ask'-- let startupConfig = cfg- { Internal.customConfig = env- , Internal.pluginSettings = Just $ Internal.StatefulSettings- (registerPlugin (\_ -> return ())) messageQueue route- }- res <- liftIO . runNeovimInternal return startupConfig . forM fs $ \f ->- registerFunctionality (getDescription f) (getFunction f)- es <- case res of- Left e -> err e- Right a -> return $ catMaybes a-- let pluginThreadConfig = cfg- { Internal.customConfig = env- , Internal.pluginSettings = Just $ Internal.StatefulSettings- (registerPlugin registerInGlobalFunctionMap) messageQueue route- }-- tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do- listeningThread messageQueue route-- return (map fst es, tid) -- NB: dropping release functions/keys here--- where- executeFunction- :: ([Object] -> Neovim env Object)- -> [Object]- -> Neovim env (Either String Object)- executeFunction f args = try (f args) >>= \case- Left e -> return . Left $ show (e :: SomeException)- Right res -> return $ Right res-- timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String- timeoutAndLog seconds functionName = do- threadDelay (fromIntegral seconds * 1000 * 1000)- return . show $- pretty functionName <+> "has been aborted after"- <+> pretty seconds <+> "seconds"--- listeningThread :: TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env ()- listeningThread q route = do- msg <- readSomeMessage q-- forM_ (fromMessage msg) $ \req@(Request fun@(F methodName) _ args) -> do- let method = NvimMethod methodName- route' <- liftIO $ readTVarIO route- forM_ (Map.lookup method route') $ \f -> do- respond req . either Left id =<< race- (timeoutAndLog 10 fun)- (executeFunction f args)-- forM_ (fromMessage msg) $ \(Notification fun@(F 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 fun)- (executeFunction f args)- case result of- Left message ->- nvim_err_writeln message- Right _ ->- return ()--- listeningThread q route-
− library/Neovim/Plugin/Classes.hs
@@ -1,473 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveGeneric #-}-{- |-Module : Neovim.Plugin.Classes-Description : Classes and data types related to plugins-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Plugin.Classes (- FunctionalityDescription(..),- FunctionName(..),- NvimMethod(..),- Synchronous(..),- CommandOption(..),- CommandOptions,- RangeSpecification(..),- CommandArguments(..),- getCommandOptions,- mkCommandOptions,- AutocmdOptions(..),- HasFunctionName(..),- ) where--import Neovim.Classes--import Control.Applicative hiding (empty)-import Control.Monad.Error.Class-import Data.ByteString (ByteString)-import Data.Char (isDigit)-import Data.Default-import Data.List (groupBy, sort)-import qualified Data.Map as Map-import Data.Maybe-import Data.MessagePack-import Data.String-import Data.Traversable (sequence)-import Data.Text.Encoding (decodeUtf8)--import Data.Text.Prettyprint.Doc--import Prelude hiding (sequence)----- | Essentially just a string.-newtype FunctionName = F ByteString- deriving (Eq, Ord, Show, Read, Generic)---instance NFData FunctionName---instance Pretty FunctionName where- pretty (F n) = pretty $ decodeUtf8 n----- | Functionality specific functional description entries.------ All fields which are directly specified in these constructors are not--- optional, but can partialy be generated via the Template Haskell functions.--- The last field is a data type that contains all relevant options with--- sensible defaults, hence 'def' can be used as an argument.-data FunctionalityDescription- = Function FunctionName Synchronous- -- ^ Exported function. Callable via @call name(arg1,arg2)@.- --- -- * Name of the function (must start with an uppercase letter)- -- * Option to indicate how neovim should behave when calling this function-- | Command FunctionName CommandOptions- -- ^ Exported Command. Callable via @:Name arg1 arg2@.- --- -- * Name of the command (must start with an uppercase letter)- -- * Options to configure neovim's behavior for calling the command-- | Autocmd ByteString FunctionName Synchronous AutocmdOptions- -- ^ Exported autocommand. Will call the given function if the type and- -- filter match.- --- -- NB: Since we are registering this on the Haskell side of things, the- -- number of accepted arguments should be 0.- --- -- * Type of the autocmd (e.g. \"BufWritePost\")- -- * 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)-- deriving (Show, Read, Eq, Ord, Generic)---instance NFData FunctionalityDescription---instance Pretty FunctionalityDescription where- pretty = \case- Function fname s ->- "Function" <+> pretty s <+> pretty fname-- Command fname copts ->- "Command" <+> pretty copts <+> pretty fname-- Autocmd t fname s aopts ->- "Autocmd" <+> pretty (decodeUtf8 t)- <+> pretty s- <+> pretty aopts- <+> pretty fname----- | This option detemines how neovim should behave when calling some--- functionality on a remote host.-data Synchronous- = Async- -- ^ Call the functionality entirely for its side effects and do not wait- -- for it to finish. Calling a functionality with this flag set is- -- completely asynchronous and nothing is really expected to happen. This- -- is why a call like this is called notification on the neovim side of- -- things.-- | Sync- -- ^ Call the function and wait for its result. This is only synchronous on- -- the neovim side. This means that the GUI will (probably) not- -- allow any user input until a reult is received.- deriving (Show, Read, Eq, Ord, Enum, Generic)--instance NFData Synchronous--instance Pretty Synchronous where- pretty = \case- Async -> "async"- Sync -> "sync"---instance IsString Synchronous where- fromString = \case- "sync" -> Sync- "async" -> Async- _ -> error "Only \"sync\" and \"async\" are valid string representations"---instance NvimObject Synchronous where- toObject = \case- Async -> toObject False- Sync -> toObject True-- fromObject = \case- ObjectBool True -> return Sync- ObjectBool False -> return Async- ObjectInt 0 -> return Async- _ -> return Sync----- | Options for commands.------ Some command can also be described by using the OverloadedString extensions.--- This means that you can write a literal 'String' inside your source file in--- place for a 'CommandOption' value. See the documentation for each value on--- how these strings should look like (Both versions are compile time checked.)-data CommandOption = CmdSync Synchronous- -- ^ Stringliteral "sync" or "async"-- | CmdRegister- -- ^ Register passed to the command.- --- -- Stringliteral: @\"\\\"\"@-- | CmdNargs String- -- ^ Command takes a specific amount of arguments- --- -- Automatically set via template haskell functions. You- -- really shouldn't use this option yourself unless you have- -- to.-- | CmdRange RangeSpecification- -- ^ Determines how neovim passes the range.- --- -- Stringliterals: \"%\" for 'WholeFile', \",\" for line- -- and \",123\" for 123 lines.-- | CmdCount Word- -- ^ Command handles a count. The argument defines the- -- default count.- --- -- Stringliteral: string of numbers (e.g. "132")-- | CmdBang- -- ^ Command handles a bang- --- -- Stringliteral: \"!\"-- | CmdComplete String- -- ^ Verbatim string passed to the @-complete=@ command attribute- deriving (Eq, Ord, Show, Read, Generic)--instance NFData CommandOption---instance Pretty CommandOption where- pretty = \case- CmdSync s ->- pretty s-- CmdRegister ->- "\""-- CmdNargs n ->- pretty n-- CmdRange rs ->- pretty rs-- CmdCount c ->- pretty c-- CmdBang ->- "!"-- CmdComplete cs ->- pretty cs---instance IsString CommandOption where- fromString = \case- "%" -> CmdRange WholeFile- "\"" -> CmdRegister- "!" -> CmdBang- "sync" -> CmdSync Sync- "async" -> CmdSync Async- "," -> CmdRange CurrentLine- ',':ds | not (null ds) && all isDigit ds -> CmdRange (read ds)- ds | not (null ds) && all isDigit ds -> CmdCount (read ds)- _ -> error "Not a valid string for a CommandOptions. Check the docs!"---- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed--- object of this type is sorted and only contains zero or one object for each--- possible option.-newtype CommandOptions = CommandOptions { getCommandOptions :: [CommandOption] }- deriving (Eq, Ord, Show, Read, Generic)--instance NFData CommandOptions--instance Pretty CommandOptions where- pretty (CommandOptions os) =- cat $ map pretty os---- | Smart constructor for 'CommandOptions'. This sorts the command options and--- removes duplicate entries for semantically the same thing. Note that the--- smallest option stays for whatever ordering is defined. It is best to simply--- not define the same thing multiple times.-mkCommandOptions :: [CommandOption] -> CommandOptions-mkCommandOptions = CommandOptions . map head . groupBy constructor . sort- where- constructor a b = case (a,b) of- _ | a == b -> True- -- Only CmdSync and CmdNargs may fail for the equality check,- -- so we just have to check those.- (CmdSync _, CmdSync _) -> True- (CmdRange _, CmdRange _) -> True- -- Range and conut are mutually recursive.- -- XXX Actually '-range=N' and '-count=N' are, but the code in- -- remote#define#CommandOnChannel treats it exclusive as a whole.- -- (see :h :command-range)- (CmdRange _, CmdCount _) -> True- (CmdNargs _, CmdNargs _) -> True- _ -> False---instance NvimObject CommandOptions where- toObject (CommandOptions opts) =- (toObject :: Dictionary -> Object) . Map.fromList $ mapMaybe addOption opts- where- addOption = \case- CmdRange r -> Just ("range" , toObject r)- CmdCount n -> Just ("count" , toObject n)- CmdBang -> Just ("bang" , ObjectBinary "")- CmdRegister -> Just ("register", ObjectBinary "")- CmdNargs n -> Just ("nargs" , toObject n)- CmdComplete cs -> Just ("complete", toObject cs)- _ -> Nothing-- fromObject o = throwError $- "Did not expect to receive a CommandOptions object:" <+> viaShow o----- | Specification of a range that acommand can operate on.-data RangeSpecification- = CurrentLine- -- ^ The line the cursor is at when the command is invoked.-- | WholeFile- -- ^ Let the command operate on every line of the file.-- | RangeCount Int- -- ^ Let the command operate on each line in the given range.-- deriving (Eq, Ord, Show, Read, Generic)--instance NFData RangeSpecification--instance Pretty RangeSpecification where- pretty = \case- CurrentLine ->- mempty-- WholeFile ->- "%"-- RangeCount c ->- pretty c---instance NvimObject RangeSpecification where- toObject = \case- CurrentLine -> ObjectBinary ""- WholeFile -> ObjectBinary "%"- RangeCount n -> toObject n-- fromObject o = throwError $- "Did not expect to receive a RangeSpecification object:" <+> viaShow o----- | You can use this type as the first argument for a function which is--- intended to be exported as a command. It holds information about the special--- attributes a command can take.-data CommandArguments = CommandArguments- { 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)---instance NFData CommandArguments---instance Pretty CommandArguments where- pretty CommandArguments{..} =- cat $ catMaybes- [ (\b -> if b then "!" else mempty) <$> bang- , (\(s,e) -> lparen <> pretty s <> comma- <+> pretty e <> rparen)- <$> range- , pretty <$> count- , pretty <$> register- ]--instance Default CommandArguments where- def = CommandArguments- { bang = Nothing- , range = Nothing- , count = Nothing- , register = Nothing- }----- XXX This instance is used as a bit of a hack, so that I don't have to write--- special code handling in the code generator and "Neovim.RPC.SocketReader".-instance NvimObject CommandArguments where- toObject CommandArguments{..} = (toObject :: Dictionary -> Object)- . Map.fromList . catMaybes $- [ bang >>= \b -> return ("bang", toObject b)- , range >>= \r -> return ("range", toObject r)- , count >>= \c -> return ("count", toObject c)- , register >>= \r -> return ("register", toObject r)- ]-- fromObject (ObjectMap m) = do- let l key = sequence (fromObject <$> Map.lookup (ObjectBinary key) m)- bang <- l "bang"- range <- l "range"- count <- l "count"- register <- l "register"- return CommandArguments{..}-- fromObject ObjectNil = return def- fromObject o =- throwError $ "Expected a map for CommandArguments object, but got: "- <+> viaShow o----- | Options that can be used to register an autocmd. See @:h :autocmd@ or any--- referenced neovim help-page from the fields of this data type.-data AutocmdOptions = AutocmdOptions- { 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)---instance NFData AutocmdOptions---instance Pretty AutocmdOptions where- pretty AutocmdOptions{..} =- pretty acmdPattern- <+> if acmdNested then "nested" else "unnested"- <> maybe mempty (\g -> mempty <+> pretty g) acmdGroup---instance Default AutocmdOptions where- def = AutocmdOptions- { acmdPattern = "*"- , acmdNested = False- , acmdGroup = Nothing- }---instance NvimObject AutocmdOptions where- toObject AutocmdOptions{..} =- (toObject :: Dictionary -> Object) . Map.fromList $- [ ("pattern", toObject acmdPattern)- , ("nested", toObject acmdNested)- ] ++ catMaybes- [ acmdGroup >>= \g -> return ("group", toObject g)- ]- fromObject o = throwError $- "Did not expect to receive an AutocmdOptions object: " <+> viaShow o--newtype NvimMethod =- NvimMethod { nvimMethodName :: ByteString }- deriving (Eq, Ord, Show, Read, Generic)---instance NFData NvimMethod---instance Pretty NvimMethod where- pretty (NvimMethod n) = pretty $ decodeUtf8 n----- | Conveniennce class to extract a name from some value.-class HasFunctionName a where- name :: a -> FunctionName- nvimMethod :: a -> NvimMethod---instance HasFunctionName FunctionalityDescription where- name = \case- Function n _ -> n- Command n _ -> n- Autocmd _ n _ _ -> n-- nvimMethod = \case- Function (F n) _ -> NvimMethod $ n <> ":function"- Command (F n) _ -> NvimMethod $ n <> ":command"- Autocmd _ (F n) _ _ -> NvimMethod n
− library/Neovim/Plugin/IPC.hs
@@ -1,20 +0,0 @@-{- |-Module : Neovim.Plugin.IPC-Description : Communication between Haskell processes/threads-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental--This module reexports publicly available means to communicate between different-plugins (or more generally threads running in the same plugin provider).--}-module Neovim.Plugin.IPC (- SomeMessage(..),- fromMessage,-- ) where--import Neovim.Plugin.IPC.Classes-
− library/Neovim/Plugin/IPC/Classes.hs
@@ -1,142 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RecordWildCards #-}-{- |-Module : Neovim.Plugin.IPC.Classes-Description : Classes used for Inter Plugin Communication-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Plugin.IPC.Classes (- SomeMessage(..),- Message(..),- FunctionCall(..),- Request(..),- Notification(..),- writeMessage,- readSomeMessage,-- UTCTime,- getCurrentTime,-- module Data.Int,- ) where--import Neovim.Classes-import Neovim.Plugin.Classes (FunctionName)--import Control.Exception (evaluate)-import Control.Concurrent.STM-import Control.Monad.IO.Class (MonadIO(..))-import Data.Data (Typeable, cast)-import Data.Int (Int64)-import Data.MessagePack-import Data.Time (UTCTime, formatTime, getCurrentTime)-import Data.Time.Locale.Compat (defaultTimeLocale)-import Data.Text.Prettyprint.Doc (nest, hardline, viaShow)--import Prelude---- | Taken from xmonad and based on ideas in /An Extensible Dynamically-Typed--- Hierarchy of Exceptions/, Simon Marlow, 2006.------ User-extensible messages must be put into a value of this type, so that it--- can be sent to other plugins.-data SomeMessage = forall msg. Message msg => SomeMessage msg----- | This class allows type safe casting of 'SomeMessage' to an actual message.--- The cast is successful if the type you're expecting matches the type in the--- 'SomeMessage' wrapper. This way, you can subscribe to an arbitrary message--- type withouth having to pattern match on the constructors. This also allows--- plugin authors to create their own message types without having to change the--- core code of /nvim-hs/.-class (NFData message, Typeable message) => Message message where- -- | Try to convert a given message to a value of the message type we are- -- interested in. Will evaluate to 'Nothing' for any other type.- fromMessage :: SomeMessage -> Maybe message- fromMessage (SomeMessage message) = cast message--writeMessage :: (MonadIO m, Message message) => TQueue SomeMessage -> message -> m ()-writeMessage q message = liftIO $ do- evaluate (rnf message)- atomically $ writeTQueue q (SomeMessage message)--readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage-readSomeMessage q = liftIO $ atomically (readTQueue q)---- | Haskell representation of supported Remote Procedure Call messages.-data FunctionCall- = FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime- -- ^ Method name, parameters, callback, timestamp- deriving (Typeable, Generic)--instance NFData FunctionCall where- rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` ()--instance Message FunctionCall---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----- | 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.-data Request = Request- { reqMethod :: FunctionName- -- ^ Name of the function to call.- , reqId :: !Int64- -- ^ Identifier to map the result to a function call invocation.- , reqArgs :: [Object]- -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable, Generic)---instance NFData Request---instance Message Request---instance Pretty Request where- pretty Request{..} =- nest 2 $ "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--- message is sent by neovim if the caller there does not care about the result--- of the computation.-data Notification = Notification- { notMethod :: FunctionName- -- ^ Name of the function to call.- , notArgs :: [Object]- -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable, Generic)---instance NFData Notification---instance Message Notification---instance Pretty Notification where- pretty Notification{..} =- nest 2 $ "Notification"- <> hardline <> "Method:" <+> pretty notMethod- <> hardline <> "Arguments:" <+> viaShow notArgs-
− library/Neovim/Plugin/Internal.hs
@@ -1,65 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-{- |-Module : Neovim.Plugin.Internal-Description : Split module that can import Neovim.Context without creating import circles-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Plugin.Internal (- ExportedFunctionality(..),- getFunction,- getDescription,- NeovimPlugin(..),- Plugin(..),- wrapPlugin,- ) where--import Neovim.Context-import Neovim.Plugin.Classes--import Data.MessagePack----- | This data type is used in the plugin registration to properly register the--- functions.-newtype ExportedFunctionality env- = EF (FunctionalityDescription, [Object] -> Neovim env Object)----- | Extract the description of an 'ExportedFunctionality'.-getDescription :: ExportedFunctionality env -> FunctionalityDescription-getDescription (EF (d,_)) = d----- | Extract the function of an 'ExportedFunctionality'.-getFunction :: ExportedFunctionality env -> [Object] -> Neovim env Object-getFunction (EF (_, f)) = f---instance HasFunctionName (ExportedFunctionality env) where- name = name . getDescription- nvimMethod = nvimMethod . getDescription----- | This data type contains meta information for the plugin manager.----data Plugin env = Plugin- { environment :: env- , exports :: [ExportedFunctionality env]- }----- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that--- we can put plugins in an ordinary list.-data NeovimPlugin = forall env. NeovimPlugin (Plugin env)----- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple--- list.-wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin-wrapPlugin = pure . NeovimPlugin
− library/Neovim/Quickfix.hs
@@ -1,206 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveGeneric #-}-{- |-Module : Neovim.Quickfix-Description : API for interacting with the quickfix list-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Quickfix- where--import Control.Applicative-import Control.Monad (void)-import Data.ByteString as BS (ByteString, all, elem)-import qualified Data.Map as Map-import Data.Maybe-import Data.MessagePack-import Data.Monoid-import Neovim.API.String-import Neovim.Classes-import Neovim.Context-import Data.Text.Prettyprint.Doc (viaShow)--import Prelude---- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any--- string that you can append to (hence 'Monoid') that is also an instance--- of 'NvimObject'. You can e.g. use the plain old 'String'.-setqflist :: (Monoid strType, NvimObject strType)- => [QuickfixListItem strType]- -> QuickfixAction- -> Neovim env ()-setqflist qs a =- void $ vim_call_function "setqflist" $ qs +: a +: []--data ColumnNumber- = VisualColumn Int- | ByteIndexColumn Int- | NoColumn- deriving (Eq, Ord, Show, Generic)---instance NFData ColumnNumber--data SignLocation strType- = LineNumber Int- | SearchPattern strType- deriving (Eq, Ord, Show, Generic)---instance (NFData strType) => NFData (SignLocation strType)----- | Quickfix list item. The parameter names should mostly conform to those in--- @:h setqflist()@. Some fields are merged to explicitly state mutually--- exclusive elements or some other behavior of the fields.------ see 'quickfixListItem' for creating a value of this type without typing too--- much.-data QuickfixListItem strType = QFItem- { bufOrFile :: Either Int strType- -- ^ Since the filename is only used if no buffer can be specified, this- -- field is a merge of @bufnr@ and @filename@.-- , lnumOrPattern :: Either Int strType- -- ^ Line number or search pattern to locate the error.-- , col :: ColumnNumber- -- ^ A tuple of a column number and a boolean indicating which kind of- -- indexing should be used. 'True' means that the visual column should be- -- used. 'False' means to use the byte index.-- , nr :: Maybe Int- -- ^ Error number.-- , text :: strType- -- ^ Description of the error.-- , errorType :: QuickfixErrorType- -- ^ Type of error.- } deriving (Eq, Show, Generic)---instance (NFData strType) => NFData (QuickfixListItem strType)----- | Simple error type enum.-data QuickfixErrorType = Warning | Error- deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)---instance NFData QuickfixErrorType---instance NvimObject QuickfixErrorType where- toObject = \case- Warning -> ObjectBinary "W"- Error -> ObjectBinary "E"-- fromObject o = case fromObject o :: Either (Doc AnsiStyle) String of- Right "W" -> return Warning- Right "E" -> return Error- _ -> return Error----- | Create a 'QuickfixListItem' by providing the minimal amount of arguments--- needed.-quickfixListItem :: (Monoid strType)- => Either Int strType -- ^ buffer of file name- -> Either Int strType -- ^ line number or pattern- -> QuickfixListItem strType-quickfixListItem bufferOrFile lineOrPattern = QFItem- { bufOrFile = bufferOrFile- , lnumOrPattern = lineOrPattern- , col = NoColumn- , nr = Nothing- , text = mempty- , errorType = Error- }---instance (Monoid strType, NvimObject strType)- => NvimObject (QuickfixListItem strType) where- toObject QFItem{..} =- (toObject :: Map.Map ByteString Object -> Object) . Map.fromList $- [ either (\b -> ("bufnr", toObject b))- (\f -> ("filename", toObject f))- bufOrFile- , either (\l -> ("lnum", toObject l))- (\p -> ("pattern", toObject p))- lnumOrPattern- , ("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) ]- ]-- fromObject objectMap@(ObjectMap _) = do- m <- fromObject objectMap- let l :: NvimObject o => ByteString -> Either (Doc AnsiStyle) o- l key = case Map.lookup key m of- Just o -> fromObject o- Nothing -> throwError $ "Key not found."- bufOrFile <- case (l "bufnr", l "filename") of- (Right b, _) -> return $ Left b- (_, Right f) -> return $ Right f- _ -> throwError $ "No buffer number or file name inside quickfix list item."- lnumOrPattern <- case (l "lnum", l "pattern") of- (Right lnum, _) -> return $ Left lnum- (_, Right pat) -> return $ Right pat- _ -> throwError $ "No line number or search pattern inside quickfix list item."- let l' :: NvimObject o => ByteString -> Either (Doc AnsiStyle) (Maybe o)- l' key = case Map.lookup key m of- Just o -> Just <$> fromObject o- Nothing -> return Nothing- nr <- l' "nr" >>= \case- Just 0 -> return Nothing- nr' -> return nr'- c <- l' "col"- v <- l' "vcol"- let col = maybe NoColumn id $ do- c' <- c- v' <- v- case (c',v') of- (0, _) -> return $ NoColumn- (_, True) -> return $ VisualColumn c'- (_, False) -> return $ ByteIndexColumn c'- text <- fromMaybe mempty <$> l' "text"- errorType <- fromMaybe Error <$> l' "type"- return QFItem{..}-- fromObject o = throwError $ "Could not deserialize QuickfixListItem,"- <+> "expected a map but received:"- <+> viaShow o---data QuickfixAction- = Append -- ^ Add items to the current list (or create a new one if none exists).- | Replace -- ^ Replace current list (or create a new one if none exists).- | New -- ^ Create a new list.- deriving (Eq, Ord, Enum, Bounded, Show, Generic)---instance NFData QuickfixAction---instance NvimObject QuickfixAction where- toObject = \case- Append -> ObjectBinary "a"- Replace -> ObjectBinary "r"- New -> ObjectBinary ""-- fromObject o = case fromObject o of- Right "a" -> return Append- Right "r" -> return Replace- Right s | BS.all (`BS.elem` " \t\n\r") s -> return New- _ -> Left "Could not convert to QuickfixAction"-
− library/Neovim/RPC/Classes.hs
@@ -1,114 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}-{- |-Module : Neovim.RPC.Classes-Description : Data types and classes for the RPC components-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC--Import this module qualified as @MsgpackRPC@--}-module Neovim.RPC.Classes- ( Message (..),- ) where--import Neovim.Classes-import Neovim.Plugin.Classes (FunctionName (..))-import qualified Neovim.Plugin.IPC.Classes as IPC--import Control.Applicative-import Control.Monad.Error.Class-import Data.Data (Typeable)-import Data.MessagePack (Object (..))--import Data.Text.Prettyprint.Doc (hardline, nest, viaShow)--import Prelude---- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for--- details about the msgpack rpc specification.-data Message- = Request IPC.Request- -- ^ Request in the sense of the msgpack rpc specification- --- -- Parameters- -- * Message identifier that has to be put in the response to this request- -- * Function name- -- * Function arguments-- | Response !Int64 (Either Object Object)- -- ^ Response in the sense of the msgpack rpc specifcation- --- -- Parameters- -- * Mesage identifier which matches a request- -- * 'Either' an error 'Object' or a result 'Object'-- | Notification IPC.Notification- -- ^ Notification in the sense of the msgpack rpc specification- deriving (Eq, Ord, Show, Typeable, Generic)---instance NFData Message---instance IPC.Message Message---instance NvimObject Message where- toObject = \case- Request (IPC.Request (F m) i ps) ->- ObjectArray $ (0 :: Int64) +: i +: m +: ps +: []-- Response i (Left e) ->- ObjectArray $ (1 :: Int64) +: i +: e +: () +: []-- Response i (Right r) ->- ObjectArray $ (1 :: Int64) +: i +: () +: r +: []-- Notification (IPC.Notification (F m) ps) ->- ObjectArray $ (2 :: Int64) +: m +: ps +: []--- fromObject = \case- ObjectArray [ObjectInt 0, i, m, ps] -> do- r <- IPC.Request- <$> (fmap F (fromObject m))- <*> fromObject i- <*> fromObject ps- return $ Request r-- ObjectArray [ObjectInt 1, i, e, r] ->- let eer = case e of- ObjectNil -> Right r- _ -> Left e- in Response <$> fromObject i- <*> pure eer-- ObjectArray [ObjectInt 2, m, ps] -> do- n <- IPC.Notification- <$> (fmap F (fromObject m))- <*> fromObject ps- return $ Notification n-- o ->- throwError $ "Not a known/valid msgpack-rpc message:" <+> viaShow o---instance Pretty Message where- pretty = \case- Request request ->- pretty request-- Response i ret ->- nest 2 $ "Response" <+> "#" <> pretty i- <> hardline <> either viaShow viaShow ret-- Notification notification ->- pretty notification--
− library/Neovim/RPC/Common.hs
@@ -1,117 +0,0 @@-{-# LANGUAGE RankNTypes #-}-{- |-Module : Neovim.RPC.Common-Description : Common functons for the RPC module-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.RPC.Common- where--import Neovim.Context--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.Environment (getEnv)-import System.IO (BufferMode (..), Handle, IOMode(ReadWriteMode),- hClose, hSetBuffering)-import System.Log.Logger--import Prelude----- | Things shared between the socket reader and the event handler.-data RPCConfig = RPCConfig- { recipients :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))- -- ^ 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)---- | 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_LISTEN_ADDRESS@.- | 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.---- | Create a 'Handle' from the given socket description.------ The handle is not automatically closed.-createHandle :: (Functor io, MonadIO io)- => SocketType- -> io Handle-createHandle = \case- Stdout h -> do- liftIO $ hSetBuffering h (BlockBuffering Nothing)- return h-- UnixSocket f ->- createHandle . Stdout =<< createUnixSocketHandle f-- TCP p h ->- createHandle . Stdout =<< createTCPSocketHandle p h-- Environment ->- createHandle . Stdout =<< createSocketHandleFromEnvironment-- where- createUnixSocketHandle :: (MonadIO io) => FilePath -> io Handle- createUnixSocketHandle f =- liftIO $ getSocketUnix f >>= flip socketToHandle ReadWriteMode-- createTCPSocketHandle :: (MonadIO io) => Int -> String -> io Handle- createTCPSocketHandle p h = liftIO $ getSocketTCP (fromString h) p- >>= flip socketToHandle ReadWriteMode . fst-- createSocketHandleFromEnvironment = do- listenAddress <- liftIO (getEnv "NVIM_LISTEN_ADDRESS")- case words listenAddress of- [unixSocket] -> createHandle (UnixSocket unixSocket)- [h,p] -> createHandle (TCP (read p) h)- _ -> do- let errMsg = unlines- [ "Unhandled socket type from environment variable: "- , "\t" <> listenAddress- ]- liftIO $ errorM "createHandle" errMsg- error errMsg----- | Close the handle and print a warning if the conduit chain has been--- interrupted prematurely.-cleanUpHandle :: (MonadIO io) => Handle -> Bool -> io ()-cleanUpHandle h completed = liftIO $ do- hClose h- unless completed $- warningM "cleanUpHandle" "Cleanup called on uncompleted handle."
− library/Neovim/RPC/EventHandler.hs
@@ -1,107 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{- |-Module : Neovim.RPC.EventHandler-Description : Event handling loop-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.RPC.EventHandler (- runEventHandler,- ) where--import Neovim.Classes-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.IPC.Classes-import qualified Neovim.RPC.Classes as MsgpackRPC-import Neovim.RPC.Common-import Neovim.RPC.FunctionCall--import Control.Applicative-import Control.Concurrent.STM hiding (writeTQueue)-import Control.Monad.Reader-import Control.Monad.Trans.Resource-import Data.ByteString (ByteString)-import Conduit as C-import qualified Data.Map as Map-import Data.Serialize (encode)-import System.IO (Handle)-import System.Log.Logger--import Prelude----- | This function will establish a connection to the given socket and write--- msgpack-rpc requests to it.-runEventHandler :: Handle- -> Internal.Config RPCConfig- -> IO ()-runEventHandler writeableHandle env =- runEventHandlerContext env . runConduit $ do- eventHandlerSource- .| eventHandler- .| (sinkHandleFlush writeableHandle)----- | Convenient monad transformer stack for the event handler-newtype EventHandler a =- EventHandler (ResourceT (ReaderT (Internal.Config RPCConfig) IO) a)- deriving ( Functor, Applicative, Monad, MonadIO- , MonadReader (Internal.Config RPCConfig))---runEventHandlerContext- :: Internal.Config RPCConfig -> EventHandler a -> IO a-runEventHandlerContext env (EventHandler a) =- runReaderT (runResourceT a) env---eventHandlerSource :: ConduitT () SomeMessage EventHandler ()-eventHandlerSource = asks Internal.eventQueue >>= \q ->- forever $ yield =<< readSomeMessage q---eventHandler :: ConduitM SomeMessage EncodedResponse EventHandler ()-eventHandler = await >>= \case- Nothing ->- return () -- i.e. close the conduit -- TODO signal shutdown globally-- Just message -> do- handleMessage (fromMessage message, fromMessage message)- eventHandler---type EncodedResponse = C.Flush ByteString--yield' :: (MonadIO io) => MsgpackRPC.Message -> ConduitM i EncodedResponse io ()-yield' o = do- liftIO . debugM "EventHandler" $ "Sending: " ++ show o- yield . Chunk . encode $ toObject o- yield Flush--handleMessage :: (Maybe FunctionCall, Maybe MsgpackRPC.Message)- -> ConduitM i EncodedResponse EventHandler ()-handleMessage = \case- (Just (FunctionCall fn params reply time), _) -> do- cfg <- asks (Internal.customConfig)- messageId <- atomically' $ do- i <- readTVar (nextMessageId cfg)- modifyTVar' (nextMessageId cfg) succ- modifyTVar' (recipients cfg) $ Map.insert i (time, reply)- return i- yield' $ MsgpackRPC.Request (Request fn messageId params)-- (_, Just r@MsgpackRPC.Response{}) ->- yield' r-- (_, Just n@MsgpackRPC.Notification{}) ->- yield' n-- _ ->- return () -- i.e. skip to next message-
− library/Neovim/RPC/FunctionCall.hs
@@ -1,135 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{- |-Module : Neovim.RPC.FunctionCall-Description : Functions for calling functions-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.RPC.FunctionCall (- acall,- acall',- scall,- scall',- scallThrow,- atomically',- wait,- wait',- respond,- ) where--import Neovim.Classes-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes (FunctionName)-import Neovim.Plugin.IPC.Classes-import qualified Neovim.RPC.Classes as MsgpackRPC--import Control.Applicative-import Control.Concurrent.STM-import Control.Monad.Reader-import Data.MessagePack-import UnliftIO.Exception (throwIO)--import Prelude---- | Simply fail and call 'error' in case an unexpected exception is thrown.--- This fails with a runtime exception. It is used by the Template Haskell API--- generator for functions that are defined as not being able to fail. If this--- exception occurs, it is a bug in neovim.-unexpectedException :: String -> err -> a-unexpectedException fn _ = error $- "Function threw an exception even though it was declared not to throw one: "- ++ fn----- | Strip the error result from the function call. This should only be used by--- the Template Haskell API generated code for functions that declare--- themselves as unfailable.-withIgnoredException :: (Functor f)- => FunctionName -- ^ For better error messages- -> f (Either err result)- -> f result-withIgnoredException fn = fmap (either ((unexpectedException . show) fn) id)----- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result.-acall :: (NvimObject result)- => FunctionName- -> [Object]- -> Neovim env (STM (Either NeovimException result))-acall fn parameters = do- q <- Internal.asks' Internal.eventQueue- mv <- liftIO newEmptyTMVarIO- timestamp <- liftIO getCurrentTime- writeMessage q $ FunctionCall fn parameters mv timestamp- return $ convertObject <$> readTMVar mv- where- convertObject :: (NvimObject result)- => Either Object Object -> Either NeovimException result- convertObject = \case- Left e -> Left $ ErrorResult e- Right o -> case fromObject o of- Left e -> Left $ ErrorMessage e- Right r -> Right r---- | Helper function similar to 'acall' that throws a runtime exception if the--- result is an error object.-acall' :: (NvimObject result)- => FunctionName- -> [Object]- -> Neovim env (STM result)-acall' fn parameters = withIgnoredException fn <$> acall fn parameters----- | Call a neovim function synchronously. This function blocks until the--- result is available.-scall :: (NvimObject result)- => FunctionName- -> [Object] -- ^ Parameters in an 'Object' array- -> Neovim env (Either NeovimException result)- -- ^ result value of the call or the thrown exception-scall fn parameters = acall fn parameters >>= atomically'---- | Similar to 'scall', but throw a 'NeovimException' instead of returning it.-scallThrow :: (NvimObject result)- => FunctionName- -> [Object]- -> Neovim env result-scallThrow fn parameters = scall fn parameters >>= either throwIO return----- | Helper function similar to 'scall' that throws a runtime exception if the--- result is an error object.-scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result-scall' fn = withIgnoredException fn . scall fn----- | Lifted variant of 'atomically'.-atomically' :: (MonadIO io) => STM result -> io result-atomically' = liftIO . atomically----- | Wait for the result of the STM action.------ This action possibly blocks as it is an alias for--- @ \ioSTM -> ioSTM >>= liftIO . atomically@.-wait :: Neovim env (STM result) -> Neovim env result-wait = (=<<) atomically'----- | Variant of 'wait' that discards the result.-wait' :: Neovim env (STM result) -> Neovim env ()-wait' = void . wait----- | Send the result back to the neovim instance.-respond :: (NvimObject result) => Request -> Either String result -> Neovim env ()-respond Request{..} result = do- q <- Internal.asks' Internal.eventQueue- writeMessage q . MsgpackRPC.Response reqId $- either (Left . toObject) (Right . toObject) result-
− library/Neovim/RPC/SocketReader.hs
@@ -1,220 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards #-}-{- |-Module : Neovim.RPC.SocketReader-Description : The component which reads RPC messages from the neovim instance-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental---}-module Neovim.RPC.SocketReader (- runSocketReader,- parseParams,- ) where--import Neovim.Classes-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes (CommandArguments (..),- CommandOption (..),- FunctionName (..),- NvimMethod (..),- FunctionalityDescription (..),- getCommandOptions)-import Neovim.Plugin.IPC.Classes-import qualified Neovim.RPC.Classes as MsgpackRPC-import Neovim.RPC.Common-import Neovim.RPC.FunctionCall--import Control.Applicative-import Control.Concurrent.STM-import Control.Monad (void)-import Conduit as C-import Data.Conduit.Cereal (conduitGet2)-import Data.Default (def)-import Data.Foldable (foldl', forM_)-import qualified Data.Map as Map-import Data.MessagePack-import Data.Monoid-import qualified Data.Serialize (get)-import System.IO (Handle)-import System.Log.Logger-import UnliftIO.Async (async, race)-import UnliftIO.Concurrent (threadDelay)--import Prelude--logger :: String-logger = "Socket Reader"---type SocketHandler = Neovim RPCConfig----- | This function will establish a connection to the given socket and read--- msgpack-rpc events from it.-runSocketReader :: Handle- -> Internal.Config RPCConfig- -> IO ()-runSocketReader readableHandle cfg =- void . runNeovim (Internal.retypeConfig (Internal.customConfig cfg) cfg) . runConduit $ do- sourceHandle readableHandle- .| conduitGet2 Data.Serialize.get- .| messageHandlerSink----- | Sink that delegates the messages depending on their type.--- <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>-messageHandlerSink :: ConduitT Object Void SocketHandler ()-messageHandlerSink = awaitForever $ \rpc -> do- liftIO . debugM logger $ "Received: " <> show rpc- case fromObject rpc of- Right (MsgpackRPC.Request (Request fn i ps)) ->- handleRequestOrNotification (Just i) fn ps-- Right (MsgpackRPC.Response i r) ->- handleResponse i r-- Right (MsgpackRPC.Notification (Notification fn ps)) ->- handleRequestOrNotification Nothing fn ps-- Left e -> liftIO . errorM logger $- "Unhandled rpc message: " <> show e---handleResponse :: Int64 -> Either Object Object- -> ConduitT a Void SocketHandler ()-handleResponse i result = do- answerMap <- asks recipients- mReply <- Map.lookup i <$> liftIO (readTVarIO answerMap)- case mReply of- Nothing -> liftIO $ warningM logger- "Received response but could not find a matching recipient."- Just (_,reply) -> do- atomically' . modifyTVar' answerMap $ Map.delete i- atomically' $ putTMVar reply result----- | Act upon the received request or notification. The main difference between--- the two is that a notification does not generate a reply. The distinction--- between those two cases is done via the first paramater which is 'Maybe' the--- function call identifier.-handleRequestOrNotification :: Maybe Int64 -> FunctionName -> [Object]- -> ConduitT a Void SocketHandler ()-handleRequestOrNotification requestId functionToCall@(F functionName) params = do- cfg <- lift Internal.ask'- void . liftIO . async $ race logTimeout (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-- Nothing -> do- let errM = "No provider for: " <> show functionToCall- debugM logger errM- forM_ requestId $ \i -> writeMessage (Internal.eventQueue rpc) $- MsgpackRPC.Response i (Left (toObject errM))-- Just (copts, Internal.Stateful c) -> do- now <- liftIO getCurrentTime- reply <- liftIO newEmptyTMVarIO- let q = (recipients . Internal.customConfig) rpc- liftIO . debugM logger $ "Executing stateful function with ID: " <> show requestId- case requestId of- Just i -> do- atomically' . modifyTVar q $ Map.insert i (now, reply)- writeMessage c $ Request functionToCall i (parseParams copts params)-- Nothing ->- writeMessage c $ Notification functionToCall (parseParams copts params)---parseParams :: FunctionalityDescription -> [Object] -> [Object]-parseParams (Function _ _) args = case args of- -- Defining a function on the remote host creates a function that, that- -- passes all arguments in a list. At the time of this writing, no other- -- arguments are passed for such a function.- --- -- The function generating the function on neovim side is called:- -- @remote#define#FunctionOnHost@- [ObjectArray fArgs] -> fArgs- _ -> args--parseParams cmd@(Command _ opts) args = case args of- (ObjectArray _ : _) ->- let cmdArgs = filter isPassedViaRPC (getCommandOptions opts)- (c,args') =- foldl' createCommandArguments (def, []) $- zip cmdArgs args- in toObject c : args'-- _ -> parseParams cmd $ [ObjectArray args]- where- isPassedViaRPC :: CommandOption -> Bool- isPassedViaRPC = \case- CmdSync{} -> False- _ -> True-- -- Neovim passes arguments in a special form, depending on the- -- CommandOption values used to export the (command) function (e.g. via- -- 'command' or 'command'').- createCommandArguments :: (CommandArguments, [Object])- -> (CommandOption, Object)- -> (CommandArguments, [Object])- createCommandArguments old@(c, args') = \case- (CmdRange _, o) ->- either (const old) (\r -> (c { range = Just r }, args')) $ fromObject o-- (CmdCount _, o) ->- either (const old) (\n -> (c { count = Just n }, args')) $ fromObject o-- (CmdBang, o) ->- either (const old) (\b -> (c { bang = Just b }, args')) $ fromObject o-- (CmdNargs "*", ObjectArray os) ->- -- CommandArguments -> [String] -> Neovim r st a- (c, os)- (CmdNargs "+", ObjectArray (o:os)) ->- -- CommandArguments -> String -> [String] -> Neovim r st a- (c, o : [ObjectArray os])- (CmdNargs "?", ObjectArray [o]) ->- -- CommandArguments -> Maybe String -> Neovim r st a- (c, [toObject (Just o)])-- (CmdNargs "?", ObjectArray []) ->- -- CommandArguments -> Maybe String -> Neovim r st a- (c, [toObject (Nothing :: Maybe Object)])-- (CmdNargs "0", ObjectArray []) ->- -- CommandArguments -> Neovim r st a- (c, [])-- (CmdNargs "1", ObjectArray [o]) ->- -- CommandArguments -> String -> Neovim r st a- (c, [o])-- (CmdRegister, o) ->- either (const old) (\r -> (c { register = Just r }, args')) $ fromObject o-- _ -> old--parseParams (Autocmd _ _ _ _) args = case args of- [ObjectArray fArgs] -> fArgs- _ -> args-
− library/Neovim/Test.hs
@@ -1,133 +0,0 @@-{- |-Module : Neovim.Test-Description : Testing functions-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Test (- testWithEmbeddedNeovim,- Seconds(..),- ) where--import Neovim-import Neovim.API.Text-import qualified Neovim.Context.Internal as Internal-import Neovim.RPC.Common (RPCConfig, newRPCConfig)-import Neovim.RPC.EventHandler (runEventHandler)-import Neovim.RPC.SocketReader (runSocketReader)--import Control.Monad.Reader (runReaderT)-import Control.Monad.Trans.Resource (runResourceT)-import Data.Text.Prettyprint.Doc (annotate, vsep)-import Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)-import GHC.IO.Exception (ioe_filename)-import Path-import Path.IO-import System.Exit (ExitCode (..))-import System.IO (Handle)-import System.Process.Typed-import UnliftIO.Async (async, cancel)-import UnliftIO.Concurrent (threadDelay)-import UnliftIO.Exception-import UnliftIO.STM (atomically, putTMVar)---- | Type synonym for 'Word'.-newtype Seconds = Seconds Word----- | 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@).------ 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".-testWithEmbeddedNeovim- :: Maybe (Path b File) -- ^ Optional path to a file that should be opened- -> Seconds -- ^ Maximum time (in seconds) that a test is allowed to run- -> env -- ^ Read-only configuration- -> Neovim env a -- ^ Test case- -> IO ()-testWithEmbeddedNeovim file timeout r (Internal.Neovim a) =- runTest `catch` catchIfNvimIsNotOnPath- where- runTest = do- (nvimProcess, cfg, cleanUp) <- startEmbeddedNvim file timeout-- let testCfg = Internal.retypeConfig r cfg-- void $ runReaderT (runResourceT a) testCfg-- -- 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-- waitExitCode nvimProcess >>= \case- ExitFailure i ->- fail $ "Neovim returned with an exit status of: " ++ show i-- ExitSuccess ->- return ()- cancel testRunner- cleanUp---catchIfNvimIsNotOnPath :: IOException -> IO ()-catchIfNvimIsNotOnPath e = case ioe_filename e of- Just "nvim" ->- putDoc . annotate (color Red) $ vsep- [ "The neovim executable 'nvim' is not on the PATH."- , "You may not be testing fully!"- ]-- _ ->- throwIO e--startEmbeddedNvim- :: Maybe (Path b File)- -> Seconds- -> IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())-startEmbeddedNvim file (Seconds timeout) = do- args <- case file of- Nothing ->- return []-- Just f -> do- -- 'fail' should work with most testing frameworks- unlessM (doesFileExist f) . fail $ "File not found: " ++ show f- return [toFilePath f]-- nvimProcess <- startProcess- $ setStdin createPipe- $ setStdout createPipe- $ proc "nvim" (["-n","-u","NONE","--embed"] ++ args)-- cfg <- Internal.newConfig (pure Nothing) newRPCConfig-- socketReader <- async . void $ runSocketReader- (getStdout nvimProcess)- (cfg { Internal.pluginSettings = Nothing })-- eventHandler <- async . void $ runEventHandler- (getStdin nvimProcess)- (cfg { Internal.pluginSettings = Nothing })-- atomically $ putTMVar- (Internal.globalFunctionMap cfg)- (Internal.mkFunctionMap [])-- timeoutAsync <- async . void $ do- threadDelay $ (fromIntegral timeout) * 1000 * 1000- getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> return ())-- let cleanUp = mapM_ cancel [socketReader, eventHandler, timeoutAsync]-- return (nvimProcess, cfg, cleanUp)-
− library/Neovim/Util.hs
@@ -1,36 +0,0 @@-{- |-Module : Neovim.Util-Description : Utility functions-Copyright : (c) Sebastian Witte-License : Apache-2.0--Maintainer : woozletoff@gmail.com-Stability : experimental-Portability : GHC---}-module Neovim.Util (- whenM,- unlessM,- oneLineErrorMessage,- ) where--import Control.Monad (when, unless)-import Neovim.Context-import qualified Data.Text as T----- | 'when' with a monadic predicate.-whenM :: (Monad m) => m Bool -> m () -> m ()-whenM mp a = mp >>= \p -> when p a----- | 'unless' with a monadic predicate.-unlessM :: (Monad m) => m Bool -> m () -> m ()-unlessM mp a = mp >>= \p -> unless p a---oneLineErrorMessage :: Doc AnsiStyle -> T.Text-oneLineErrorMessage d = case T.lines $ docToText d of- (x:_) -> x- [] -> mempty
− nvim-hs-devel.sh
@@ -1,34 +0,0 @@-#!/bin/sh--# Helper script to run nvim-hs in a development environment.--# You should not name this script nvim-hs and put it on your path.-if [ x"$0" = x`which nvim-hs` ] ; then- echo "This script has the potential to run in an infinite loop. Exiting now..."- exit 1-fi--# This variable defines where the sandbox or stack files can be found. Adjust it-# appropriately and then delete the line after it.-sandbox_directory=$HOME/git/nvim-hs-echo "I should have read the comments. Silly me." && exit 1--old_pwd="`pwd`"-cd "$sandbox_directory"--if [ -d "$sandbox_directory/.cabal-sandbox" ] ; then- # We detect the sandbox by checking for the directory .cabal-sandbox- # This should work most of the time.- env CABAL_SANDBOX_CONFIG="$sandbox_directory"/cabal.sandbox.config cabal \- exec "$sandbox_directory/.cabal-sandbox/bin/nvim-hs" -- "$@"-elif [ -d "$sandbox_directory/.stack-work" ] ; then- # Stack leaves behind a .stack-work directory, so we take its present as a- # sign to use this approach.- stack exec nvim-hs -- "$@"-else- echo "No development directories found. Have you built the project?"- exit 2-fi-cd "$old_pwd"--# vim: foldmethod=marker sts=2 ts=4 expandtab sw=4
nvim-hs.cabal view
@@ -1,5 +1,6 @@+cabal-version: 3.0 name: nvim-hs-version: 2.1.0.7+version: 2.3.2.4 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write@@ -26,15 +27,19 @@ license-file: LICENSE author: Sebastian Witte maintainer: woozletoff@gmail.com-copyright: Copyright 2017-2018 Sebastian Witte <woozletoff@gmail.com>+copyright: Copyright 2017-2022 Sebastian Witte <woozletoff@gmail.com> category: Editor build-type: Simple-cabal-version: 1.18-extra-source-files: nvim-hs-devel.sh- , test-files/hello+extra-source-files: test-files/hello , apiblobs/0.1.7.msgpack , apiblobs/0.2.0.msgpack , apiblobs/0.3.0.msgpack+ , apiblobs/0.4.3.msgpack+ , apiblobs/0.5.0.msgpack+ , apiblobs/0.6.1.msgpack+ , apiblobs/0.8.0.msgpack+ , apiblobs/0.10.4.msgpack+ , apiblobs/0.11.0-nightly.msgpack , api extra-doc-files: CHANGELOG.md@@ -45,7 +50,44 @@ type: git location: https://github.com/neovimhaskell/nvim-hs +common defaults+ default-language: Haskell2010+ default-extensions: BangPatterns+ , ScopedTypeVariables+ , StrictData+ other-extensions: DeriveDataTypeable+ , DeriveGeneric+ , DerivingVia+ , ExistentialQuantification+ , FlexibleContexts+ , FlexibleInstances+ , GADTs+ , GeneralizedNewtypeDeriving+ , LambdaCase+ , MultiParamTypeClasses+ , NamedFieldPuns+ , NoOverloadedStrings+ , NoRebindableSyntax+ , OverloadedLists+ , OverloadedStrings+ , PackageImports+ , RankNTypes+ , RecordWildCards+ , TemplateHaskell+ ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates+ build-depends: base >=4.9 && < 5 + , containers+ , data-default+ , deepseq >= 1.1 && < 2+ , prettyprinter+ , prettyprinter-ansi-terminal+ , unliftio >= 0.2+ , unliftio-core >= 0.2+ , vector+ , void+ library+ import: defaults exposed-modules: Neovim , Neovim.Quickfix , Neovim.Debug@@ -71,6 +113,7 @@ , Neovim.Plugin.IPC.Classes , Neovim.Log , Neovim.Main+ , Neovim.OS , Neovim.RPC.Classes , Neovim.RPC.Common , Neovim.RPC.EventHandler@@ -79,121 +122,54 @@ , Neovim.Util , Neovim.API.Parser , Neovim.API.TH- default-extensions: OverloadedStrings- , LambdaCase- , ScopedTypeVariables- other-extensions: BangPatterns- , CPP- , DeriveDataTypeable- , DeriveGeneric- , ExistentialQuantification- , FlexibleContexts- , FlexibleInstances- , GADTs- , GeneralizedNewtypeDeriving- , MultiParamTypeClasses- , MultiWayIf- , NamedFieldPuns- , NoOverloadedStrings- , OverlappingInstances- , PackageImports- , RankNTypes- , RecordWildCards- , TemplateHaskell- build-depends: base >=4.9 && < 5- , bytestring+ other-extensions: CPP+ build-depends: bytestring , cereal , cereal-conduit >= 0.8.0 , conduit >= 1.3.0- , containers- , data-default- , deepseq >= 1.1 && < 1.5- , path- , path-io , foreign-store , hslogger , messagepack >= 0.5.4 , network- , mtl >= 2.2.1 && < 2.3+ , mtl >= 2.2.1 && < 2.4 , optparse-applicative , time-locale-compat , megaparsec < 10- , prettyprinter >= 1.2 && < 2- , prettyprinter-ansi-terminal- , resourcet >= 1.1.11- , stm , streaming-commons , template-haskell- , template-haskell-compat-v0208+ , template-haskell-compat-v0208 >= 0.1.9 , text , time- , transformers- , transformers-base , typed-process- , unliftio >= 0.2- , unliftio-core >= 0.2 , utf8-string- , vector- , void- hs-source-dirs: library- default-language: Haskell2010- ghc-options: -Wall+ hs-source-dirs: src + if os(windows)+ cpp-options: -DWINDOWS+ hs-source-dirs: srcos/windows+ else+ hs-source-dirs: srcos/unix+ test-suite hspec+ import: defaults type: exitcode-stdio-1.0- hs-source-dirs: test-suite+ hs-source-dirs: tests main-is: Spec.hs- default-extensions: OverloadedStrings- , LambdaCase- , ScopedTypeVariables- default-language: Haskell2010- build-depends: base >= 4.6 && < 5- , nvim-hs+ build-depends: nvim-hs , hspec ==2.* , hspec-discover , QuickCheck >=2.6 - , bytestring- , cereal- , cereal-conduit- , conduit- , containers- , data-default- , path- , path-io- , foreign-store- , hslogger- , mtl- , messagepack- , time-locale-compat- , network- , optparse-applicative- , megaparsec- , prettyprinter- , prettyprinter-ansi-terminal- , typed-process >= 0.2.1.0- , resourcet- , stm- , streaming-commons- , text- , template-haskell- , template-haskell-compat-v0208- , time- , transformers- , transformers-base- , unliftio- , unliftio-core- , utf8-string- , vector- , HUnit-- other-modules: Neovim.API.THSpec- , Neovim.API.THSpecFunctions- , Neovim.EmbeddedRPCSpec- , Neovim.Plugin.ClassesSpec- , Neovim.RPC.SocketReaderSpec+ other-modules: API.THSpec+ , API.THSpecFunctions+ , EmbeddedRPCSpec+ , EventSubscriptionSpec+ , Plugin.ClassesSpec+ , AsyncFunctionSpec+ , RPC.SocketReaderSpec+ , RPC.CommonSpec ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ src/Neovim.hs view
@@ -0,0 +1,476 @@+{- |+Module : Neovim+Description : API for the neovim plugin provider /nvim-hs/+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC (due to Template Haskell)++This module should contain all the things you need to write neovim plugins in+your favorite language! @:-)@++The documentation in this module should provide every information you need to start+writing plugins.+-}+module Neovim (+ -- * Installation+ -- $installation++ -- * Tutorial+ -- ** Motivation+ -- $overview+ -- ** Combining existing plugins+ -- $existingplugins+ Neovim,+ neovim,+ NeovimConfig(..),+ defaultConfig,+ def,+++ -- ** Creating a plugin+ -- $creatingplugins+ NeovimPlugin(..),+ Plugin(..),+ NvimObject(..),+ (+:),+ Dictionary,+ Object(..),+ wrapPlugin,+ function,+ function',+ command,+ command',+ autocmd,+ Synchronous(..),+ CommandOption(..),+ RangeSpecification(..),+ CommandArguments(..),+ AutocmdOptions(..),+ addAutocmd,++ ask,+ asks,++ -- ** Subscribing to notifications or events+ Subscription,+ subscribe,+ unsubscribe,+ NeovimEventId(..),++ -- ** Creating a stateful plugin+ -- $statefulplugin++ -- ** Calling remote functions+ -- $remote+ wait,+ wait',+ err,+ errOnInvalidResult,+ catchNeovimException,+ NeovimException(..),++ -- * Unsorted exports+ -- This section contains just a bunch of more or less useful functions which+ -- were not introduced in any of the previous sections.+ liftIO,+ whenM,+ unlessM,+ docToObject,+ docFromObject,+ Doc,+ AnsiStyle,+ Pretty(..),+ putDoc,+ exceptionToDoc,+ Priority(..),+ module Control.Monad,+ module Control.Applicative,+ module Data.Monoid,+ module Data.Int,+ module Data.Word,++ ) where++import Control.Applicative+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Data.Default (def)+import Data.Int (Int16, Int32, Int64, Int8)+import Data.MessagePack (Object (..))+import Data.Monoid+import Data.Word (Word, Word16, Word32, Word8)+import Neovim.API.TH (autocmd, command, command',+ function, function')+import Neovim.Classes (Dictionary, NvimObject (..),+ Doc, AnsiStyle, Pretty(..),+ docFromObject, docToObject, (+:))+import Neovim.Config (NeovimConfig (..))+import Neovim.Context (Neovim,+ NeovimException(..),+ exceptionToDoc,+ ask, asks, err,+ errOnInvalidResult, subscribe, unsubscribe)+import Neovim.Main (neovim)+import Neovim.Exceptions (catchNeovimException)+import Neovim.Plugin (addAutocmd)+import Neovim.Plugin.Classes (AutocmdOptions (..),+ CommandArguments (..),+ CommandOption (CmdBang, CmdCount, CmdRange, CmdRegister, CmdSync),+ RangeSpecification (..),+ Synchronous (..),+ Subscription, NeovimEventId(..))+import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..),+ wrapPlugin)+import Neovim.RPC.FunctionCall (wait, wait')+import Neovim.Util (unlessM, whenM)+import System.Log.Logger (Priority (..))+import Prettyprinter.Render.Terminal (putDoc)+-- 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.++-}++-- Tutorial+-- Overview+{- $overview+An @nvim-hs@ plugin is just a collection of haskell functions that can be+called from neovim.++As a user of plugins, you basically have two choices. You can start every+plugin in a separate process and use normal vim plugin management strategies+such as <https://github.com/junegunn/vim-plug vim-plug>+or <https://github.com/tpope/vim-pathogen pathogen>.+Alternatively, you can create a haskell project and depend on the plugins+you want to use and plumb them together. This plumbing is equivalent to+writing a plugin.++Since you are reading haddock documentation, you probably want the latter, so+just keep reading. @:-)@++-}+++-- 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+directory (@~\/.config\/nvim@ on linux-based systems), it should automatically be+compiled and run with two simple example plugins.++You have to define a haskell project that depends on this package and+contains an executable secion within a main file that looks something like this:++@+import TestPlugin.ExamplePlugin (examplePlugin)++main = 'neovim' 'def'+ { 'plugins' = [ examplePlugin ] ++ 'plugins' 'defaultConfig'+ }+@+++/nvim-hs/ is all about importing and creating plugins. This is done following a+concise API. Let's start by making a given plugin available inside+our plugin provider. Assuming that we have installed a cabal package that exports+an @examplePlugin@ from the module @TestPlugin.ExamplePlugin@, a minimal+main file would look something like this:++That's all you have to do! Multiple plugins are simply imported and put in a+list.++-}++-- | Default configuration options for /nvim-hs/. If you want to keep the+-- default plugins enabled, you can define your config like this:+--+-- @+-- main = 'neovim' 'defaultConfig'+-- { plugins = plugins defaultConfig ++ myPlugins+-- }+-- @+--+defaultConfig :: NeovimConfig+defaultConfig = Config+ { plugins = []+ , logOptions = Nothing+ }+++-- 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+so bad. We will cover most pitfalls in the following paragraphs and if there+isn't a solution for your error, you can always ask any friendly Haskeller in+\#haskell on @irc.freenode.net@!++Enough scary stuff said for now, let's write a plugin!+Due to a stage restriction in GHC when using Template Haskell+(i.e. code generation), we must define+our functions in a different module than @\$XDG_CONFIG_HOME\/nvim\/nvim.hs@.+(I'm assuming here, that you use @\$XDG_CONFIG_HOME\/nvim\/@ as the base+directory for historical reasons and because it might be an appropriate place.)+This is a bit unfortunate, but it will save you a lot of boring boilerplate and+it will present you with helpful error messages if your plugin's functions do+not work together with neovim.++So, let\'s write a plugin that calculates the @n@th Fibonacci number. Don\'t we all+love those!++File @\~\/.config\/nvim\/lib\/Fibonacci\/Plugin.hs@:++@+module Fibonacci.Plugin (fibonacci) where++import "Neovim"++\-\- \| Neovim is not really good with big numbers, so we return a 'String' here.+fibonacci :: 'Int' -> 'Neovim' env 'String'+fibonacci n = 'return' . 'show' \$ fibs !! n+ where+ fibs :: [Integer]+ fibs = 0:1:'scanl1' (+) fibs+@++File @\~\/.config\/nvim\/lib\/Fibonacci.hs@:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}+module Fibonacci (plugin) where++import "Neovim"+import Fibonacci.Plugin (fibonacci)++plugin :: 'Neovim' () 'NeovimPlugin'+plugin = 'wrapPlugin' Plugin+ { 'environment' = ()+ , 'exports' = [ $('function'' 'fibonacci) 'Sync' ]+ }+@++File @~\/.config\/nvim\/nvim.hs@:++@+import "Neovim"++import qualified Fibonacci as Fibonacci++main :: 'IO' ()+main = 'neovim' 'defaultConfig'+ { 'plugins' = 'plugins' 'defaultConfig' ++ [ Fibonacci.plugin ]+ }+@++Let's analyze how it works. The module @Fibonacci.Plugin@ simply defines a function+that takes the @n@th element of the infinite list of Fibonacci numbers. Even though+the definition is very concise and asthetically pleasing, the important part is the+type signature for @fibonacci@. Similarly how @main :: IO ()@ works in normal Haskell+programs, 'Neovim' is the environment we need for plugins. Internally, it stores a+few things that are needed to communicate with neovim, but that shouldn't bother you+too much. Simply remember that every plugin function must have a function signature+whose last element is of type @'Neovim' env something@. The result of @fibonacci@+is 'String' because neovim cannot handle big numbers so well. :-)+You can use any argument or result type as long as it is an instance of 'NvimObject'.++The second part of of the puzzle, which is the definition of @plugin@+in @~\/.config\/nvim\/lib\/Fibonacci.hs@, shows what a plugin is. It is essentially+an empty environment and a list of functions, commands or autocommands in the context of vim+terminology. In the end, all of those things map to a function at the side+of /nvim-hs/. If you really want to know what the distinction between those is, you+have to consult the @:help@ pages of neovim (e.g. @:help :function@, @:help :command@+and @:help :autocmd@). What's relevant from the side of /nvim-hs/ is the environment.+The environment is a data type that is avaiable to all exported functions of your+plugin. This example does not make use of anything of that environment, so+we used '()', also known as unit, as our environment. The definition of+@fibonacci@ uses a type variable @env@ as it does not access the environment and+can handle any environment. If you want to access the environment, you can call+'ask' or 'asks' if you are inside a 'Neovim' environment. An example that shows+you how to use it can be found in a later chapter.++Now to the magical part: @\$('function'' 'fibonacci)@. This is a so called+Template Haskell splice and this is why you need+@\{\-\# LANGUAGE TemplateHaskell \#\-\}@ at the top of your Haskell file. This+splice simply generates Haskell code that, in this case, still needs a value+of type 'Synchronous' which indicates whether calling the function will make+neovim wait for its result or not. Internally, the expression+@\$('function'' 'fibonacci) 'Sync'@ creates a value that contains all the+necessary information to properly register the function with neovim. Note the+prime symbol before the function name! This would have probably caused you+some trouble if I haven't mentioned it here! Template Haskell simply requires+you to put that in front of function names that are passed in a splice.++If you compile this and restart the plugin, you can calculate the 2000th Fibonacci+number like as if it were a normal vim-script function:++@+:echo Fibonacci(2000)+@++You can also directly insert the result inside any text file opened with neovim+by using the evaluation register by pressing the following key sequence in insert+mode:++@+\<C-r\>=Fibonacci(2000)+@++The haddock documentation will now list all the things we have used up until now.+Afterwards, there is a plugin with state which uses the environment.++-}+-- 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+generator!++File @~\/.config\/nvim\/lib\/Random\/Plugin.hs@:++@+module Random.Plugin (nextRandom, setNextRandom) where++import "Neovim"++import System.Random (newStdGen, randoms)+import UnliftIO.STM (TVar, atomically, readTVar, modifyTVar, newTVarIO)++-- You may want to define a type alias for your plugin, so that if you change+-- your environment, you don't have to change all type signatures.+--+-- If I were to write a real plugin, I would probably also create a data type+-- instead of directly using a TVar here.+--+type MyNeovim a = Neovim ('TVar' ['Int16']) a++-- This function will create an initial environment for our random number+-- generator. Note that the return type is the type of our environment.+randomNumbers :: Neovim startupEnv (TVar [Int16])+randomNumbers = do+ g <- liftIO newStdGen -- Create a new seed for a pseudo random number generator+ newTVarIO (randoms g) -- Put an infinite list of random numbers into a TVar++-- | Get the next random number and update the state of the list.+nextRandom :: MyNeovim 'Int16'+nextRandom = do+ tVarWithRandomNumbers <- 'ask'+ atomically $ do+ -- pick the head of our list of random numbers+ r \<- 'head' <$> 'readTVar' tVarWithRandomNumbers++ -- Since we do not want to return the same number all over the place+ -- remove the head of our list of random numbers+ modifyTVar tVarWithRandomNumbers 'tail'++ 'return' r+++-- | You probably don't want this in a random number generator, but this shows+-- hoy you can edit the state of a stateful plugin.+setNextRandom :: 'Int16' -> MyNeovim ()+setNextRandom n = do+ tVarWithRandomNumbers <- 'ask'++ -- cons n to the front of the infinite list+ atomically $ modifyTVar tVarWithRandomNumbers (n:)+@++File @~\/.config\/nvim\/lib\/Random.hs@:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}+module Random (plugin) where++import "Neovim"+import Random.Plugin (nextRandom, setNextRandom)+import "System.Random" ('newStdGen', 'randoms')++plugin :: 'Neovim' ('StartupConfig' 'NeovimConfig') () 'NeovimPlugin'+plugin = do+ env <- randomNumbers+ 'wrapPlugin' 'Plugin'+ { environment = env+ , 'exports' =+ [ $('function'' 'nextRandom) 'Sync'+ , $('function' \"SetNextRandom\" 'setNextRandom) 'Async'+ ]+ }+@++File @~\/.config\/nvim\/nvim.hs@:++@+import "Neovim"++import qualified Fibonacci as Fibonacci+import qualified Random as Random++main :: 'IO' ()+main = 'neovim' 'defaultConfig'+ { 'plugins' = 'plugins' 'defaultConfig' ++ [ Fibonacci.plugin, Random.plugin ]+ }+@+++That wasn't too hard, was it? The definition is very similar to the previous+example, we just were able to mutate our state and share that with other+functions. Another noteworthy detail, in case you+are not familiar with it, is the use of 'liftIO' in front of 'newStdGen'. You+have to do this, because 'newStdGen' has type @'IO' 'StdGen'@ but the actions+inside the startup code are of type+@'Neovim' () something@. 'liftIO' lifts an+'IO' function so that it can be run inside the 'Neovim' context (or more+generally, any monad that implements the 'MonadIO' type class).++After you have saved these files (and removed any typos @:-)@), you can restart+/nvim-hs/ with @:RestartNvimhs@ and insert random numbers in your text files!++@+\<C-r\>=NextRandom()+@++You can also cheat and pretend you know the next number:++@+:call SetNextRandom(42)+@++-}+-- 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+getting some abstract 'Buffer' object, test whether it is valid and then try+to rename it.++@+inspectBuffer :: 'Neovim' env ()+inspectBuffer = do+ cb <- 'vim_get_current_buffer'+ isValid <- 'buffer_is_valid' cb+ when isValid $ do+ let newName = "magic"+ cbName \<- 'wait'' $ 'buffer_set_name' cb newName+ case () of+ _ | cbName == newName -> 'return' ()+ _ -> 'err' $ "Renaming the current buffer failed!"+@++You may have noticed the 'wait'' function in there. Some functions have a return+type with 'STM' in it. This means that the function call is asynchronous. We can+'wait' (or 'wait'') for the result at the point at which we actually need it. In+this short example, we put the 'wait'' directly in front of the remote function+call because we want to inspect the result immediately, though. The other+functions either returned a result directly or they returned+@'Either' 'Object' something@ whose result we inspected ourselves. The 'err'+function directly terminates the current thread and sends the given error+message to neovim which the user immediately notices.++That's pretty much all there is to it.+-}+
+ src/Neovim/API/ByteString.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoOverloadedStrings #-}++{- |+Module : Neovim.API.ByteString+Description : ByteString based API+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.API.ByteString where++import Neovim.API.TH++$(generateAPI bytestringVectorTypeMap)
+ src/Neovim/API/Parser.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.API.Parser+Description : P.Parser for the msgpack output stram API+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.API.Parser (+ NeovimAPI (..),+ NeovimFunction (..),+ NeovimType (..),+ parseAPI,+) where++import Neovim.Classes+import Neovim.OS (isWindows)++import Control.Applicative (optional)+import Control.Monad (forM)+import Control.Monad.Except (MonadError (throwError))+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 (+ MonadParsec (eof, try),+ Parser,+ char,+ noneOf,+ oneOf,+ parse,+ some,+ space,+ string,+ (<|>),+ )+import System.Process.Typed (proc, readProcessStdout_)+import UnliftIO.Exception (+ SomeException,+ catch,+ )++import Prelude++data NeovimType+ = SimpleType String+ | NestedType NeovimType (Maybe Int)+ | Void+ deriving (Show, Eq)++{- | This data type contains simple information about a function as received+ throudh the @nvim --api-info@ command.+-}+data NeovimFunction = NeovimFunction+ { name :: String+ -- ^ function name+ , parameters :: [(NeovimType, String)]+ -- ^ A list of type name and variable name.+ , canFail :: Bool+ -- ^ Indicator whether the function can fail/throws exceptions.+ , async :: Bool+ -- ^ Indicator whether the this function is asynchronous.+ , returnType :: NeovimType+ -- ^ Functions return type.+ }+ deriving (Show)++{- | This data type represents the top-level structure of the @nvim --api-info@+ output.+-}+data NeovimAPI = NeovimAPI+ { errorTypes :: [(String, Int64)]+ -- ^ The error types are defined by a name and an identifier.+ , customTypes :: [(String, Int64)]+ -- ^ Extension types defined by neovim.+ , functions :: [NeovimFunction]+ -- ^ The remotely executable functions provided by the neovim api.+ }+ deriving (Show)++-- | Run @nvim --api-info@ and parse its output.+parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI)+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"])++extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI+extractAPI apiObj =+ fromObject apiObj >>= \apiMap ->+ NeovimAPI+ <$> extractErrorTypes apiMap+ <*> extractCustomTypes apiMap+ <*> extractFunctions apiMap++readFromAPIFile :: IO (Either String Object)+readFromAPIFile = (decode <$> B.readFile "api") `catch` returnNoApiForCodegeneratorErrorMessage+ where+ returnNoApiForCodegeneratorErrorMessage :: SomeException -> IO (Either String Object)+ returnNoApiForCodegeneratorErrorMessage _ =+ return . Left $+ "The 'nvim' process could not be started and there is no file named 'api' in the working directory as a substitute."++oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o+oLookup qry = maybe throwErrorMessage fromObject . Map.lookup qry+ where+ throwErrorMessage = throwError $ "No entry for:" <+> pretty qry++oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o+oLookupDefault d qry m = maybe (return d) fromObject $ Map.lookup qry m++extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]+extractErrorTypes objAPI = extractTypeNameAndID =<< oLookup "error_types" objAPI++extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)]+extractTypeNameAndID m = do+ types <- Map.toList <$> fromObject m+ forM types $ \(errName, idMap) -> do+ i <- oLookup "id" idMap+ return (errName, i)++extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)]+extractCustomTypes objAPI = extractTypeNameAndID =<< oLookup "types" objAPI++extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction]+extractFunctions objAPI = mapM extractFunction =<< oLookup "functions" objAPI++toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)]+toParameterlist ps = forM ps $ \(t, n) -> do+ t' <- parseType t+ return (t', n)++extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction+extractFunction funDefMap =+ NeovimFunction+ <$> oLookup "name" funDefMap+ <*> (oLookup "parameters" funDefMap >>= toParameterlist)+ <*> oLookupDefault True "can_fail" funDefMap+ <*> oLookupDefault False "async" funDefMap+ <*> (oLookup "return_type" funDefMap >>= parseType)++parseType :: String -> Either (Doc AnsiStyle) NeovimType+parseType s = either (throwError . pretty . show) return $ parse (pType <* eof) s s++pType :: P.Parser NeovimType+pType = pArray P.<|> pVoid P.<|> pSimple++pVoid :: P.Parser NeovimType+pVoid = Void <$ (P.try (string "void") <* eof)++pSimple :: P.Parser NeovimType+pSimple = SimpleType <$> P.some (noneOf [',', ')'])++pArray :: P.Parser NeovimType+pArray =+ NestedType+ <$> (P.try (string "ArrayOf(") *> pType)+ <*> optional pNum+ <* char ')'++pNum :: P.Parser Int+pNum = read <$> (P.try (char ',') *> space *> P.some (oneOf ['0' .. '9']))
+ src/Neovim/API/String.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoOverloadedStrings #-}++{- |+Module : Neovim.API.String+Description : String based API+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental++Note that this module is completely generated. If you're reading this on+hackage, the actual functions of this module may be different from what is+available to you. All the functions in this module depend on the neovim version+that was used when this package was compiled.+-}+module Neovim.API.String where++import Neovim.API.TH++$(generateAPI stringListTypeMap)
+ src/Neovim/API/TH.hs view
@@ -0,0 +1,582 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE TemplateHaskell #-}++{- |+Module : Neovim.API.TH+Description : Template Haskell API generation module+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.API.TH (+ generateAPI,+ function,+ function',+ command,+ command',+ autocmd,+ stringListTypeMap,+ textVectorTypeMap,+ bytestringVectorTypeMap,+ createFunction,+ module UnliftIO.Exception,+ module Neovim.Classes,+ module Data.Data,+ module Data.MessagePack,+) where++import Neovim.API.Parser+import Neovim.Classes+import Neovim.Context+import Neovim.Plugin.Classes (+ CommandArguments (..),+ CommandOption (..),+ FunctionName (..),+ FunctionalityDescription (..),+ mkCommandOptions,+ )+import Neovim.Plugin.Internal (ExportedFunctionality (..))+import Neovim.RPC.FunctionCall++import Language.Haskell.TH hiding (conP, dataD, instanceD)+import TemplateHaskell.Compat.V0208++import Control.Applicative+import Control.Arrow (first)+import Control.Exception+import Control.Monad+import Data.ByteString (ByteString)+import Data.Char (isUpper, toUpper)+import Data.Data (Data, Typeable)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe+import Data.MessagePack+import Data.Monoid+import qualified Data.Set as Set+import Data.Text (Text)+import qualified Data.Text as T+import Data.Vector (Vector)+import Prettyprinter (viaShow)+import UnliftIO (STM)+import UnliftIO.Exception++import Prelude++{- | Generate the API types and functions provided by @nvim --api-info@.++ The provided map allows the use of different Haskell types for the types+ defined in the API. The types must be an instance of 'NvimObject' and they+ must form an isomorphism with the sent messages types. Currently, it+ provides a Convenient way to replace the /String/ type with 'Text',+ 'ByteString' or 'String'.+-}+generateAPI :: TypeMap -> Q [Dec]+generateAPI typeMap = do+ api <- either (fail . show) return =<< runIO parseAPI+ let exceptionName = mkName "NeovimExceptionGen"+ exceptions = (\(n, i) -> (mkName ("Neovim" <> n), i)) `map` errorTypes api+ customTypesN = first mkName `map` customTypes api+ join+ <$> sequence+ [ join . pure <$> createDataTypeWithByteStringComponent exceptionName (map fst exceptions)+ , exceptionInstance exceptionName+ , customTypeInstance exceptionName exceptions+ , fmap join (mapM ((\n -> createDataTypeWithByteStringComponent n [n]) . fst) customTypesN)+ , join <$> mapM (\(n, i) -> customTypeInstance n [(n, i)]) customTypesN+ , fmap join . mapM (createFunction typeMap) $ functions api+ ]++-- | Maps type identifiers from the neovim API to Haskell types.+data TypeMap = TypeMap+ { typesOfAPI :: Map String (Q Type)+ , list :: Q Type+ }++stringListTypeMap :: TypeMap+stringListTypeMap =+ TypeMap+ { typesOfAPI =+ Map.fromList+ [ ("Boolean", [t|Bool|])+ , ("Integer", [t|Int64|])+ , ("LuaRef", [t|Int64|])+ , ("Float", [t|Double|])+ , ("String", [t|String|])+ , ("Array", [t|[Object]|])+ , ("Dict", [t|Map String Object|])+ , ("Dictionary", [t|Map String Object|])+ , ("void", [t|()|])+ ]+ , list = listT+ }++textVectorTypeMap :: TypeMap+textVectorTypeMap =+ stringListTypeMap+ { typesOfAPI = adjustTypeMapForText $ typesOfAPI stringListTypeMap+ , list = [t|Vector|]+ }+ where+ adjustTypeMapForText =+ Map.insert "String" [t|Text|]+ . Map.insert "Array" [t|Vector Object|]+ . Map.insert "Dict" [t|Map Text Object|]+ . Map.insert "Dictionary" [t|Map Text Object|]++bytestringVectorTypeMap :: TypeMap+bytestringVectorTypeMap =+ textVectorTypeMap+ { typesOfAPI = adjustTypeMapForByteString $ typesOfAPI textVectorTypeMap+ }+ where+ adjustTypeMapForByteString =+ Map.insert "String" [t|ByteString|]+ . Map.insert "Array" [t|Vector Object|]+ . Map.insert "Dict" [t|Map ByteString Object|]+ . Map.insert "Dictionary" [t|Map ByteString Object|]++apiTypeToHaskellType :: TypeMap -> NeovimType -> Q Type+apiTypeToHaskellType typeMap@TypeMap{typesOfAPI, list} at = case at of+ Void -> [t|()|]+ NestedType t Nothing ->+ appT list $ apiTypeToHaskellType typeMap t+ NestedType t (Just n) ->+ foldl appT (tupleT n) . replicate n $ apiTypeToHaskellType typeMap t+ SimpleType t ->+ fromMaybe ((conT . mkName) t) $ Map.lookup t typesOfAPI++{- | This function will create a wrapper function with neovim's function name+ as its name.++ Synchronous function:+ @+ buffer_get_number :: Buffer -> Neovim Int64+ buffer_get_number buffer = scall "buffer_get_number" [toObject buffer]+ @++ Asynchronous function:+ @+ vim_eval :: String -> Neovim (TMVar Object)+ vim_eval str = acall "vim_eval" [toObject str]+ @++ Asynchronous function without a return value:+ @+ vim_feed_keys :: String -> String -> Bool -> Neovim ()+ vim_feed_keys keys mode escape_csi =+ acallVoid "vim_feed_keys" [ toObject keys+ , toObject mode+ , toObject escape_csi+ ]+ @+-}+createFunction :: TypeMap -> NeovimFunction -> Q [Dec]+createFunction typeMap nf = do+ let withDeferred+ | async nf = appT [t|STM|] . appT [t|Either NeovimException|]+ | otherwise = id++ callFn+ | async nf = [|acall|]+ | otherwise = [|scall'|]++ functionName = mkName $ name nf+ toObjVar v = [|toObject $(varE v)|]++ let env = mkName "env"+ retType <- appT [t|Neovim $(varT env)|]+ . withDeferred+ . apiTypeToHaskellType typeMap+ $ returnType nf++ -- prefix with arg0_, arg1_ etc. to prevent generated code from crashing due+ -- to keywords being used.+ -- see https://github.com/neovimhaskell/nvim-hs/issues/65+ let prefixWithNumber i n = "arg" ++ show i ++ "_" ++ n+ applyPrefixWithNumber =+ zipWith+ (\i (t, n) -> (t, prefixWithNumber i n))+ [0 :: Int ..]+ . parameters+ vars <-+ mapM+ ( \(t, n) ->+ (,)+ <$> apiTypeToHaskellType typeMap t+ <*> newName n+ )+ $ applyPrefixWithNumber nf++ sequence+ [ (sigD functionName . return)+ . ForallT [specifiedPlainTV env] []+ $ foldr ((AppT . AppT ArrowT) . fst) retType vars+ , funD+ functionName+ [ clause+ (map (varP . snd) vars)+ ( normalB+ ( callFn+ `appE` ([|(F . T.pack)|] `appE` (litE . stringL . name) nf)+ `appE` listE (map (toObjVar . snd) vars)+ )+ )+ []+ ]+ ]++{- | @ createDataTypeWithObjectComponent SomeName [Foo,Bar]@+ will create this:+ @+ data SomeName = Foo !Object+ | Bar !Object+ deriving (Typeable, Eq, Show)+ @+-}+createDataTypeWithByteStringComponent :: Name -> [Name] -> Q [Dec]+createDataTypeWithByteStringComponent nme cs = do+ tObject <- [t|ByteString|]++ let strictNess = (Bang NoSourceUnpackedness SourceStrict, tObject)++ pure+ [ dataD+ []+ nme+ []+ (map (\n -> NormalC n [strictNess]) cs)+ (mkName <$> ["Typeable", "Eq", "Show", "Generic"])+ , instanceD [] (AppT (ConT (mkName "NFData")) (ConT nme)) []+ ]++{- | If the first parameter is @mkName NeovimException@, this function will+ generate @instance Exception NeovimException@.+-}+exceptionInstance :: Name -> Q [Dec]+exceptionInstance exceptionName = do+ tException <- [t|Exception|]+ pure [instanceD [] (tException `AppT` ConT exceptionName) []]++{- | @customTypeInstance Foo [(Bar, 1), (Quz, 2)]@+ will create this:+ @+ instance Serializable Foo where+ toObject (Bar bs) = ObjectExt 1 bs+ toObject (Quz bs) = ObjectExt 2 bs+ fromObject (ObjectExt 1 bs) = return $ Bar bs+ fromObject (ObjectExt 2 bs) = return $ Quz bs+ fromObject o = Left $ "Object is not convertible to: Foo Received: " <> show o+ @+-}+customTypeInstance :: Name -> [(Name, Int64)] -> Q [Dec]+customTypeInstance typeName nis = do+ let fromObjectClause :: Name -> Int64 -> Q Clause+ fromObjectClause n i = do+ bs <- newName "bs"+ let objectExtMatch =+ conP+ (mkName "ObjectExt")+ [(LitP . integerL . fromIntegral) i, VarP bs]+ clause+ [pure objectExtMatch]+ (normalB [|return $ $(conE n) $(varE bs)|])+ []+ fromObjectErrorClause :: Q Clause+ fromObjectErrorClause = do+ o <- newName "o"+ let n = nameBase typeName+ clause+ [varP o]+ ( normalB+ [|+ throwError $+ pretty "Object is not convertible to:"+ <+> viaShow n+ <+> pretty "Received:"+ <+> viaShow $(varE o)+ |]+ )+ []++ toObjectClause :: Name -> Int64 -> Q Clause+ toObjectClause n i = do+ bs <- newName "bs"+ clause+ [pure (conP n [VarP bs])]+ (normalB [|ObjectExt $((litE . integerL . fromIntegral) i) $(varE bs)|])+ []++ tNvimObject <- [t|NvimObject|]+ fToObject <- funD (mkName "toObject") $ map (uncurry toObjectClause) nis+ fFromObject <- funD (mkName "fromObject") $ map (uncurry fromObjectClause) nis <> [fromObjectErrorClause]+ pure [instanceD [] (tNvimObject `AppT` ConT typeName) [fToObject, fFromObject]]++{- | Define an exported function by providing a custom name and referencing the+ function you want to export.++ Note that the name must start with an upper case letter.++ Example: @ $(function \"MyExportedFunction\" 'myDefinedFunction) 'Sync' @+-}+function :: String -> Name -> Q Exp+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 capital letter: " <> show customName+ | otherwise = do+ (_, fun) <- functionImplementation functionName+ [|\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 = function (uppercaseFirstCharacter functionName) functionName++{- | Simply data type used to identify a string-ish type (e.g. 'String', 'Text',+ 'ByteString' for a value of type.+-}+data ArgType+ = StringyType+ | ListOfStringyTypes+ | Optional ArgType+ | CommandArgumentsType+ | OtherType+ deriving (Eq, Ord, Show, Read)++{- | Given a value of type 'Type', test whether it can be classified according+ to the constructors of "ArgType".+-}+classifyArgType :: Type -> Q ArgType+classifyArgType t = do+ set <- genStringTypesSet+ maybeType <- [t|Maybe|]+ cmdArgsType <- [t|CommandArguments|]+ case t of+ AppT ListT (ConT str)+ | str `Set.member` set ->+ return ListOfStringyTypes+ AppT m mt@(ConT _)+ | m == maybeType ->+ Optional <$> classifyArgType mt+ ConT str+ | str `Set.member` set ->+ return StringyType+ cmd+ | cmd == cmdArgsType ->+ return CommandArgumentsType+ _ -> return OtherType+ where+ genStringTypesSet = do+ types <- sequence [[t|String|], [t|ByteString|], [t|Text|]]+ return $ Set.fromList [n | ConT n <- types]++{- | Similarly to 'function', this function is used to export a command with a+ custom name.++ Note that commands must start with an upper case letter.++ Due to limitations on the side of (neo)vim, commands can only have one of the+ following five signatures, where you can replace 'String' with 'ByteString'+ or 'Text' if you wish:++ * 'CommandArguments' -> 'Neovim' env ()++ * 'CommandArguments' -> 'Maybe' 'String' -> 'Neovim' env ()++ * 'CommandArguments' -> 'String' -> 'Neovim' env ()++ * 'CommandArguments' -> ['String'] -> 'Neovim' env ()++ * 'CommandArguments' -> 'String' -> ['String'] -> 'Neovim' env ()++ Example: @ $(command \"RememberThePrime\" 'someFunction) ['CmdBang'] @++ Note that the list of command options (i.e. the last argument) removes+ duplicate options by means of some internally convenient sorting. You should+ simply not define the same option twice.+-}+command :: String -> Name -> Q Exp+command [] _ = error "Empty names are not allowed for exported commands."+command customFunctionName@(c : _) functionName+ | (not . isUpper) c = error $ "Custom command name must start with a capital letter: " <> show customFunctionName+ | otherwise = do+ (argTypes, fun) <- functionImplementation functionName+ -- See :help :command-nargs for what the result strings mean+ case argTypes of+ (CommandArgumentsType : _) -> return ()+ _ -> error "First argument for a function exported as a command must be CommandArguments!"+ let nargs = case tail argTypes of+ [] -> [|CmdNargs "0"|]+ [StringyType] -> [|CmdNargs "1"|]+ [Optional StringyType] -> [|CmdNargs "?"|]+ [ListOfStringyTypes] -> [|CmdNargs "*"|]+ [StringyType, ListOfStringyTypes] -> [|CmdNargs "+"|]+ _ ->+ error $+ unlines+ [ "Trying to generate a command without compatible types."+ , "Due to a limitation burdened on us by vimL, we can only"+ , "use a limited amount type signatures for commands. See"+ , "the documentation for 'command' for a more thorough"+ , "explanation."+ ]+ [|+ \copts ->+ EF+ ( Command+ (F (T.pack $(litE (StringL customFunctionName))))+ (mkCommandOptions ($(nargs) : copts))+ , $(return fun)+ )+ |]++{- | Define an exported command. This function works exactly like 'command', but+ it generates the command name by converting the first letter to upper case.+-}+command' :: Name -> Q Exp+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+ fully applied function and pass it as an argument. If you have to add+ autocmds dynamically, it can be done with 'addAutocmd'.++ Example:++ @+ someFunction :: a -> b -> c -> d -> Neovim r st res+ someFunction = ...++ theFunction :: Neovim r st res+ theFunction = someFunction 1 2 3 4+-}++{- $(autocmd 'theFunction) def+ @++ @def@ is of type 'AutocmdOptions'.++ Note that you have to define @theFunction@ in a different module due to+ the use of Template Haskell.+-}++autocmd :: Name -> Q Exp+autocmd functionName = do+ (as, fun) <- functionImplementation functionName+ case as of+ [] ->+ [|\t sync acmdOpts -> EF (Autocmd t (F (T.pack $(litE (StringL (uppercaseFirstCharacter functionName))))) sync acmdOpts, $(return fun))|]+ _ ->+ error "Autocmd functions have to be fully applied (i.e. they should not take any arguments)."++{- | Generate a function of type @[Object] -> Neovim' Object@ from the argument+ function.++ The function+ @+ add :: Int -> Int -> Int+ add = (+)+ @+ will be converted to+ @+ \args -> case args of+ [x,y] -> case pure add <*> fromObject x <*> fromObject y of+ Left e -> err $ "Wrong type of arguments for add: " ++ e+ Right action -> toObject <$> action+ _ -> err $ "Wrong number of arguments for add: " ++ show xs+ @+-}+functionImplementation :: Name -> Q ([ArgType], Exp)+functionImplementation functionName = do+ fInfo <- reify functionName+ nargs <- mapM classifyArgType $ case fInfo of+ VarI _ functionType _ ->+ determineNumberOfArguments functionType+ x ->+ error $ "Value given to function is (likely) not the name of a function.\n" <> show x++ e <- topLevelCase nargs+ return (nargs, e)+ where+ determineNumberOfArguments :: Type -> [Type]+ determineNumberOfArguments ft = case ft of+ ForallT _ _ t -> determineNumberOfArguments t+ AppT (AppT ArrowT t) r -> t : determineNumberOfArguments r+ _ -> []+ -- \args -> case args of ...+ topLevelCase :: [ArgType] -> Q Exp+ topLevelCase ts = do+ let n = length ts+ minLength = length [() | Optional _ <- reverse ts]+ args <- newName "args"+ lamE+ [varP args]+ ( caseE+ (varE args)+ (zipWith matchingCase [n, n - 1 ..] [0 .. minLength] ++ [errorCase])+ )++ -- _ -> err "Wrong number of arguments"+ errorCase :: Q Match+ errorCase =+ match+ wildP+ ( normalB+ [|+ throw . ErrorMessage . pretty $+ "Wrong number of arguments for function: "+ ++ $(litE (StringL (nameBase functionName)))+ |]+ )+ []++ -- [x,y] -> case pure add <*> fromObject x <*> fromObject y of ...+ matchingCase :: Int -> Int -> Q Match+ matchingCase n x = do+ vars <- mapM (\_ -> Just <$> newName "x") [1 .. n]+ let optVars = replicate x (Nothing :: Maybe Name)+ match+ ((listP . map varP . catMaybes) vars)+ ( normalB+ ( caseE+ ( foldl+ genArgumentCast+ [|pure $(varE functionName)|]+ (zip (vars ++ optVars) (repeat [|(<*>)|]))+ )+ [successfulEvaluation, failedEvaluation]+ )+ )+ []++ genArgumentCast :: Q Exp -> (Maybe Name, Q Exp) -> Q Exp+ genArgumentCast e = \case+ (Just v, op) ->+ infixE (Just e) op (Just [|fromObject $(varE v)|])+ (Nothing, op) ->+ infixE (Just e) op (Just [|pure Nothing|])++ successfulEvaluation :: Q Match+ successfulEvaluation =+ newName "action" >>= \action ->+ match+ (pure (conP (mkName "Right") [VarP action]))+ (normalB [|toObject <$> $(varE action)|])+ []+ failedEvaluation :: Q Match+ failedEvaluation =+ newName "e" >>= \e ->+ match+ (pure (conP (mkName "Left") [VarP e]))+ (normalB [|err ($(varE e) :: Doc AnsiStyle)|])+ []
+ src/Neovim/API/Text.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE NoOverloadedStrings #-}++{- |+Module : Neovim.API.Text+Description : Text based API+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.API.Text where++import Neovim.API.TH++$(generateAPI textVectorTypeMap)
+ src/Neovim/Classes.hs view
@@ -0,0 +1,454 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++{- |+Module : Neovim.Classes+Description : Type classes used for conversion of msgpack and Haskell types+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.Classes (+ NvimObject (..),+ Dictionary,+ (+:),+ Generic,+ docToObject,+ docFromObject,+ docToText,+ Doc,+ AnsiStyle,+ Pretty (..),+ (<+>),+ module Data.Int,+ module Data.Word,+ module Control.DeepSeq,+) where++import Neovim.Exceptions (NeovimException (..))++import Control.Applicative (Applicative (liftA2))+import Control.Arrow ((***))+import Control.DeepSeq (NFData)+import Control.Monad ()+import Control.Monad.Except (+ MonadError (throwError),+ )+import Control.Monad.IO.Class (MonadIO)+import Data.ByteString (ByteString)+import Data.Int (+ Int16,+ Int32,+ Int64,+ Int8,+ )+import qualified Data.Map.Strict as SMap+import Data.MessagePack+import Data.Monoid+import Data.Text as Text (Text)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Word (+ Word,+ Word16,+ Word32,+ Word64,+ Word8,+ )+import GHC.Generics (Generic)+import Prettyprinter (+ Doc,+ Pretty (..),+ defaultLayoutOptions,+ layoutPretty,+ viaShow,+ (<+>),+ )+import qualified Prettyprinter as P+import Prettyprinter.Render.Terminal (+ AnsiStyle,+ renderStrict,+ )++import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import UnliftIO.Exception (throwIO)++import Prelude++infixr 5 +:++{- | Convenient operator to create a list of 'Object' from normal values.+ @+ values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []+ @+-}+(+:) :: (NvimObject o) => o -> [Object] -> [Object]+o +: os = toObject o : os++{- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience+ method to transport error message from and to neovim. It generally does not+ hold that 'docToObject . docFromObject' = 'id'.+-}+docToObject :: Doc AnsiStyle -> Object+docToObject = ObjectString . encodeUtf8 . docToText++-- | See 'docToObject'.+docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle)+docFromObject o = (P.viaShow :: Text -> Doc AnsiStyle) <$> fromObject o++docToText :: Doc AnsiStyle -> Text+docToText = renderStrict . layoutPretty defaultLayoutOptions++{- | A generic vim dictionary is a simply a map from strings to objects. This+ type alias is sometimes useful as a type annotation especially if the+ OverloadedStrings extension is enabled.+-}+type Dictionary = SMap.Map ByteString Object++{- | Conversion from 'Object' files to Haskell types and back with respect+ to neovim's interpretation.++ The 'NFData' constraint has been added to allow forcing results of function+ evaluations in order to catch exceptions from pure code. This adds more+ stability to the plugin provider and seems to be a cleaner approach.+-}+class NFData o => NvimObject o where+ toObject :: o -> Object++ fromObjectUnsafe :: Object -> o+ fromObjectUnsafe o = case fromObject o of+ Left e ->+ error . show $+ "Not the expected object:"+ <+> P.viaShow o+ <+> P.lparen <> e <> P.rparen+ Right obj -> obj++ fromObject :: Object -> Either (Doc AnsiStyle) o+ fromObject = return . fromObjectUnsafe++ fromObject' :: (MonadIO io) => Object -> io o+ fromObject' = either (throwIO . ErrorMessage) return . fromObject++ {-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-}++-- Instances for NvimObject {{{1+instance NvimObject () where+ toObject _ = ObjectNil++ fromObject ObjectNil = return ()+ fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o++-- We may receive truthy values from neovim, so we should be more forgiving+-- here.+instance NvimObject Bool where+ toObject = ObjectBool++ fromObject (ObjectBool o) = return o+ fromObject (ObjectInt 0) = return False+ fromObject (ObjectUInt 0) = return False+ fromObject ObjectNil = return False+ fromObject (ObjectBinary "0") = return False+ fromObject (ObjectBinary "") = return False+ fromObject (ObjectString "0") = return False+ fromObject (ObjectString "") = return False+ fromObject _ = return True++instance NvimObject Double where+ toObject = ObjectDouble++ fromObject (ObjectDouble o) = return o+ fromObject (ObjectFloat o) = return $ realToFrac o+ fromObject (ObjectInt o) = return $ fromIntegral o+ fromObject (ObjectUInt o) = return $ fromIntegral o+ fromObject o =+ throwError $+ "Expected ObjectDouble, but got"+ <+> viaShow o++instance NvimObject Integer where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt o) = return $ toInteger o+ fromObject (ObjectUInt o) = return $ toInteger o+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o++instance NvimObject Int64 where+ toObject = ObjectInt++ fromObject (ObjectInt i) = return i+ fromObject (ObjectUInt o) = return $ fromIntegral o+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Int32 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Int16 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Int8 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Word where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Word64 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Word32 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Word16 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Word8 where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance NvimObject Int where+ toObject = ObjectInt . fromIntegral++ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o++instance {-# OVERLAPPING #-} NvimObject [Char] where+ toObject = ObjectBinary . UTF8.fromString++ fromObject (ObjectBinary o) = return $ UTF8.toString o+ fromObject (ObjectString o) = return $ UTF8.toString o+ fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o++instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where+ toObject = ObjectArray . map toObject++ fromObject (ObjectArray os) = mapM fromObject os+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance NvimObject o => NvimObject (Maybe o) where+ toObject = maybe ObjectNil toObject++ fromObject ObjectNil = return Nothing+ fromObject o = either throwError (return . Just) $ fromObject o++instance NvimObject o => NvimObject (Vector o) where+ toObject = ObjectArray . V.toList . V.map toObject++ fromObject (ObjectArray os) = V.fromList <$> mapM fromObject os+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++-- | Right-biased instance for toObject.+instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where+ toObject = either toObject toObject++ fromObject o = case fromObject o of+ Right r ->+ return $ Right r+ Left e1 -> case fromObject o of+ Right l ->+ return $ Left l+ Left e2 ->+ throwError $ e1 <+> "--" <+> e2++instance+ (Ord key, NvimObject key, NvimObject val) =>+ NvimObject (SMap.Map key val)+ where+ toObject =+ ObjectMap+ . SMap.fromList+ . map (toObject *** toObject)+ . SMap.toList++ fromObject (ObjectMap om) =+ SMap.fromList+ <$> ( traverse+ ( uncurry (liftA2 (,))+ . (fromObject *** fromObject)+ )+ . SMap.toList+ )+ om+ fromObject o = throwError $ "Expected ObjectMap, but got" <+> viaShow o++instance NvimObject Text where+ toObject = ObjectBinary . encodeUtf8++ fromObject (ObjectBinary o) = return $ decodeUtf8 o+ fromObject (ObjectString o) = return $ decodeUtf8 o+ fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o++instance NvimObject ByteString where+ toObject = ObjectBinary++ fromObject (ObjectBinary o) = return o+ fromObject (ObjectString o) = return o+ fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o++instance NvimObject Object where+ toObject = id++ fromObject = return+ fromObjectUnsafe = id++-- By the magic of vim, i will create these.+instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where+ toObject (o1, o2) = ObjectArray [toObject o1, toObject o2]++ fromObject (ObjectArray [o1, o2]) =+ (,)+ <$> fromObject o1+ <*> fromObject o2+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where+ toObject (o1, o2, o3) = ObjectArray [toObject o1, toObject o2, toObject o3]++ fromObject (ObjectArray [o1, o2, o3]) =+ (,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where+ toObject (o1, o2, o3, o4) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4]++ fromObject (ObjectArray [o1, o2, o3, o4]) =+ (,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where+ toObject (o1, o2, o3, o4, o5) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5]++ fromObject (ObjectArray [o1, o2, o3, o4, o5]) =+ (,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where+ toObject (o1, o2, o3, o4, o5, o6) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6]++ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) =+ (,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) where+ toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7]++ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) =+ (,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8) where+ toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8]++ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) =+ (,,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7+ <*> fromObject o8+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8, NvimObject o9) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) where+ toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8, toObject o9]++ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) =+ (,,,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7+ <*> fromObject o8+ <*> fromObject o9+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o++-- 1}}}
+ src/Neovim/Compat/Megaparsec.hs view
@@ -0,0 +1,30 @@+{-# LANGUAGE CPP #-}+module Neovim.Compat.Megaparsec+ ( Parser+ , module X+#if MIN_VERSION_megaparsec(7,0,0)+ , anyChar+#endif+ ) where+++import Text.Megaparsec as X++#if MIN_VERSION_megaparsec(6,0,0)++import Data.Void+import Text.Megaparsec.Char as X++type Parser = Parsec Void String++#else++import Text.Megaparsec.String as X++#endif++#if MIN_VERSION_megaparsec(7,0,0)+anyChar :: Parser Char+anyChar = anySingle+#endif+
+ src/Neovim/Config.hs view
@@ -0,0 +1,31 @@+{- |+Module : Neovim.Config+Description : The user editable and compilable configuration+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.Config (+ NeovimConfig (..),+ module System.Log,+) where++import Neovim.Context (Neovim)+import Neovim.Plugin.Internal (NeovimPlugin)++import System.Log (Priority (..))++{- | This data type contains information about the configuration of neovim. See+ the fields' documentation for what you possibly want to change. Also, the+ tutorial in the "Neovim" module should get you started.+-}+data NeovimConfig = Config+ { -- | The list of plugins. The IO type inside the list allows the plugin+ -- author to run some arbitrary startup code before creating a value of+ -- type 'NeovimPlugin'.+ plugins :: [Neovim () NeovimPlugin]+ , -- | Set the general logging options.+ logOptions :: Maybe (FilePath, Priority)+ }
+ src/Neovim/Context.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE LambdaCase #-}+{- |+Module : Neovim.Context+Description : The Neovim context+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.Context (+ newUniqueFunctionName,+ Neovim,+ NeovimException (..),+ exceptionToDoc,+ FunctionMap,+ FunctionMapEntry,+ mkFunctionMap,+ runNeovim,+ err,+ errOnInvalidResult,+ restart,+ quit,+ subscribe,+ unsubscribe,+ ask,+ asks,+ get,+ gets,+ put,+ modify,+ Doc,+ AnsiStyle,+ docToText,+ throwError,+ module Control.Monad.IO.Class,+) 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++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++-- | 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
+ src/Neovim/Context/Internal.hs view
@@ -0,0 +1,348 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Context.Internal+Description : Abstract description of the plugin provider's internal context+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC++To shorten function and data type names, import this qualfied as @Internal@.+-}+module Neovim.Context.Internal where++import Neovim.Classes (+ AnsiStyle,+ Doc,+ NFData,+ Pretty (pretty),+ )+import Neovim.Exceptions (+ NeovimException (..),+ exceptionToDoc,+ )+import Neovim.Plugin.Classes (+ FunctionName (..),+ FunctionalityDescription,+ HasFunctionName (nvimMethod),+ NeovimEventId (..),+ NvimMethod,+ Subscription (..),+ SubscriptionId (..),+ )+import Neovim.Plugin.IPC (SomeMessage)++import Control.Monad.IO.Class (MonadIO)+import Data.Functor (void)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.MessagePack (Object)+import Data.Monoid (Ap (Ap))+import Data.Text (Text, pack)+import System.Log.Logger (errorM)+import UnliftIO (+ Exception (fromException),+ Handler (..),+ MVar,+ MonadIO (..),+ MonadUnliftIO,+ SomeException,+ TMVar,+ TQueue,+ TVar,+ atomically,+ catches,+ modifyTVar',+ newEmptyMVar,+ newEmptyTMVarIO,+ newTMVarIO,+ newTQueueIO,+ newTVarIO,+ putTMVar,+ readTVar,+ takeTMVar,+ throwIO,+ try,+ )++import Prettyprinter (viaShow)++import Conduit (MonadThrow)+import Control.Exception (+ ArithException,+ ArrayException,+ ErrorCall,+ PatternMatchFail,+ )+import qualified Control.Monad.Fail as Fail+import Control.Monad.Reader (+ MonadReader (ask, local),+ ReaderT (..),+ asks,+ )+import Prelude+import Control.DeepSeq (deepseq)++{- | This is the environment in which all plugins are initially started.++ Functions have to run in this transformer stack to communicate with neovim.+ If parts of your own functions dont need to communicate with neovim, it is+ good practice to factor them out. This allows you to write tests and spot+ errors easier. Essentially, you should treat this similar to 'IO' in general+ haskell programs.+-}+newtype Neovim env a = Neovim+ {unNeovim :: ReaderT (Config env) IO a}+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)+ deriving (Semigroup, Monoid) via (Ap (Neovim env) a)++-- | User facing instance declaration for the reader state.+instance MonadReader env (Neovim env) where+ ask = Neovim $ asks customConfig+ local f (Neovim a) = do+ r <- Neovim ask+ liftIO $ runReaderT a (r{customConfig = f (customConfig r)})++instance Fail.MonadFail (Neovim env) where+ fail = throwIO . ErrorMessage . pretty++-- | Same as 'ask' for the 'InternalConfig'.+ask' :: Neovim env (Config env)+ask' = Neovim ask++-- | Same as 'asks' for the 'InternalConfig'.+asks' :: (Config env -> a) -> Neovim env a+asks' = Neovim . asks++exceptionHandlers :: [Handler IO (Either (Doc ann) a)]+exceptionHandlers =+ [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)"+ , Handler $ \(_ :: ArrayException) -> ret "ArrayException"+ , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error"+ , Handler $ \(_ :: PatternMatchFail) -> ret "Pattern match failure"+ , Handler $ \(_ :: SomeException) -> ret "Unhandled exception"+ ]+ where+ ret = return . Left++-- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.+runNeovim ::+ NFData a =>+ Config env ->+ Neovim env a ->+ IO (Either (Doc AnsiStyle) a)+runNeovim = runNeovimInternal (\a -> a `deepseq` return a)++runNeovimInternal ::+ (a -> IO a) ->+ Config env ->+ Neovim env a ->+ IO (Either (Doc AnsiStyle) a)+runNeovimInternal f r (Neovim a) =+ (try . runReaderT a) r >>= \case+ Left e -> case fromException e of+ Just e' ->+ return . Left . exceptionToDoc $ (e' :: NeovimException)+ Nothing -> do+ liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e+ (return . Left . viaShow) e+ Right res ->+ (Right <$> f res) `catches` exceptionHandlers++{- | Create a new unique function name. To prevent possible name clashes, digits+ are stripped from the given suffix.+-}+newUniqueFunctionName :: Neovim env FunctionName+newUniqueFunctionName = do+ tu <- asks' uniqueCounter+ -- reverseing the integer string should distribute the first character more+ -- evently and hence cause faster termination for comparisons.+ fmap (F . pack . reverse . show) . liftIO . atomically $ do+ u <- readTVar tu+ modifyTVar' tu succ+ return u++{- | This data type is used to dispatch a remote function call to the appopriate+ recipient.+-}+newtype FunctionType+ = -- | 'Stateful' functions are handled within a special thread, the 'TQueue'+ -- is the communication endpoint for the arguments we have to pass.+ Stateful (TQueue SomeMessage)++instance Pretty FunctionType where+ pretty = \case+ Stateful _ -> "\\os -> Neovim env o"++-- | Type of the values stored in the function map.+type FunctionMapEntry = (FunctionalityDescription, FunctionType)++{- | A function map is a map containing the names of functions as keys and some+ context dependent value which contains all the necessary information to+ execute that function in the intended way.++ This type is only used internally and handles two distinct cases. One case+ is a direct function call, wich is simply a function that accepts a list of+ 'Object' values and returns a result in the 'Neovim' context. The second+ case is calling a function that has a persistent state. This is mediated to+ a thread that reads from a 'TQueue'. (NB: persistent currently means, that+ state is stored for as long as the plugin provider is running and not+ restarted.)+-}+type FunctionMap = Map NvimMethod FunctionMapEntry++-- | Create a new function map from the given list of 'FunctionMapEntry' values.+mkFunctionMap :: [FunctionMapEntry] -> FunctionMap+mkFunctionMap = Map.fromList . map (\e -> (nvimMethod (fst e), e))++data Subscriptions = Subscriptions+ { nextSubscriptionId :: SubscriptionId+ , byEventId :: Map NeovimEventId [Subscription]+ }++{- | Subscribe to an event. When the event is received, the given callback function+ is run. It is usually necessary to call the appropriate API function in order for+ /neovim/ to send the notifications to /nvim-hs/. The returned subscription can be+ used to 'unsubscribe'.+-}+subscribe :: Text -> ([Object] -> Neovim env ()) -> Neovim env Subscription+subscribe event action = do+ let eventId = NeovimEventId event+ cfg <- ask'+ let subscriptions' = subscriptions cfg+ atomically $ do+ s <- takeTMVar subscriptions'+ let subscriptionId = nextSubscriptionId s+ let newSubscription =+ Subscription+ { subId = subscriptionId+ , subEventId = eventId+ , subAction = void . runNeovim cfg . action+ }+ putTMVar+ subscriptions'+ s+ { nextSubscriptionId = succ subscriptionId+ , byEventId = Map.insertWith (<>) eventId [newSubscription] (byEventId s)+ }+ pure newSubscription++-- | Remove the subscription that has been returned by 'subscribe'.+unsubscribe :: Subscription -> Neovim env ()+unsubscribe subscription = do+ subscriptions' <- asks' subscriptions+ void . atomically $ do+ s <- takeTMVar subscriptions'+ let eventId = subEventId subscription+ deleteSubscription = Just . filter ((/= subId subscription) . subId)+ putTMVar+ subscriptions'+ s+ { byEventId = Map.update deleteSubscription eventId (byEventId s)+ }++{- | A wrapper for a reader value that contains extra fields required to+ communicate with the messagepack-rpc components and provide necessary data to+ provide other globally available operations.++ Note that you most probably do not want to change the fields prefixed with an+ underscore.+-}+data Config env = Config+ -- Global settings; initialized once+ { eventQueue :: TQueue SomeMessage+ -- ^ A queue of messages that the event handler will propagate to+ -- appropriate threads and handlers.+ , transitionTo :: MVar StateTransition+ -- ^ The main thread will wait for this 'MVar' to be filled with a value+ -- and then perform an action appropriate for the value of type+ -- 'StateTransition'.+ , providerName :: TMVar (Either String Int)+ -- ^ Since nvim-hs must have its "Neovim.RPC.SocketReader" and+ -- "Neovim.RPC.EventHandler" running to determine the actual channel id+ -- (i.e. the 'Int' value here) this field can only be set properly later.+ -- Hence, the value of this field is put in an 'TMVar'.+ -- Name that is used to identify this provider. Assigning such a name is+ -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).+ , uniqueCounter :: TVar Integer+ -- ^ This 'TVar' is used to generate uniqe function names on the side of+ -- /nvim-hs/. This is useful if you don't want to overwrite existing+ -- functions or if you create autocmd functions.+ , globalFunctionMap :: TMVar FunctionMap+ -- ^ This map is used to dispatch received messagepack function calls to+ -- it's appropriate targets.+ , -- Local settings; intialized for each stateful component++ pluginSettings :: Maybe (PluginSettings env)+ -- ^ In a registered functionality this field contains a function (and+ -- possibly some context dependent values) to register new functionality.+ , subscriptions :: TMVar Subscriptions+ -- ^ Plugins can dynamically subscribe to events that neovim sends.+ , customConfig :: env+ -- ^ Plugin author supplyable custom configuration. Queried on the+ -- user-facing side with 'ask' or 'asks'.+ }++{- | Convenient helper to create a new config for the given state and read-only+ config.++ Sets the 'pluginSettings' field to 'Nothing'.+-}+retypeConfig :: env -> Config anotherEnv -> Config env+retypeConfig r cfg = cfg{pluginSettings = Nothing, customConfig = r}++{- | This GADT is used to share information between stateless and stateful+ plugin threads since they work fundamentally in the same way. They both+ contain a function to register some functionality in the plugin provider+ as well as some values which are specific to the one or the other context.+-}+data PluginSettings env where+ StatefulSettings ::+ ( FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ Neovim env (Maybe FunctionMapEntry)+ ) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ PluginSettings env++{- | Create a new 'InternalConfig' object by providing the minimal amount of+ necessary information.++ This function should only be called once per /nvim-hs/ session since the+ arguments are shared across processes.+-}+newConfig :: IO (Maybe String) -> IO env -> IO (Config env)+newConfig ioProviderName r =+ Config+ <$> newTQueueIO+ <*> newEmptyMVar+ <*> (maybe newEmptyTMVarIO (newTMVarIO . Left) =<< ioProviderName)+ <*> newTVarIO 100+ <*> newEmptyTMVarIO+ <*> pure Nothing+ <*> newTMVarIO (Subscriptions (SubscriptionId 1) mempty)+ <*> r++-- | The state that the plugin provider wants to transition to.+data StateTransition+ = -- | Quit the plugin provider.+ Quit+ | -- | Restart the plugin provider.+ Restart+ | -- | The plugin provider failed to start or some other error occured.+ Failure (Doc AnsiStyle)+ | -- | The plugin provider started successfully.+ InitSuccess+ deriving (Show)
+ src/Neovim/Debug.hs view
@@ -0,0 +1,229 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Debug+Description : Utilities to debug Neovim and nvim-hs functionality+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+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++{- | Run a 'Neovim' function.++ This function connects to the socket pointed to by the environment variable+ @$NVIM@ and executes the command. It does not register itself+ as a real plugin provider, you can simply call neovim-functions from the+ module "Neovim.API.String" this way.++ Tip: If you run a terminal inside a neovim instance, then this variable is+ automatically set.+-}+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."++{- | Run a 'Neovim'' function.++ @+ debug' = debug ()+ @++ See documentation for 'debug'.+-}+debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a)+debug' = debug ()++{- | Simple datatype storing neccessary information to start, stop and reload a+ set of plugins. This is passed to most of the functions in this module for+ storing state even when the ghci-session has been reloaded.+-}+data NvimHSDebugInstance = NvimHSDebugInstance+ { threads :: [Async ()]+ , neovimConfig :: NeovimConfig+ , internalConfig :: Internal.Config RPCConfig+ }++{- | This function is intended to be run _once_ in a ghci session that to+ give a REPL based workflow when developing a plugin.++ Note that the dyre-based reload mechanisms, i.e. the+ "Neovim.Plugin.ConfigHelper" plugin, is not started this way.++ To use this in ghci, you simply bind the results to some variables. After+ each reload of ghci, you have to rebind those variables.++ Example:++ @+ λ di <- 'develMain' 'Nothing'++ λ 'runNeovim'' di \$ vim_call_function \"getqflist\" []+ 'Right' ('Right' ('ObjectArray' []))++ λ :r++ λ di <- 'develMain' 'Nothing'+ @++ You can also create a GHCI alias to get rid of most the busy-work:+ @+ :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\"+ @+-}+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++-- | Quit a previously started plugin provider.+quitDevelMain :: NvimHSDebugInstance -> IO ()+quitDevelMain NvimHSDebugInstance{internalConfig} =+ putMVar (Internal.transitionTo internalConfig) Internal.Quit++-- | Restart the development plugin provider.+restartDevelMain ::+ NvimHSDebugInstance ->+ IO (Maybe NvimHSDebugInstance)+restartDevelMain di = do+ quitDevelMain di+ develMain (neovimConfig di)++-- | Convenience function to run a stateless 'Neovim' function.+runNeovim' ::+ NFData a =>+ NvimHSDebugInstance ->+ Neovim () a ->+ IO (Either (Doc AnsiStyle) a)+runNeovim' NvimHSDebugInstance{internalConfig} =+ runNeovim (Internal.retypeConfig () internalConfig)++-- | Print the global function map to the console.+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]
+ src/Neovim/Exceptions.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Exceptions+Description : General Exceptions+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Exceptions (+ NeovimException (..),+ exceptionToDoc,+ catchNeovimException,+) where++import Control.Exception (Exception)+import Data.MessagePack (Object (..))+import Data.String (IsString (..))+import Data.Typeable (Typeable)+import Prettyprinter (Doc, viaShow, (<+>))+import Prettyprinter.Render.Terminal (AnsiStyle)+import UnliftIO (MonadUnliftIO, catch)++-- | Exceptions specific to /nvim-hs/.+data NeovimException+ = -- | Simple error message that is passed to neovim. It should currently only+ -- contain one line of text.+ ErrorMessage (Doc AnsiStyle)+ | -- | Error that can be returned by a remote API call. The 'Doc' argument is+ -- the name of the remote function that threw this exception.+ ErrorResult (Doc AnsiStyle) Object+ deriving (Typeable, Show)++instance Exception NeovimException++instance IsString NeovimException where+ fromString = ErrorMessage . fromString++exceptionToDoc :: NeovimException -> Doc AnsiStyle+exceptionToDoc = \case+ ErrorMessage e ->+ "Error message:" <+> e+ ErrorResult fn o ->+ "Function" <+> fn <+> "has thrown an error:" <+> viaShow o++-- | Specialization of 'catch' for 'NeovimException's.+catchNeovimException :: MonadUnliftIO io => io a -> (NeovimException -> io a) -> io a+catchNeovimException action exceptionHandler = action `catch` exceptionHandler
+ src/Neovim/Log.hs view
@@ -0,0 +1,58 @@+{- |+Module : Neovim.Log+Description : Logging utilities and reexports+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Log (+ disableLogger,+ withLogger,+ module System.Log.Logger,+) where++import Control.Exception+import System.Log.Formatter (simpleLogFormatter)+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple+import System.Log.Logger++-- | Disable logging to stderr.+disableLogger :: IO a -> IO a+disableLogger action = do+ updateGlobalLogger rootLoggerName removeHandler+ action++{- | Initialize the root logger to avoid stderr and set it to log the given+ file instead. Simply wrap the main entry point with this function to+ initialze the logger.++ @+ main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do+ 'putStrLn' "Hello, World!"+ @+-}+withLogger :: FilePath -> Priority -> IO a -> IO a+withLogger fp p action =+ bracket+ setupRootLogger+ (\fh -> closeFunc fh (privData fh))+ (const action)+ where+ setupRootLogger = do+ -- We shouldn't log to stderr or stdout as it is not unlikely that our+ -- messagepack communication is handled via those channels.+ disableLogger (return ())+ -- Log to the given file instead+ fh <- fileHandler fp p+ -- Adjust logging format+ let fh' = setFormatter fh (simpleLogFormatter "[$loggername : $prio] $msg")+ -- Adjust the log level as well+ updateGlobalLogger rootLoggerName (setLevel p . addHandler fh')+ -- For good measure, log some debug information+ logM "Neovim.Debug" DEBUG $+ unwords ["Initialized root looger with priority", show p, "and file: ", fp]+ return fh'
+ src/Neovim/Main.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Main+Description : Wrapper for the actual main function+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.Main where++import Neovim.Config (+ NeovimConfig (logOptions, plugins),+ Priority (..),+ )+import qualified Neovim.Context.Internal as Internal+import Neovim.Log (debugM, disableLogger, errorM, withLogger)+import qualified Neovim.Plugin as P+import Neovim.RPC.Common as RPC (+ RPCConfig,+ SocketType (Environment, TCP, UnixSocket),+ createHandle,+ newRPCConfig,+ )+import Neovim.RPC.EventHandler (runEventHandler)+import Neovim.RPC.SocketReader (runSocketReader)+import Neovim.Util (oneLineErrorMessage)++import Control.Monad (void)+import Data.Default (Default (..))+import Options.Applicative (+ Parser,+ ParserInfo,+ auto,+ execParser,+ fullDesc,+ header,+ help,+ helper,+ info,+ long,+ metavar,+ option,+ optional,+ progDesc,+ short,+ strArgument,+ strOption,+ switch,+ )+import System.IO (stdin, stdout)+import UnliftIO (Async, async, putMVar, atomically, putTMVar, takeMVar)+import Control.Applicative ((<|>))++import Prelude++logger :: String+logger = "Neovim.Main"++data CommandLineOptions = Opt+ { providerName :: Maybe String+ , hostPort :: Maybe (String, Int)+ , unix :: Maybe FilePath+ , envVar :: Bool+ , logOpts :: Maybe (FilePath, Priority)+ }++instance Default CommandLineOptions where+ def =+ Opt+ { providerName = Nothing+ , hostPort = Nothing+ , unix = Nothing+ , envVar = False+ , logOpts = Nothing+ }++optParser :: Parser CommandLineOptions+optParser =+ Opt+ <$> optional+ ( strArgument+ ( metavar "NAME"+ <> help+ ( unlines+ [ "Name that associates the plugin provider with neovim."+ , "This option has only an effect if you start nvim-hs"+ , "with rpcstart()/jobstart() and use the factory method approach."+ , "Since it is extremely hard to figure that out inside"+ , "nvim-hs, this option is assumed to used if the input"+ , "and output is tied to standard in and standard out."+ ]+ )+ )+ )+ <*> optional+ ( (,)+ <$> strOption+ ( long "host"+ <> short 'a'+ <> metavar "HOSTNAME"+ <> help "Connect to the specified host. (requires -p)"+ )+ <*> option+ auto+ ( long "port"+ <> short 'p'+ <> metavar "PORT"+ <> help "Connect to the specified port. (requires -a)"+ )+ )+ <*> optional+ ( strOption+ ( long "unix"+ <> short 'u'+ <> help "Connect to the given unix domain socket."+ )+ )+ <*> switch+ ( long "environment"+ <> short 'e'+ <> help "Read connection information from $NVIM."+ )+ <*> optional+ ( (,)+ <$> strOption+ ( long "log-file"+ <> short 'l'+ <> help "File to log to."+ )+ <*> option+ auto+ ( long "log-level"+ <> short 'v'+ <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels)+ )+ )+ where+ -- [minBound..maxBound] would have been nice here.+ logLevels :: [Priority]+ logLevels = [DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY]++opts :: ParserInfo CommandLineOptions+opts =+ info+ (helper <*> optParser)+ ( fullDesc+ <> header "Start a neovim plugin provider for Haskell plugins."+ <> progDesc "This is still work in progress. Feel free to contribute."+ )++{- | This is essentially the main function for /nvim-hs/, at least if you want+ to use "Config.Dyre" for the configuration.+-}+neovim :: NeovimConfig -> IO ()+neovim = realMain standalone++{- | A 'TransitionHandler' function receives the 'ThreadId's of all running+ threads which have been started by the plugin provider as well as the+ 'Internal.Config' with the custom field set to 'RPCConfig'. These information+ can be used to properly clean up a session and then do something else.+ The transition handler is first called after the plugin provider has started.+-}+type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a++{- | This main functions can be used to create a custom executable without+ using the "Config.Dyre" library while still using the /nvim-hs/ specific+ configuration facilities.+-}+realMain ::+ TransitionHandler a ->+ NeovimConfig ->+ IO ()+realMain transitionHandler cfg = do+ os <- execParser opts+ maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do+ debugM logger "Starting up neovim haskell plguin provider"+ void $ runPluginProvider os (Just cfg) transitionHandler++-- | Generic main function. Most arguments are optional or have sane defaults.+runPluginProvider ::+ -- | See /nvim-hs/ executables --help function or 'optParser'+ CommandLineOptions ->+ Maybe NeovimConfig ->+ TransitionHandler a ->+ IO a+runPluginProvider os mcfg transitionHandler = case (hostPort os, unix os) of+ (Just (h, p), _) ->+ createHandle (TCP p h) >>= \s -> run s s+ (_, Just fp) ->+ createHandle (UnixSocket fp) >>= \s -> run s s+ _+ | envVar os ->+ createHandle Environment >>= \s -> run s s+ _ ->+ run stdout stdin+ where+ run evHandlerHandle sockreaderHandle = do+ -- The plugins to register depend on the given arguments and may need+ -- special initialization methods.+ let allPlugins = maybe [] plugins mcfg++ conf <- Internal.newConfig (pure (providerName os)) newRPCConfig++ ehTid <-+ async $+ runEventHandler+ evHandlerHandle+ conf{Internal.pluginSettings = Nothing}++ srTid <- async $ runSocketReader sockreaderHandle conf++ let startupConf = Internal.retypeConfig () conf+ P.startPluginThreads startupConf allPlugins >>= \case+ Left e -> do+ errorM logger $ "Error initializing plugins: " <> show (oneLineErrorMessage e)+ putMVar (Internal.transitionTo conf) $ Internal.Failure e+ transitionHandler [ehTid, srTid] conf+ Right (funMapEntries, pluginTids) -> do+ atomically $+ putTMVar+ (Internal.globalFunctionMap conf)+ (Internal.mkFunctionMap funMapEntries)+ putMVar (Internal.transitionTo conf) Internal.InitSuccess+ transitionHandler (srTid : ehTid : pluginTids) conf++standalone :: TransitionHandler ()+standalone threads cfg =+ takeMVar (Internal.transitionTo cfg) >>= \case+ Internal.InitSuccess -> do+ debugM logger "Initialization Successful"+ standalone threads cfg+ Internal.Restart -> do+ errorM logger "Cannot restart"+ standalone threads cfg+ Internal.Failure e ->+ errorM logger . show $ oneLineErrorMessage e+ Internal.Quit ->+ return ()
+ src/Neovim/Plugin.hs view
@@ -0,0 +1,381 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Plugin+Description : Plugin and functionality registration code+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Plugin (+ startPluginThreads,+ wrapPlugin,+ NeovimPlugin,+ Plugin (..),+ Synchronous (..),+ CommandOption (..),+ addAutocmd,+ registerPlugin,+ registerFunctionality,+ getProviderName,+) where++import Neovim.API.String+ ( nvim_err_writeln, nvim_get_api_info, vim_call_function )+import Neovim.Classes+ ( (<+>),+ Doc,+ AnsiStyle,+ Pretty(pretty),+ NvimObject(toObject, fromObject),+ Dictionary,+ (+:) )+import Neovim.Context+ ( MonadIO(liftIO),+ NeovimException,+ newUniqueFunctionName,+ runNeovim,+ FunctionMapEntry,+ Neovim,+ err )+import Neovim.Context.Internal (+ FunctionType (..),+ runNeovimInternal,+ )+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes+ ( HasFunctionName(nvimMethod),+ FunctionName(..),+ NeovimEventId(NeovimEventId),+ Synchronous(..),+ CommandOption(..),+ CommandOptions(getCommandOptions),+ AutocmdOptions(AutocmdOptions),+ FunctionalityDescription(..),+ NvimMethod(..) )+import Neovim.Plugin.IPC.Classes+ ( Notification(Notification),+ Request(Request),+ Message(fromMessage),+ SomeMessage,+ readSomeMessage )+import Neovim.Plugin.Internal+ ( NeovimPlugin(..),+ Plugin(..),+ getDescription,+ getFunction,+ wrapPlugin )+import Neovim.RPC.FunctionCall ( respond )++import Control.Monad (foldM, void)+import Data.Foldable (forM_)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Either (rights)+import Data.MessagePack ( Object )+import Data.Text (Text)+import Data.Traversable (forM)+import System.Log.Logger ( debugM, errorM )+import UnliftIO.Async (Async, async, race)+import UnliftIO.Concurrent (threadDelay)+import UnliftIO.Exception (SomeException, catch, try)+import UnliftIO.STM+ ( TVar,+ putTMVar,+ takeTMVar,+ tryReadTMVar,+ modifyTVar,+ TQueue,+ atomically,+ newTQueueIO,+ newTVarIO,+ readTVarIO )++import Prelude++logger :: String+logger = "Neovim.Plugin"++startPluginThreads ::+ Internal.Config () ->+ [Neovim () NeovimPlugin] ->+ IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))+startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], [])+ where+ go ::+ ([FunctionMapEntry], [Async ()]) ->+ Neovim () NeovimPlugin ->+ Neovim () ([FunctionMapEntry], [Async ()])+ go (es, tids) iop = do+ NeovimPlugin p <- iop+ (es', tid) <- registerStatefulFunctionality p++ return (es ++ es', tid : tids)++{- | 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/.+-}+registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool+registerWithNeovim = \case+ func@(Function (F functionName) s) -> do+ pName <- getProviderName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#FunctionOnHost", toObject n))+ (\c -> ("remote#define#FunctionOnChannel", toObject c))+ pName+ reportError (e :: NeovimException) = do+ liftIO . errorM logger $+ "Failed to register function: " ++ show functionName ++ show e+ return False+ logSuccess = do+ liftIO . debugM logger $+ "Registered function: " ++ show functionName+ return True++ flip catch reportError $ do+ void $+ vim_call_function defineFunction $+ host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: []+ logSuccess+ cmd@(Command (F functionName) copts) -> do+ let sync = case getCommandOptions copts of+ -- This works because CommandOptions are sorted and CmdSync is+ -- the smallest element in the sorting+ (CmdSync s : _) -> s+ _ -> Sync++ pName <- getProviderName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#CommandOnHost", toObject n))+ (\c -> ("remote#define#CommandOnChannel", toObject c))+ pName+ reportError (e :: NeovimException) = do+ liftIO . errorM logger $+ "Failed to register command: " ++ show functionName ++ show e+ return False+ logSuccess = do+ liftIO . debugM logger $+ "Registered command: " ++ show functionName+ return True+ flip catch reportError $ do+ void $+ vim_call_function defineFunction $+ host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: []+ logSuccess+ Autocmd acmdType (F functionName) sync opts -> do+ pName <- getProviderName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#AutocmdOnHost", toObject n))+ (\c -> ("remote#define#AutocmdOnChannel", toObject c))+ pName+ reportError (e :: NeovimException) = do+ liftIO . errorM logger $+ "Failed to register autocmd: " ++ show functionName ++ show e+ return False+ logSuccess = do+ liftIO . debugM logger $+ "Registered autocmd: " ++ show functionName+ return True+ flip catch reportError $ do+ void $+ vim_call_function defineFunction $+ host +: functionName +: sync +: acmdType +: opts +: []+ logSuccess++{- | Return or retrive the provider name that the current instance is associated+ with on the neovim side.+-}+getProviderName :: Neovim env (Either String Int)+getProviderName = do+ mp <- Internal.asks' Internal.providerName+ (liftIO . atomically . tryReadTMVar) mp >>= \case+ Just p ->+ return p+ Nothing -> do+ api <- nvim_get_api_info+ case api of+ [] -> err "empty nvim_get_api_info"+ (i : _) -> do+ case fromObject i :: Either (Doc AnsiStyle) Int of+ Left _ ->+ err $+ "Expected an integral value as the first"+ <+> "argument of nvim_get_api_info"+ Right channelId -> do+ liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId+ return . Right $ fromIntegral channelId++registerFunctionality ::+ FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)+registerFunctionality d f = do+ Internal.asks' Internal.pluginSettings >>= \case+ Nothing -> do+ 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+ pure $ Right e+ Nothing ->+ pure $ Left ""++registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()+registerInGlobalFunctionMap e = do+ liftIO . debugM logger $ "Adding function to global function map." ++ show (fst e)+ funMap <- Internal.asks' Internal.globalFunctionMap+ liftIO . atomically $ do+ m <- takeTMVar funMap+ putTMVar funMap $ Map.insert ((nvimMethod . fst) e) e m+ liftIO . debugM logger $ "Added function to global function map." ++ show (fst e)++registerPlugin ::+ (FunctionMapEntry -> Neovim env ()) ->+ FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ Neovim env (Maybe FunctionMapEntry)+registerPlugin reg d f q tm =+ registerWithNeovim d >>= \case+ True -> do+ let n = nvimMethod d+ e = (d, Stateful q)+ liftIO . atomically . modifyTVar tm $ Map.insert n f+ reg e+ return (Just e)+ False ->+ return Nothing++{- | Register an autocmd in the current context. This means that, if you are+ currently in a stateful plugin, the function will be called in the current+ thread and has access to the configuration and state of this thread. .++ Note that the function you pass must be fully applied.+-}+addAutocmd ::+ -- | The event to register to (e.g. BufWritePost)+ Text ->+ Synchronous ->+ AutocmdOptions ->+ -- | Fully applied function to register+ Neovim env () ->+ -- | A 'ReleaseKey' if the registration worked+ Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)+addAutocmd event s opts@AutocmdOptions{} f = do+ n <- newUniqueFunctionName+ 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).+-}+registerStatefulFunctionality ::+ Plugin env ->+ Neovim anyEnv ([FunctionMapEntry], Async ())+registerStatefulFunctionality (Plugin{environment = env, exports = fs}) = do+ messageQueue <- liftIO newTQueueIO+ route <- liftIO $ newTVarIO Map.empty+ subscribers <- liftIO $ newTVarIO []++ cfg <- Internal.ask'++ let startupConfig =+ cfg+ { Internal.customConfig = env+ , Internal.pluginSettings =+ Just $+ Internal.StatefulSettings+ (registerPlugin (\_ -> return ()))+ messageQueue+ route+ }+ res <- liftIO . runNeovimInternal return startupConfig . forM fs $ \f ->+ registerFunctionality (getDescription f) (getFunction f)+ es <- case res of+ Left e -> err e+ Right a -> return $ rights a++ let pluginThreadConfig =+ cfg+ { Internal.customConfig = env+ , Internal.pluginSettings =+ Just $+ Internal.StatefulSettings+ (registerPlugin registerInGlobalFunctionMap)+ messageQueue+ route+ }++ tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do+ listeningThread messageQueue route subscribers++ return (es, tid) -- NB: dropping release functions/keys here+ where+ executeFunction ::+ ([Object] -> Neovim env Object) ->+ [Object] ->+ Neovim env (Either String Object)+ executeFunction f args =+ try (f args) >>= \case+ Left e -> return . Left $ show (e :: SomeException)+ Right res -> return $ Right res++ killAfterSeconds :: Word -> Neovim anyEnv ()+ killAfterSeconds seconds = threadDelay (fromIntegral seconds * 1000 * 1000)++ timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String+ timeoutAndLog seconds functionName = do+ killAfterSeconds seconds+ return . show $+ pretty functionName <+> "has been aborted after"+ <+> pretty seconds+ <+> "seconds"++ listeningThread ::+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ TVar [Notification -> Neovim env ()] ->+ Neovim env ()+ listeningThread q route subscribers = do+ msg <- readSomeMessage q++ forM_ (fromMessage msg) $ \req@(Request fun@(F methodName) _ args) -> do+ let method = NvimMethod methodName+ route' <- liftIO $ readTVarIO route+ forM_ (Map.lookup method route') $ \f -> do+ respond req . either Left id+ =<< race+ (timeoutAndLog 10 fun)+ (executeFunction f args)++ 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)++ listeningThread q route subscribers
+ src/Neovim/Plugin/Classes.hs view
@@ -0,0 +1,453 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Plugin.Classes+Description : Classes and data types related to plugins+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Plugin.Classes (+ FunctionalityDescription (..),+ FunctionName (..),+ NeovimEventId (..),+ SubscriptionId (..),+ Subscription (..),+ NvimMethod (..),+ Synchronous (..),+ CommandOption (..),+ CommandOptions,+ RangeSpecification (..),+ CommandArguments (..),+ getCommandOptions,+ mkCommandOptions,+ AutocmdOptions (..),+ HasFunctionName (..),+) where++import Neovim.Classes++import Control.Monad.Error.Class (MonadError (throwError))+import Data.Char (isDigit)+import Data.Default (Default (..))+import Data.List (groupBy, sort)+import qualified Data.Map as Map+import Data.Maybe (catMaybes, mapMaybe)+import Data.MessagePack (Object (..))+import Data.String (IsString (..))+import Data.Text (Text)+import Prettyprinter (cat, comma, lparen, rparen, viaShow)++import Prelude hiding (sequence)++-- | Essentially just a string.+newtype FunctionName = F Text+ deriving (Eq, Ord, Show, Read, Generic)+ deriving (NFData, Pretty) via Text++newtype NeovimEventId = NeovimEventId Text+ deriving (Eq, Ord, Show, Read, Generic)+ deriving (Pretty) via Text+ deriving (NFData) via Text++instance NvimObject NeovimEventId where+ toObject (NeovimEventId e) = toObject e+ fromObject o = NeovimEventId <$> fromObject o++newtype SubscriptionId = SubscriptionId Int64+ deriving (Eq, Ord, Show, Read)+ deriving (Enum) via Int64++data Subscription = Subscription+ { subId :: SubscriptionId+ , subEventId :: NeovimEventId+ , subAction :: [Object] -> IO ()+ }++{- | Functionality specific functional description entries.++ All fields which are directly specified in these constructors are not+ optional, but can partialy be generated via the Template Haskell functions.+ The last field is a data type that contains all relevant options with+ sensible defaults, hence 'def' can be used as an argument.+-}+data FunctionalityDescription+ = -- | Exported function. Callable via @call name(arg1,arg2)@.+ --+ -- * Name of the function (must start with an uppercase letter)+ -- * Option to indicate how neovim should behave when calling this function+ Function FunctionName Synchronous+ | -- | Exported Command. Callable via @:Name arg1 arg2@.+ --+ -- * Name of the command (must start with an uppercase letter)+ -- * Options to configure neovim's behavior for calling the command+ Command FunctionName CommandOptions+ | -- | Exported autocommand. Will call the given function if the type and+ -- filter match.+ --+ -- NB: Since we are registering this on the Haskell side of things, the+ -- number of accepted arguments should be 0.+ --+ -- * Type of the autocmd (e.g. \"BufWritePost\")+ -- * 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 Text FunctionName Synchronous AutocmdOptions+ deriving (Show, Read, Eq, Ord, Generic)++instance NFData FunctionalityDescription++instance Pretty FunctionalityDescription where+ pretty = \case+ Function fname s ->+ "Function" <+> pretty s <+> pretty fname+ Command fname copts ->+ "Command" <+> pretty copts <+> pretty fname+ Autocmd t fname s aopts ->+ "Autocmd"+ <+> pretty t+ <+> pretty s+ <+> pretty aopts+ <+> pretty fname++{- | This option detemines how neovim should behave when calling some+ functionality on a remote host.+-}+data Synchronous+ = -- | Call the functionality entirely for its side effects and do not wait+ -- for it to finish. Calling a functionality with this flag set is+ -- completely asynchronous and nothing is really expected to happen. This+ -- is why a call like this is called notification on the neovim side of+ -- things.+ Async+ | -- | Call the function and wait for its result. This is only synchronous on+ -- the neovim side. This means that the GUI will (probably) not+ -- allow any user input until a reult is received.+ Sync+ deriving (Show, Read, Eq, Ord, Enum, Generic)++instance NFData Synchronous++instance Pretty Synchronous where+ pretty = \case+ Async -> "async"+ Sync -> "sync"++instance IsString Synchronous where+ fromString = \case+ "sync" -> Sync+ "async" -> Async+ _ -> error "Only \"sync\" and \"async\" are valid string representations"++instance NvimObject Synchronous where+ toObject = \case+ Async -> toObject False+ Sync -> toObject True++ fromObject = \case+ ObjectBool True -> return Sync+ ObjectBool False -> return Async+ ObjectInt 0 -> return Async+ _ -> return Sync++{- | Options for commands.++ Some command can also be described by using the OverloadedString extensions.+ This means that you can write a literal 'String' inside your source file in+ place for a 'CommandOption' value. See the documentation for each value on+ how these strings should look like (Both versions are compile time checked.)+-}+data CommandOption+ = -- | Stringliteral "sync" or "async"+ CmdSync Synchronous+ | -- | Register passed to the command.+ --+ -- Stringliteral: @\"\\\"\"@+ CmdRegister+ | -- | Command takes a specific amount of arguments+ --+ -- Automatically set via template haskell functions. You+ -- really shouldn't use this option yourself unless you have+ -- to.+ CmdNargs String+ | -- | Determines how neovim passes the range.+ --+ -- Stringliterals: \"%\" for 'WholeFile', \",\" for line+ -- and \",123\" for 123 lines.+ CmdRange RangeSpecification+ | -- | Command handles a count. The argument defines the+ -- default count.+ --+ -- Stringliteral: string of numbers (e.g. "132")+ CmdCount Word+ | -- | Command handles a bang+ --+ -- Stringliteral: \"!\"+ CmdBang+ | -- | Verbatim string passed to the @-complete=@ command attribute+ CmdComplete String+ deriving (Eq, Ord, Show, Read, Generic)++instance NFData CommandOption++instance Pretty CommandOption where+ pretty = \case+ CmdSync s ->+ pretty s+ CmdRegister ->+ "\""+ CmdNargs n ->+ pretty n+ CmdRange rs ->+ pretty rs+ CmdCount c ->+ pretty c+ CmdBang ->+ "!"+ CmdComplete cs ->+ pretty cs++instance IsString CommandOption where+ fromString = \case+ "%" -> CmdRange WholeFile+ "\"" -> CmdRegister+ "!" -> CmdBang+ "sync" -> CmdSync Sync+ "async" -> CmdSync Async+ "," -> CmdRange CurrentLine+ ',' : ds | not (null ds) && all isDigit ds -> CmdRange (read ds)+ ds | not (null ds) && all isDigit ds -> CmdCount (read ds)+ _ -> error "Not a valid string for a CommandOptions. Check the docs!"++{- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed+ object of this type is sorted and only contains zero or one object for each+ possible option.+-}+newtype CommandOptions = CommandOptions {getCommandOptions :: [CommandOption]}+ deriving (Eq, Ord, Show, Read, Generic)++instance NFData CommandOptions++instance Pretty CommandOptions where+ pretty (CommandOptions os) =+ cat $ map pretty os++{- | Smart constructor for 'CommandOptions'. This sorts the command options and+ removes duplicate entries for semantically the same thing. Note that the+ smallest option stays for whatever ordering is defined. It is best to simply+ not define the same thing multiple times.+-}+mkCommandOptions :: [CommandOption] -> CommandOptions+mkCommandOptions = CommandOptions . map head . groupBy constructor . sort+ where+ constructor a b = case (a, b) of+ _ | a == b -> True+ -- Only CmdSync and CmdNargs may fail for the equality check,+ -- so we just have to check those.+ (CmdSync _, CmdSync _) -> True+ (CmdRange _, CmdRange _) -> True+ -- Range and conut are mutually recursive.+ -- XXX Actually '-range=N' and '-count=N' are, but the code in+ -- remote#define#CommandOnChannel treats it exclusive as a whole.+ -- (see :h :command-range)+ (CmdRange _, CmdCount _) -> True+ (CmdNargs _, CmdNargs _) -> True+ _ -> False++instance NvimObject CommandOptions where+ toObject (CommandOptions opts) =+ (toObject :: Dictionary -> Object) . Map.fromList $ mapMaybe addOption opts+ where+ addOption = \case+ CmdRange r -> Just ("range", toObject r)+ CmdCount n -> Just ("count", toObject n)+ CmdBang -> Just ("bang", ObjectBinary "")+ CmdRegister -> Just ("register", ObjectBinary "")+ CmdNargs n -> Just ("nargs", toObject n)+ CmdComplete cs -> Just ("complete", toObject cs)+ _ -> Nothing++ fromObject o =+ throwError $+ "Did not expect to receive a CommandOptions object:" <+> viaShow o++-- | Specification of a range that acommand can operate on.+data RangeSpecification+ = -- | The line the cursor is at when the command is invoked.+ CurrentLine+ | -- | Let the command operate on every line of the file.+ WholeFile+ | -- | Let the command operate on each line in the given range.+ RangeCount Int+ deriving (Eq, Ord, Show, Read, Generic)++instance NFData RangeSpecification++instance Pretty RangeSpecification where+ pretty = \case+ CurrentLine ->+ mempty+ WholeFile ->+ "%"+ RangeCount c ->+ pretty c++instance NvimObject RangeSpecification where+ toObject = \case+ CurrentLine -> ObjectBinary ""+ WholeFile -> ObjectBinary "%"+ RangeCount n -> toObject n++ fromObject o =+ throwError $+ "Did not expect to receive a RangeSpecification object:" <+> viaShow o++{- | You can use this type as the first argument for a function which is+ intended to be exported as a command. It holds information about the special+ attributes a command can take.+-}+data CommandArguments = CommandArguments+ { 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)++instance NFData CommandArguments++instance Pretty CommandArguments where+ pretty CommandArguments{..} =+ cat $+ catMaybes+ [ (\b -> if b then "!" else mempty) <$> bang+ , ( \(s, e) ->+ lparen <> pretty s <> comma+ <+> pretty e <> rparen+ )+ <$> range+ , pretty <$> count+ , pretty <$> register+ ]++instance Default CommandArguments where+ def =+ CommandArguments+ { bang = Nothing+ , range = Nothing+ , count = Nothing+ , register = Nothing+ }++-- XXX This instance is used as a bit of a hack, so that I don't have to write+-- special code handling in the code generator and "Neovim.RPC.SocketReader".+instance NvimObject CommandArguments where+ toObject CommandArguments{..} =+ (toObject :: Dictionary -> Object)+ . Map.fromList+ . catMaybes+ $ [ bang >>= \b -> return ("bang", toObject b)+ , range >>= \r -> return ("range", toObject r)+ , count >>= \c -> return ("count", toObject c)+ , register >>= \r -> return ("register", toObject r)+ ]++ fromObject (ObjectMap m) = do+ let l key = mapM fromObject (Map.lookup (ObjectBinary key) m)+ bang <- l "bang"+ range <- l "range"+ count <- l "count"+ register <- l "register"+ return CommandArguments{..}+ fromObject ObjectNil = return def+ fromObject o =+ throwError $+ "Expected a map for CommandArguments object, but got: "+ <+> viaShow o++{- | Options that can be used to register an autocmd. See @:h :autocmd@ or any+ referenced neovim help-page from the fields of this data type.+-}+data AutocmdOptions = AutocmdOptions+ { 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)++instance NFData AutocmdOptions++instance Pretty AutocmdOptions where+ pretty AutocmdOptions{..} =+ pretty acmdPattern+ <+> if acmdNested+ then "nested"+ else+ "unnested"+ <> maybe mempty (\g -> mempty <+> pretty g) acmdGroup++instance Default AutocmdOptions where+ def =+ AutocmdOptions+ { acmdPattern = "*"+ , acmdNested = False+ , acmdGroup = Nothing+ }++instance NvimObject AutocmdOptions where+ toObject AutocmdOptions{..} =+ (toObject :: Dictionary -> Object) . Map.fromList $+ [ ("pattern", toObject acmdPattern)+ , ("nested", toObject acmdNested)+ ]+ ++ catMaybes+ [ acmdGroup >>= \g -> return ("group", toObject g)+ ]+ fromObject o =+ throwError $+ "Did not expect to receive an AutocmdOptions object: " <+> viaShow o++newtype NvimMethod = NvimMethod {nvimMethodName :: Text}+ deriving (Eq, Ord, Show, Read, Generic)+ deriving (Pretty, NFData) via Text++-- | Conveniennce class to extract a name from some value.+class HasFunctionName a where+ name :: a -> FunctionName+ nvimMethod :: a -> NvimMethod++instance HasFunctionName FunctionalityDescription where+ name = \case+ Function n _ -> n+ Command n _ -> n+ Autocmd _ n _ _ -> n++ nvimMethod = \case+ Function (F n) _ -> NvimMethod $ n <> ":function"+ Command (F n) _ -> NvimMethod $ n <> ":command"+ Autocmd _ (F n) _ _ -> NvimMethod n+
+ src/Neovim/Plugin/IPC.hs view
@@ -0,0 +1,18 @@+{- |+Module : Neovim.Plugin.IPC+Description : Communication between Haskell processes/threads+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental++This module reexports publicly available means to communicate between different+plugins (or more generally threads running in the same plugin provider).+-}+module Neovim.Plugin.IPC (+ SomeMessage (..),+ fromMessage,+) where++import Neovim.Plugin.IPC.Classes
+ src/Neovim/Plugin/IPC/Classes.hs view
@@ -0,0 +1,167 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module : Neovim.Plugin.IPC.Classes+Description : Classes used for Inter Plugin Communication+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Plugin.IPC.Classes (+ SomeMessage (..),+ Message (..),+ FunctionCall (..),+ Request (..),+ Notification (..),+ writeMessage,+ readSomeMessage,+ UTCTime,+ getCurrentTime,+ module Data.Int,+) where++import Neovim.Classes (+ Generic,+ Int64,+ Pretty (pretty),+ (<+>),+ )+import Neovim.Plugin.Classes (FunctionName, NeovimEventId)++import Data.Data (cast)+import Data.Int (Int64)+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 Control.DeepSeq (NFData, deepseq, rnf)+import Prelude++{- | Taken from xmonad and based on ideas in /An Extensible Dynamically-Typed+ Hierarchy of Exceptions/, Simon Marlow, 2006.++ User-extensible messages must be put into a value of this type, so that it+ can be sent to other plugins.+-}+data SomeMessage = forall msg. Message msg => SomeMessage msg++{- | This class allows type safe casting of 'SomeMessage' to an actual message.+ The cast is successful if the type you're expecting matches the type in the+ 'SomeMessage' wrapper. This way, you can subscribe to an arbitrary message+ type withouth having to pattern match on the constructors. This also allows+ plugin authors to create their own message types without having to change the+ core code of /nvim-hs/.+-}+class (NFData message, Typeable message) => Message message where+ -- | Try to convert a given message to a value of the message type we are+ -- interested in. Will evaluate to 'Nothing' for any other type.+ fromMessage :: SomeMessage -> Maybe message+ fromMessage (SomeMessage message) = cast message++writeMessage :: (MonadUnliftIO m, Message message) => TQueue SomeMessage -> message -> m ()+writeMessage q message = liftIO $ do+ evaluate (rnf message)+ atomically $ writeTQueue q (SomeMessage message)++readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage+readSomeMessage q = liftIO $ atomically (readTQueue q)++-- | Haskell representation of supported Remote Procedure Call messages.+data FunctionCall+ = -- | Method name, parameters, callback, timestamp+ FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime+ deriving (Typeable, Generic)++instance NFData FunctionCall where+ rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` ()++instance Message FunctionCall++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++{- | 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.+-}+data Request = Request+ { reqMethod :: FunctionName+ -- ^ Name of the function to call.+ , reqId :: !Int64+ -- ^ Identifier to map the result to a function call invocation.+ , reqArgs :: [Object]+ -- ^ Arguments for the function.+ }+ deriving (Eq, Ord, Show, Typeable, Generic)++instance NFData Request++instance Message Request++instance Pretty Request where+ pretty Request{..} =+ nest 2 $+ "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+ message is sent by neovim if the caller there does not care about the result+ of the computation.+-}+data Notification = Notification+ { notEvent :: NeovimEventId+ -- ^ Event name of the notification.+ , notArgs :: [Object]+ -- ^ Arguments for the function.+ }+ deriving (Eq, Ord, Show, Typeable, Generic)++instance NFData Notification++instance Message Notification++instance Pretty Notification where+ pretty Notification{..} =+ nest 2 $+ "Notification"+ <> hardline+ <> "Event:"+ <+> pretty notEvent+ <> hardline+ <> "Arguments:"+ <+> viaShow notEvent
+ src/Neovim/Plugin/Internal.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE ExistentialQuantification #-}++{- |+Module : Neovim.Plugin.Internal+Description : Split module that can import Neovim.Context without creating import circles+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Plugin.Internal (+ ExportedFunctionality (..),+ getFunction,+ getDescription,+ NeovimPlugin (..),+ Plugin (..),+ wrapPlugin,+) where++import Neovim.Context (Neovim)+import Neovim.Plugin.Classes (+ FunctionalityDescription,+ HasFunctionName (..),+ )++import Data.MessagePack (Object)++{- | This data type is used in the plugin registration to properly register the+ functions.+-}+newtype ExportedFunctionality env+ = EF (FunctionalityDescription, [Object] -> Neovim env Object)++-- | Extract the description of an 'ExportedFunctionality'.+getDescription :: ExportedFunctionality env -> FunctionalityDescription+getDescription (EF (d, _)) = d++-- | Extract the function of an 'ExportedFunctionality'.+getFunction :: ExportedFunctionality env -> [Object] -> Neovim env Object+getFunction (EF (_, f)) = f++instance HasFunctionName (ExportedFunctionality env) where+ name = name . getDescription+ nvimMethod = nvimMethod . getDescription++-- | This data type contains meta information for the plugin manager.+data Plugin env = Plugin+ { environment :: env+ , exports :: [ExportedFunctionality env]+ }++{- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that+ we can put plugins in an ordinary list.+-}+data NeovimPlugin = forall env. NeovimPlugin (Plugin env)++{- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple+ list.+-}+wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin+wrapPlugin = pure . NeovimPlugin
+ src/Neovim/Quickfix.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Quickfix+Description : API for interacting with the quickfix list+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Quickfix where++import Neovim.API.String ( vim_call_function )+import Neovim.Classes+ ( Generic,+ NFData,+ (<+>),+ Doc,+ AnsiStyle,+ NvimObject(toObject, fromObject),+ (+:) )+import Neovim.Context ( throwError, Neovim )+++import Control.Monad (void)+import Data.ByteString as BS (ByteString, all, elem)+import qualified Data.Map as Map+import Data.Maybe ( fromMaybe )+import Data.MessagePack ( Object(ObjectBinary, ObjectMap) )+import Prettyprinter (viaShow)+import Prelude++{- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any+ string that you can append to (hence 'Monoid') that is also an instance+ of 'NvimObject'. You can e.g. use the plain old 'String'.+-}+setqflist ::+ (Monoid strType, NvimObject strType) =>+ [QuickfixListItem strType] ->+ QuickfixAction ->+ Neovim env ()+setqflist qs a =+ void $ vim_call_function "setqflist" $ qs +: a +: []++data ColumnNumber+ = VisualColumn Int+ | ByteIndexColumn Int+ | NoColumn+ deriving (Eq, Ord, Show, Generic)++instance NFData ColumnNumber++data SignLocation strType+ = LineNumber Int+ | SearchPattern strType+ deriving (Eq, Ord, Show, Generic)++instance (NFData strType) => NFData (SignLocation strType)++{- | Quickfix list item. The parameter names should mostly conform to those in+ @:h setqflist()@. Some fields are merged to explicitly state mutually+ exclusive elements or some other behavior of the fields.++ see 'quickfixListItem' for creating a value of this type without typing too+ much.+-}+data QuickfixListItem strType = QFItem+ { -- | Since the filename is only used if no buffer can be specified, this+ -- field is a merge of @bufnr@ and @filename@.+ bufOrFile :: Either Int strType+ , -- | Line number or search pattern to locate the error.+ lnumOrPattern :: Either Int strType+ , -- | A tuple of a column number and a boolean indicating which kind of+ -- indexing should be used. 'True' means that the visual column should be+ -- used. 'False' means to use the byte index.+ col :: ColumnNumber+ , -- | Error number.+ nr :: Maybe Int+ , -- | Description of the error.+ text :: strType+ , -- | Type of error.+ errorType :: QuickfixErrorType+ }+ deriving (Eq, Show, Generic)++instance (NFData strType) => NFData (QuickfixListItem strType)++-- | Simple error type enum.+data QuickfixErrorType = Warning | Error+ deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic)++instance NFData QuickfixErrorType++instance NvimObject QuickfixErrorType where+ toObject = \case+ Warning -> ObjectBinary "W"+ Error -> ObjectBinary "E"++ fromObject o = case fromObject o :: Either (Doc AnsiStyle) String of+ Right "W" -> return Warning+ Right "E" -> return Error+ _ -> return Error++{- | Create a 'QuickfixListItem' by providing the minimal amount of arguments+ needed.+-}+quickfixListItem ::+ (Monoid strType) =>+ -- | buffer of file name+ Either Int strType ->+ -- | line number or pattern+ Either Int strType ->+ QuickfixListItem strType+quickfixListItem bufferOrFile lineOrPattern =+ QFItem+ { bufOrFile = bufferOrFile+ , lnumOrPattern = lineOrPattern+ , col = NoColumn+ , nr = Nothing+ , text = mempty+ , errorType = Error+ }++instance+ (Monoid strType, NvimObject strType) =>+ NvimObject (QuickfixListItem strType)+ where+ toObject QFItem{..} =+ (toObject :: Map.Map ByteString Object -> Object) . Map.fromList $+ [ either+ (\b -> ("bufnr", toObject b))+ (\f -> ("filename", toObject f))+ bufOrFile+ , either+ (\l -> ("lnum", toObject l))+ (\p -> ("pattern", toObject p))+ lnumOrPattern+ , ("type", toObject errorType)+ , ("text", toObject text)+ ]+ ++ 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+ let l :: NvimObject o => ByteString -> Either (Doc AnsiStyle) o+ l key = case Map.lookup key m of+ Just o -> fromObject o+ Nothing -> throwError $ "Key not found."+ bufOrFile <- case (l "bufnr", l "filename") of+ (Right b, _) -> return $ Left b+ (_, Right f) -> return $ Right f+ _ -> throwError $ "No buffer number or file name inside quickfix list item."+ lnumOrPattern <- case (l "lnum", l "pattern") of+ (Right lnum, _) -> return $ Left lnum+ (_, Right pat) -> return $ Right pat+ _ -> throwError $ "No line number or search pattern inside quickfix list item."+ let l' :: NvimObject o => ByteString -> Either (Doc AnsiStyle) (Maybe o)+ l' key = case Map.lookup key m of+ Just o -> Just <$> fromObject o+ Nothing -> return Nothing+ nr <-+ l' "nr" >>= \case+ Just 0 -> return Nothing+ nr' -> return nr'+ c <- l' "col"+ v <- l' "vcol"+ let col = fromMaybe NoColumn $ do+ c' <- c+ v' <- v+ case (c', v') of+ (0, _) -> return NoColumn+ (_, True) -> return $ VisualColumn c'+ (_, False) -> return $ ByteIndexColumn c'+ text <- fromMaybe mempty <$> l' "text"+ errorType <- fromMaybe Error <$> l' "type"+ return QFItem{..}+ fromObject o =+ throwError $+ "Could not deserialize QuickfixListItem,"+ <+> "expected a map but received:"+ <+> viaShow o++data QuickfixAction+ = -- | Add items to the current list (or create a new one if none exists).+ Append+ | -- | Replace current list (or create a new one if none exists).+ Replace+ | -- | Create a new list.+ New+ deriving (Eq, Ord, Enum, Bounded, Show, Generic)++instance NFData QuickfixAction++instance NvimObject QuickfixAction where+ toObject = \case+ Append -> ObjectBinary "a"+ Replace -> ObjectBinary "r"+ New -> ObjectBinary ""++ fromObject o = case fromObject o of+ Right "a" -> return Append+ Right "r" -> return Replace+ Right s | BS.all (`BS.elem` " \t\n\r") s -> return New+ _ -> Left "Could not convert to QuickfixAction"
+ src/Neovim/RPC/Classes.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.RPC.Classes+Description : Data types and classes for the RPC components+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC++Import this module qualified as @MsgpackRPC@+-}+module Neovim.RPC.Classes (+ Message (..),+) where++import Neovim.Classes+import Neovim.Plugin.Classes (FunctionName (..), NeovimEventId (..))+import qualified Neovim.Plugin.IPC.Classes as IPC++import Control.Applicative+import Control.Monad.Error.Class+import Data.Data (Typeable)+import Data.MessagePack (Object (..))+import Prettyprinter (hardline, nest, viaShow)++import Prelude++{- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for+ details about the msgpack rpc specification.+-}+data Message+ = -- | Request in the sense of the msgpack rpc specification+ --+ -- Parameters+ -- * Message identifier that has to be put in the response to this request+ -- * Function name+ -- * Function arguments+ Request IPC.Request+ | -- | Response in the sense of the msgpack rpc specifcation+ --+ -- Parameters+ -- * Mesage identifier which matches a request+ -- * 'Either' an error 'Object' or a result 'Object'+ Response !Int64 (Either Object Object)+ | -- | Notification in the sense of the msgpack rpc specification+ Notification IPC.Notification+ deriving (Eq, Ord, Show, Typeable, Generic)++instance NFData Message++instance IPC.Message Message++instance NvimObject Message where+ toObject = \case+ Request (IPC.Request (F m) i ps) ->+ ObjectArray $ (0 :: Int64) +: i +: m +: ps +: []+ Response i (Left e) ->+ ObjectArray $ (1 :: Int64) +: i +: e +: () +: []+ Response i (Right r) ->+ ObjectArray $ (1 :: Int64) +: i +: () +: r +: []+ Notification (IPC.Notification (NeovimEventId eventId) ps) ->+ ObjectArray $ (2 :: Int64) +: eventId +: ps +: []++ fromObject = \case+ ObjectArray [ObjectInt 0, i, m, ps] -> do+ r <-+ IPC.Request+ <$> fmap F (fromObject m)+ <*> fromObject i+ <*> fromObject ps+ return $ Request r+ ObjectArray [ObjectInt 1, i, e, r] ->+ let eer = case e of+ ObjectNil -> Right r+ _ -> Left e+ in Response <$> fromObject i+ <*> pure eer+ ObjectArray [ObjectInt 2, m, ps] -> do+ n <-+ IPC.Notification+ <$> fmap NeovimEventId (fromObject m)+ <*> fromObject ps+ return $ Notification n+ o ->+ throwError $ "Not a known/valid msgpack-rpc message:" <+> viaShow o++instance Pretty Message where+ pretty = \case+ Request request ->+ pretty request+ Response i ret ->+ nest 2 $+ "Response" <+> "#" <> pretty i+ <> hardline+ <> either viaShow viaShow ret+ Notification notification ->+ pretty notification
+ src/Neovim/RPC/Common.hs view
@@ -0,0 +1,142 @@+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE LambdaCase #-} ++{- |+Module : Neovim.RPC.Common+Description : Common functons for the RPC module+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.RPC.Common where++import Neovim.OS (getSocketUnix)++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 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+ { recipients :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))+ -- ^ 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, 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+ = -- | 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, MonadUnliftIO io) =>+ SocketType ->+ io Handle+createHandle = \case+ Stdout h -> do+ liftIO $ hSetBuffering h (BlockBuffering Nothing)+ return h+ UnixSocket f ->+ liftIO $ createHandle . Stdout =<< flip socketToHandle ReadWriteMode =<< getSocketUnix f+ TCP p h ->+ createHandle . Stdout =<< createTCPSocketHandle p h+ Environment ->+ createHandle . Stdout =<< createSocketHandleFromEnvironment+ where+ 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+ ]+ 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++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)++{- | 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 $+ warningM "cleanUpHandle" "Cleanup called on uncompleted handle."
+ src/Neovim/RPC/EventHandler.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}++{- |+Module : Neovim.RPC.EventHandler+Description : Event handling loop+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.RPC.EventHandler (+ runEventHandler,+) where++import Neovim.Classes (NvimObject (toObject))+import Neovim.Context (MonadIO (..), asks)+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.IPC.Classes (+ FunctionCall (..),+ Message (fromMessage),+ Request (Request),+ SomeMessage,+ readSomeMessage,+ )+import qualified Neovim.RPC.Classes as MsgpackRPC+import Neovim.RPC.Common (RPCConfig (nextMessageId, recipients))+import Neovim.RPC.FunctionCall (atomically')++import Conduit as C (+ ConduitM,+ ConduitT,+ Flush (..),+ ResourceT,+ await,+ runConduit,+ runResourceT,+ sinkHandleFlush,+ yield,+ (.|),+ )+import Control.Monad (forever)+import Control.Monad.Reader (+ MonadReader,+ ReaderT (runReaderT),+ )+import Data.ByteString (ByteString)+import qualified Data.Map as Map+import Data.Serialize (encode)+import System.IO (Handle)+import System.Log.Logger (debugM)+import UnliftIO (MonadUnliftIO, modifyTVar', readTVar)+import Prelude++{- | This function will establish a connection to the given socket and write+ msgpack-rpc requests to it.+-}+runEventHandler ::+ Handle ->+ Internal.Config RPCConfig ->+ IO ()+runEventHandler writeableHandle env =+ runEventHandlerContext env . runConduit $ do+ eventHandlerSource+ .| eventHandler+ .| sinkHandleFlush writeableHandle++-- | Convenient monad transformer stack for the event handler+newtype EventHandler a+ = EventHandler (ResourceT (ReaderT (Internal.Config RPCConfig) IO) a)+ deriving+ ( Functor+ , Applicative+ , Monad+ , MonadIO+ , MonadUnliftIO+ , MonadReader (Internal.Config RPCConfig)+ )++runEventHandlerContext ::+ Internal.Config RPCConfig -> EventHandler a -> IO a+runEventHandlerContext env (EventHandler a) =+ runReaderT (runResourceT a) env++eventHandlerSource :: ConduitT () SomeMessage EventHandler ()+eventHandlerSource =+ asks Internal.eventQueue >>= \q ->+ forever $ yield =<< readSomeMessage q++eventHandler :: ConduitM SomeMessage EncodedResponse EventHandler ()+eventHandler =+ await >>= \case+ Nothing ->+ return () -- i.e. close the conduit -- TODO signal shutdown globally+ Just message -> do+ handleMessage (fromMessage message, fromMessage message)+ eventHandler++type EncodedResponse = C.Flush ByteString++yield' :: (MonadUnliftIO io) => MsgpackRPC.Message -> ConduitM i EncodedResponse io ()+yield' o = do+ liftIO . debugM "EventHandler" $ "Sending: " ++ show o+ yield . Chunk . encode $ toObject o+ yield Flush++handleMessage ::+ (Maybe FunctionCall, Maybe MsgpackRPC.Message) ->+ ConduitM i EncodedResponse EventHandler ()+handleMessage = \case+ (Just (FunctionCall fn params reply time), _) -> do+ cfg <- asks Internal.customConfig+ messageId <- atomically' $ do+ i <- readTVar (nextMessageId cfg)+ modifyTVar' (nextMessageId cfg) succ+ modifyTVar' (recipients cfg) $ Map.insert i (time, reply)+ return i+ yield' $ MsgpackRPC.Request (Request fn messageId params)+ (_, Just r@MsgpackRPC.Response{}) ->+ yield' r+ (_, Just n@MsgpackRPC.Notification{}) ->+ yield' n+ _ ->+ return () -- i.e. skip to next message
+ src/Neovim/RPC/FunctionCall.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++{- |+Module : Neovim.RPC.FunctionCall+Description : Functions for calling functions+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.RPC.FunctionCall (+ acall,+ scall,+ scall',+ scallThrow,+ atomically',+ wait,+ wait',+ respond,+) where++import Neovim.Classes+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes (FunctionName)+import Neovim.Plugin.IPC.Classes+import qualified Neovim.RPC.Classes as MsgpackRPC++import Control.Applicative+import Control.Monad (void, (<=<))+import Control.Monad.Reader+import Data.MessagePack++import UnliftIO (STM, atomically, newEmptyTMVarIO, readTMVar, throwIO)+import Prelude++-- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result.+acall ::+ (NvimObject result) =>+ FunctionName ->+ [Object] ->+ Neovim env (STM (Either NeovimException result))+acall fn parameters = do+ q <- Internal.asks' Internal.eventQueue+ mv <- liftIO newEmptyTMVarIO+ timestamp <- liftIO getCurrentTime+ writeMessage q $ FunctionCall fn parameters mv timestamp+ return $ convertObject <$> readTMVar mv+ where+ convertObject ::+ (NvimObject result) =>+ Either Object Object ->+ Either NeovimException result+ convertObject = \case+ Left e -> Left $ ErrorResult (pretty fn) e+ Right o -> case fromObject o of+ Left e -> Left $ ErrorMessage e+ Right r -> Right r++{- | Call a neovim function synchronously. This function blocks until the+ result is available.+-}+scall ::+ (NvimObject result) =>+ FunctionName ->+ -- | Parameters in an 'Object' array+ [Object] ->+ -- | result value of the call or the thrown exception+ Neovim env (Either NeovimException result)+scall fn parameters = acall fn parameters >>= atomically'++-- | Similar to 'scall', but throw a 'NeovimException' instead of returning it.+scallThrow ::+ (NvimObject result) =>+ FunctionName ->+ [Object] ->+ Neovim env result+scallThrow fn parameters = scall fn parameters >>= either throwIO return++{- | Helper function similar to 'scall' that throws a runtime exception if the+ result is an error object.+-}+scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result+scall' fn = either throwIO pure <=< scall fn++-- | Lifted variant of 'atomically'.+atomically' :: (MonadIO io) => STM result -> io result+atomically' = liftIO . atomically++{- | Wait for the result of the STM action.++ This action possibly blocks as it is an alias for+ @ \ioSTM -> ioSTM >>= liftIO . atomically@.+-}+wait :: Neovim env (STM result) -> Neovim env result+wait = (=<<) atomically'++-- | Variant of 'wait' that discards the result.+wait' :: Neovim env (STM result) -> Neovim env ()+wait' = void . wait++-- | Send the result back to the neovim instance.+respond :: (NvimObject result) => Request -> Either String result -> Neovim env ()+respond Request{..} result = do+ q <- Internal.asks' Internal.eventQueue+ writeMessage q . MsgpackRPC.Response reqId $+ either (Left . toObject) (Right . toObject) result
+ src/Neovim/RPC/SocketReader.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE LambdaCase #-}+{- |+Module : Neovim.RPC.SocketReader+Description : The component which reads RPC messages from the neovim instance+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+-}+module Neovim.RPC.SocketReader (+ runSocketReader,+ parseParams,+) where++import Neovim.Classes ( Int64, NvimObject(toObject, fromObject) )+import Neovim.Context ( MonadIO(liftIO), asks, Neovim, runNeovim )+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes (+ CommandArguments (..),+ CommandOption (..),+ FunctionName (..),+ FunctionalityDescription (..),+ NeovimEventId (..),+ NvimMethod (..),+ Subscription (..),+ getCommandOptions,+ )+import Neovim.Plugin.IPC.Classes+ ( getCurrentTime,+ Notification(Notification),+ Request(Request),+ writeMessage )+import qualified Neovim.RPC.Classes as MsgpackRPC+import Neovim.RPC.Common ( RPCConfig(recipients) )+import Neovim.RPC.FunctionCall ( atomically' )++import Conduit as C+ ( Void,+ MonadTrans(lift),+ sourceHandle,+ (.|),+ awaitForever,+ runConduit,+ ConduitT )+import Control.Monad (void)+import Data.Conduit.Cereal (conduitGet2)+import Data.Default (def)+import Data.Foldable (foldl', forM_)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.MessagePack ( Object(ObjectArray) )+import qualified Data.Serialize (get)+import System.IO (Handle)+import System.Log.Logger ( debugM, errorM, warningM )+import UnliftIO (atomically, timeout, readTVarIO, modifyTVar', putTMVar, readTMVar, async, newEmptyTMVarIO, modifyTVar)++import Prelude++logger :: String+logger = "Socket Reader"++type SocketHandler = Neovim RPCConfig++{- | This function will establish a connection to the given socket and read+ msgpack-rpc events from it.+-}+runSocketReader ::+ Handle ->+ Internal.Config RPCConfig ->+ IO ()+runSocketReader readableHandle cfg =+ void . runNeovim (Internal.retypeConfig (Internal.customConfig cfg) cfg) . runConduit $ do+ sourceHandle readableHandle+ .| conduitGet2 Data.Serialize.get+ .| messageHandlerSink++{- | Sink that delegates the messages depending on their type.+ <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>+-}+messageHandlerSink :: ConduitT Object Void SocketHandler ()+messageHandlerSink = awaitForever $ \rpc -> do+ liftIO . debugM logger $ "Received: " <> show rpc+ case fromObject rpc of+ Right (MsgpackRPC.Request (Request fn i ps)) ->+ handleRequest i fn ps+ Right (MsgpackRPC.Response i r) ->+ handleResponse i r+ Right (MsgpackRPC.Notification (Notification eventId args)) ->+ handleNotification eventId args+ Left e ->+ liftIO . errorM logger $ "Unhandled rpc message: " <> show e++handleResponse :: Int64 -> Either Object Object -> ConduitT a Void SocketHandler ()+handleResponse i result = do+ answerMap <- asks recipients+ mReply <- Map.lookup i <$> liftIO (readTVarIO answerMap)+ case mReply of+ Nothing ->+ liftIO $ warningM logger "Received response but could not find a matching recipient."+ Just (_, reply) -> do+ 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 params = do+ cfg <- lift Internal.ask'+ void . liftIO . async $ timeout (10 * 1000 * 1000) (handle cfg)+ return ()+ where+ handle :: Internal.Config RPCConfig -> IO ()+ handle rpc =+ lookupFunction rpc functionToCall >>= \case+ Nothing -> do+ let errM = "No provider for: " <> show functionToCall+ debugM logger errM+ writeMessage (Internal.eventQueue rpc) $+ MsgpackRPC.Response requestId (Left (toObject errM))+ Just (copts, Internal.Stateful c) -> do+ now <- liftIO getCurrentTime+ reply <- liftIO newEmptyTMVarIO+ let q = (recipients . Internal.customConfig) rpc+ liftIO . debugM logger $ "Executing stateful function with ID: " <> show requestId+ atomically' . modifyTVar q $ Map.insert requestId (now, reply)+ writeMessage c $ Request functionToCall requestId (parseParams copts params)++handleNotification :: NeovimEventId -> [Object] -> ConduitT a Void SocketHandler ()+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+ -- Defining a function on the remote host creates a function that, that+ -- passes all arguments in a list. At the time of this writing, no other+ -- arguments are passed for such a function.+ --+ -- The function generating the function on neovim side is called:+ -- @remote#define#FunctionOnHost@+ [ObjectArray fArgs] -> fArgs+ _ -> args+parseParams cmd@(Command _ opts) args = case args of+ (ObjectArray _ : _) ->+ let cmdArgs = filter isPassedViaRPC (getCommandOptions opts)+ (c, args') = foldl' createCommandArguments (def, []) $ zip cmdArgs args+ in toObject c : args'+ _ -> parseParams cmd [ObjectArray args]+ where+ isPassedViaRPC :: CommandOption -> Bool+ isPassedViaRPC = \case+ CmdSync{} -> False+ _ -> True++ -- Neovim passes arguments in a special form, depending on the+ -- CommandOption values used to export the (command) function (e.g. via+ -- 'command' or 'command'').+ createCommandArguments ::+ (CommandArguments, [Object]) ->+ (CommandOption, Object) ->+ (CommandArguments, [Object])+ createCommandArguments old@(c, args') = \case+ (CmdRange _, o) ->+ either (const old) (\r -> (c{range = Just r}, args')) $ fromObject o+ (CmdCount _, o) ->+ either (const old) (\n -> (c{count = Just n}, args')) $ fromObject o+ (CmdBang, o) ->+ either (const old) (\b -> (c{bang = Just b}, args')) $ fromObject o+ (CmdNargs "*", ObjectArray os) ->+ -- CommandArguments -> [String] -> Neovim r st a+ (c, os)+ (CmdNargs "+", ObjectArray (o : os)) ->+ -- CommandArguments -> String -> [String] -> Neovim r st a+ (c, o : [ObjectArray os])+ (CmdNargs "?", ObjectArray [o]) ->+ -- CommandArguments -> Maybe String -> Neovim r st a+ (c, [toObject (Just o)])+ (CmdNargs "?", ObjectArray []) ->+ -- CommandArguments -> Maybe String -> Neovim r st a+ (c, [toObject (Nothing :: Maybe Object)])+ (CmdNargs "0", ObjectArray []) ->+ -- CommandArguments -> Neovim r st a+ (c, [])+ (CmdNargs "1", ObjectArray [o]) ->+ -- CommandArguments -> String -> Neovim r st a+ (c, [o])+ (CmdRegister, o) ->+ either (const old) (\r -> (c{register = Just r}, args')) $ fromObject o+ _ -> old+parseParams Autocmd{} args = case args of+ [ObjectArray fArgs] -> fArgs+ _ -> args
+ src/Neovim/Test.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{- |+Module : Neovim.Test+Description : Testing functions+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Test (+ runInEmbeddedNeovim,+ runInEmbeddedNeovim',+ Seconds (..),+ TestConfiguration (..),+ -- deprecated+ testWithEmbeddedNeovim,+) where++import Neovim+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)+import Neovim.RPC.SocketReader (runSocketReader)++import Control.Monad.Reader (runReaderT)+import Data.Default (Default)+import Data.Text (pack)+import GHC.IO.Exception (ioe_filename)+import Neovim.Plugin (startPluginThreads)+import Neovim.Util (oneLineErrorMessage)+import Prettyprinter (annotate, vsep)+import Prettyprinter.Render.Terminal (Color (..), color)+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++newtype TestConfiguration = TestConfiguration+ { cancelAfter :: Seconds+ }+ deriving (Show)++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.+-}+runInEmbeddedNeovim :: TestConfiguration -> Plugin env -> Neovim env a -> IO ()+runInEmbeddedNeovim TestConfiguration{..} plugin action =+ warnIfNvimIsNotOnPath runTest+ where+ runTest = do+ 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'++ result <- timeout (microSeconds cancelAfter) (takeMVar resultMVar)++ waitExitCode nvimProcess >>= \case+ ExitFailure i ->+ fail $ "Neovim returned with an exit status of: " ++ show i+ ExitSuccess -> case result of+ Nothing -> fail "Test timed out"+ Just _ -> pure ()+ cleanUp++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 FilePath ->+ -- | 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 " ++ f++warnIfNvimIsNotOnPath :: IO a -> IO ()+warnIfNvimIsNotOnPath test = void test `catch` \(e :: IOException) -> case ioe_filename e of+ Just "nvim" ->+ putDoc . annotate (color Red) $+ vsep+ [ "The neovim executable 'nvim' is not on the PATH."+ , "You may not be testing fully!"+ ]+ _ ->+ throwIO e++startEmbeddedNvim ::+ Seconds ->+ 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"]++ cfg <- Internal.newConfig (pure Nothing) newRPCConfig++ socketReader <-+ async . void $+ runSocketReader+ (getStdout nvimProcess)+ (cfg{Internal.pluginSettings = Nothing})++ eventHandler <-+ async . void $+ runEventHandler+ (getStdin nvimProcess)+ (cfg{Internal.pluginSettings = Nothing})++ let actionCfg = Internal.retypeConfig (environment plugin) cfg+ action' = runReaderT 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, transitionHandler]+ ++ pluginHandlers++ pure (nvimProcess, cleanUp)
+ src/Neovim/Util.hs view
@@ -0,0 +1,32 @@+{- |+Module : Neovim.Util+Description : Utility functions+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC+-}+module Neovim.Util (+ whenM,+ unlessM,+ oneLineErrorMessage,+) where++import Control.Monad (unless, when)+import qualified Data.Text as T+import Neovim.Context++-- | 'when' with a monadic predicate.+whenM :: (Monad m) => m Bool -> m () -> m ()+whenM mp a = mp >>= \p -> when p a++-- | 'unless' with a monadic predicate.+unlessM :: (Monad m) => m Bool -> m () -> m ()+unlessM mp a = mp >>= \p -> unless p a++oneLineErrorMessage :: Doc AnsiStyle -> T.Text+oneLineErrorMessage d = case T.lines $ docToText d of+ (x : _) -> x+ [] -> mempty
+ 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/Neovim/API/THSpec.hs
@@ -1,117 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-module Neovim.API.THSpec- where--import Neovim.API.THSpecFunctions--import Neovim.API.TH hiding (function)-import qualified Neovim.API.TH as TH-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes-import Neovim.Plugin.Internal--import Data.Default-import qualified Data.Map as Map--import Test.Hspec-import Test.QuickCheck--call :: ([Object] -> Neovim () Object) -> [Object]- -> IO Object-call f args = do- cfg <- Internal.newConfig (pure Nothing) (pure ())- res <- runNeovim cfg (f args)- case res of- Right x -> return x- Left e -> (throwIO . ErrorMessage) e---isNeovimException :: NeovimException -> Bool-isNeovimException _ = True---spec :: Spec-spec = do- describe "calling function without an argument" $ do- let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync- it "should have a capitalized prefix" $- fname `shouldBe` (F "TestFunction0")-- it "should return the consant value" $- call testFun [] `shouldReturn` ObjectInt 42-- it "should fail if supplied an argument" $- call testFun [ObjectNil] `shouldThrow` isNeovimException--- describe "calling testFunction with two arguments" $ do- let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync- it "should have a capitalized prefix" $- fname `shouldBe` (F "TestFunction2")-- it "should return 2 for proper arguments" $- call testFun [ ObjectNil- , ObjectString "ignored"- , ObjectArray [ObjectString "42"]- ]- `shouldReturn` ObjectDouble 2-- it "should throw an exception for the wrong number of arguments" $- call testFun [ObjectNil] `shouldThrow` isNeovimException-- it "should throw an exception for incompatible types" $- call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"]- `shouldThrow` isNeovimException-- it "should cast arguments to similar types" $- call testFun [ObjectNil, ObjectString "ignored", ObjectArray []]- `shouldReturn` ObjectDouble 2--- describe "generating a command from the two argument test function" $ do- let EF (Command fname _, _) = $(command' 'testFunction2) []- it "should capitalize the first character" $- fname `shouldBe` (F "TestFunction2")-- describe "generating the test successor functions" $ do- let EF (Function fname _, testFun) = $(function' 'testSucc) Sync- it "should be named TestSucc" $- fname `shouldBe` (F "TestSucc")-- it "should return the old value + 1" . property $- \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x+1)-- describe "calling test function with a map argument" $ do- let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync- it "should capitalize the first letter" $- fname `shouldBe` (F "TestFunctionMap")-- it "should fail for the wrong number of arguments" $- call testFun [] `shouldThrow` isNeovimException-- it "should fail for the wrong type of arguments" $- call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException-- it "should return Nothing for an empty map" $- call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"]- `shouldReturn` ObjectNil-- it "should return just the value for the singletion entry" $- call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"]- `shouldReturn` ObjectInt 7--- describe "Calling function with an optional argument" $ do- let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) []- defCmdArgs = toObject (def :: CommandArguments)- it "should capitalize the first letter" $- cname `shouldBe` (F "TestCommandOptArgument")-- it "should return \"default\" when passed no argument" $ do- call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String)-- it "should return what is passed otherwise" . property $ do- \str -> call testFun [defCmdArgs, toObject str]- `shouldReturn` toObject (str :: String)
− test-suite/Neovim/API/THSpecFunctions.hs
@@ -1,22 +0,0 @@-module Neovim.API.THSpecFunctions- where--import qualified Data.Map as Map-import Neovim--testFunction0 :: Neovim env Int-testFunction0 = return 42--testFunction2 :: CommandArguments -> String -> [String] -> Neovim env Double-testFunction2 _ _ _ = return 2--testFunctionMap :: Map.Map String Int -> String -> Neovim env (Maybe Int)-testFunctionMap m k = return $ Map.lookup k m--testSucc :: Int -> Neovim env Int-testSucc = return . succ--testCommandOptArgument :: CommandArguments -> Maybe String -> Neovim env String-testCommandOptArgument _ ms = case ms of- Just x -> return x- Nothing -> return "default"
− test-suite/Neovim/EmbeddedRPCSpec.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE LambdaCase #-}-module Neovim.EmbeddedRPCSpec- where--import Test.Hspec-import Test.HUnit--import Neovim-import Neovim.API.Text-import qualified Neovim.Context.Internal as Internal-import Neovim.Quickfix-import Neovim.RPC.Common-import Neovim.RPC.EventHandler-import Neovim.RPC.FunctionCall (atomically')-import Neovim.RPC.SocketReader-import Neovim.Test--import Control.Concurrent-import Control.Concurrent.STM-import Control.Monad.Reader (runReaderT)-import Control.Monad.State (runStateT)-import qualified Data.Map as Map-import Path-import Path.IO-import System.Exit (ExitCode (..))-import System.Process.Typed---spec :: Spec-spec = parallel $ do- let withNeovimEmbedded f a = testWithEmbeddedNeovim f (Seconds 3) () a- describe "Read hello test file" .- it "should match 'Hello, World!'" . withNeovimEmbedded Nothing $ do- nvim_command "edit test-files/hello"- bs <- vim_get_buffers- l <- vim_get_current_line- liftIO $ l `shouldBe` "Hello, World!"- liftIO $ length bs `shouldBe` 1-- describe "New empty buffer test" $ do- it "should contain the test text" . withNeovimEmbedded Nothing $ do- cl0 <- vim_get_current_line- liftIO $ cl0 `shouldBe` ""- bs <- vim_get_buffers- liftIO $ length bs `shouldBe` 1-- let testContent = "Test on empty buffer"- vim_set_current_line testContent- cl1 <- vim_get_current_line- liftIO $ cl1 `shouldBe` testContent-- it "should create a new buffer" . withNeovimEmbedded Nothing $ do- bs0 <- vim_get_buffers- liftIO $ length bs0 `shouldBe` 1- vim_command "new"- bs1 <- vim_get_buffers- liftIO $ length bs1 `shouldBe` 2- vim_command "new"- bs2 <- vim_get_buffers- liftIO $ length bs2 `shouldBe` 3-- it "should set the quickfix list" . withNeovimEmbedded Nothing $ do- let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String- setqflist [q] Replace- q' <- vim_eval "getqflist()"- liftIO $ fromObjectUnsafe q' `shouldBe` [q]-
− test-suite/Neovim/Plugin/ClassesSpec.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-}-{-# LANGUAGE RecordWildCards #-}-module Neovim.Plugin.ClassesSpec- where--import Neovim-import Neovim.Plugin.Classes--import Test.Hspec-import Test.QuickCheck---newtype RandomCommandArguments = RCA { getRandomCommandArguments :: CommandArguments }- deriving (Eq, Ord, Show, Read)---instance Arbitrary RandomCommandArguments where- arbitrary = do- bang <- arbitrary- range <- arbitrary- count <- arbitrary- register <- fmap (fmap getNonEmpty) arbitrary- return . RCA $ CommandArguments{..}---newtype RandomCommandOption = RCO { getRandomCommandOption :: CommandOption }- deriving (Eq, Ord, Show, Read)---instance Arbitrary RandomCommandOption where- arbitrary = do- a <- choose (0,5) :: Gen Int- o <- case a of- -- XXX Most constructor arguments are not tested anyway, so they are- -- hardcoded for now.- 0 -> CmdSync <$> elements [Sync, Async]- 1 -> return CmdRegister- 2 -> return $ CmdNargs ""- 3 -> CmdRange <$> elements [CurrentLine, WholeFile, RangeCount 1]- 4 -> CmdCount <$> arbitrary- _ -> return CmdBang- return $ RCO o---newtype RandomCommandOptions = RCOs { getRandomCommandOptions :: CommandOptions }- deriving (Eq, Ord, Show, Read)---instance Arbitrary RandomCommandOptions where- arbitrary = do- l <- choose (0,20)- (RCOs . mkCommandOptions . map getRandomCommandOption) <$> vectorOf l arbitrary---spec :: Spec-spec = do- describe "Deserializing and serializing" $ do- it "should be id for CommandArguments" . property $ do- \args -> (fromObjectUnsafe . toObject . getRandomCommandArguments) args- `shouldBe` getRandomCommandArguments args-- describe "If a sync option is set for commands" $ do- let isSyncOption = \case- CmdSync _ -> True- _ -> False- it "must be at the head of the list" . property $ do- \(RCOs opts) -> any isSyncOption (getCommandOptions opts) ==> do- length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1- head (getCommandOptions opts) `shouldSatisfy` isSyncOption-
− test-suite/Neovim/RPC/SocketReaderSpec.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Neovim.RPC.SocketReaderSpec- where--import Neovim-import Neovim.Plugin.Classes-import Neovim.RPC.SocketReader (parseParams)--import Test.Hspec--spec :: Spec-spec = do- describe "parseParams" $ do-- it "should pass the inner argument list as is for functions" $ do- parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]]- `shouldBe` [ObjectNil, ObjectBinary "ABC"]- parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"]- `shouldBe` [ObjectNil, ObjectBinary "ABC"]- parseParams (Function (F "") Sync) []- `shouldBe` []-- let defCmdArgs = def :: CommandArguments- it "should filter out implicit arguments" $ do- parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))- [ObjectArray []]- `shouldBe` [toObject defCmdArgs]- parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))- [ObjectArray [ObjectBinary "7", ObjectInt 7]]- `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7]-- it "should set the CommandOptions argument as expected" $ do- parseParams (Command (F "") (mkCommandOptions- [ CmdRange WholeFile, CmdBang, CmdNargs "*"]))- [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil]- , ObjectArray [ObjectInt 1, ObjectInt 12]- , ObjectInt 1- ]- `shouldBe` [ toObject (defCmdArgs { bang = Just True, range = Just (1,12) })- , ObjectBinary "7"- , ObjectBinary "8"- , ObjectNil]-- it "should pass this test" $ do- parseParams (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang]))- [ ObjectArray [ ObjectBinary "me"- , ObjectBinary "up"- , ObjectBinary "before"- , ObjectBinary "you"- , ObjectBinary "go"- , ObjectBinary "go"- ]- , ObjectArray [ ObjectInt 1- , ObjectInt 27- ]- , ObjectInt 0- ]- `shouldBe` [ toObject (defCmdArgs { bang = Just False, range = Just (1,27) })- , ObjectBinary "me"- , ObjectArray [ ObjectBinary "up"- , ObjectBinary "before"- , ObjectBinary "you"- , ObjectBinary "go"- , ObjectBinary "go"- ]- ]-
− test-suite/Spec.hs
@@ -1,1 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/API/THSpec.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-overlapping-patterns #-}++module API.THSpec where++import API.THSpecFunctions++import Neovim.API.TH hiding (function)+import qualified Neovim.API.TH as TH+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes+import Neovim.Plugin.Internal++import Data.Default+import qualified Data.Map as Map++import Test.Hspec+import Test.QuickCheck++call ::+ ([Object] -> Neovim () Object) ->+ [Object] ->+ IO Object+call f args = do+ cfg <- Internal.newConfig (pure Nothing) (pure ())+ res <- runNeovim cfg (f args)+ case res of+ Right x -> return x+ Left e -> (throwIO . ErrorMessage) e++isNeovimException :: NeovimException -> Bool+isNeovimException _ = True++spec :: Spec+spec = do+ describe "calling function without an argument" $ do+ let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` F "TestFunction0"++ it "should return the consant value" $+ call testFun [] `shouldReturn` ObjectInt 42++ it "should fail if supplied an argument" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException++ describe "calling testFunction with two arguments" $ do+ let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` F "TestFunction2"++ it "should return 2 for proper arguments" $+ call+ testFun+ [ ObjectNil+ , ObjectString "ignored"+ , ObjectArray [ObjectString "42"]+ ]+ `shouldReturn` ObjectDouble 2++ it "should throw an exception for the wrong number of arguments" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException++ it "should throw an exception for incompatible types" $+ call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"]+ `shouldThrow` isNeovimException++ it "should cast arguments to similar types" $+ call testFun [ObjectNil, ObjectString "ignored", ObjectArray []]+ `shouldReturn` ObjectDouble 2++ describe "generating a command from the two argument test function" $ do+ let EF (Command fname _, _) = $(command' 'testFunction2) []+ it "should capitalize the first character" $+ fname `shouldBe` F "TestFunction2"++ describe "generating the test successor functions" $ do+ let EF (Function fname _, testFun) = $(function' 'testSucc) Sync+ it "should be named TestSucc" $+ fname `shouldBe` F "TestSucc"++ it "should return the old value + 1" . property $+ \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x + 1)++ describe "calling test function with a map argument" $ do+ let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync+ it "should capitalize the first letter" $+ fname `shouldBe` F "TestFunctionMap"++ it "should fail for the wrong number of arguments" $+ call testFun [] `shouldThrow` isNeovimException++ it "should fail for the wrong type of arguments" $+ call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException++ it "should return Nothing for an empty map" $+ call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectNil++ it "should return just the value for the singletion entry" $+ call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectInt 7++ describe "Calling function with an optional argument" $ do+ let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) []+ defCmdArgs = toObject (def :: CommandArguments)+ it "should capitalize the first letter" $+ cname `shouldBe` F "TestCommandOptArgument"++ it "should return \"default\" when passed no argument" $ do+ call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String)++ it "should return what is passed otherwise" . property $ do+ \str ->+ call testFun [defCmdArgs, toObject str]+ `shouldReturn` toObject (str :: String)
+ tests/API/THSpecFunctions.hs view
@@ -0,0 +1,21 @@+module API.THSpecFunctions where++import qualified Data.Map as Map+import Neovim++testFunction0 :: Neovim env Int+testFunction0 = return 42++testFunction2 :: CommandArguments -> String -> [String] -> Neovim env Double+testFunction2 _ _ _ = return 2++testFunctionMap :: Map.Map String Int -> String -> Neovim env (Maybe Int)+testFunctionMap m k = return $ Map.lookup k m++testSucc :: Int -> Neovim env Int+testSucc = return . succ++testCommandOptArgument :: CommandArguments -> Maybe String -> Neovim env String+testCommandOptArgument _ ms = case ms of+ Just x -> return x+ Nothing -> return "default"
+ tests/AsyncFunctionSpec.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+module AsyncFunctionSpec where++import Neovim+import Neovim.API.Text+import Neovim.Plugin.Classes (FunctionName (..), FunctionalityDescription (..))+import Neovim.Plugin.Internal (ExportedFunctionality (..))+import Neovim.Test++import Test.Hspec++import UnliftIO++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+ void $ nvim_call_function "MyAsyncTestFunction" mempty++ liftIO $ readMVar called `shouldReturn` ()
+ tests/EmbeddedRPCSpec.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module EmbeddedRPCSpec where++import Test.Hspec++import Neovim+import Neovim.API.Text+import Neovim.Context (docToText)+import Neovim.Quickfix+import Neovim.Test++{- | 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+ see the test failing.+-}+spec :: Spec+spec = parallel $ 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+ liftIO $ l `shouldBe` "Hello, World!"+ liftIO $ length bs `shouldBe` 1++ describe "New empty buffer test" $ do+ it "should contain the test text" . runInEmbeddedNeovim' def $ do+ cl0 <- vim_get_current_line+ liftIO $ cl0 `shouldBe` ""+ bs <- vim_get_buffers+ liftIO $ length bs `shouldBe` 1++ let testContent = "Test on empty buffer"+ vim_set_current_line testContent+ cl1 <- vim_get_current_line+ liftIO $ cl1 `shouldBe` testContent++ it "should create a new buffer" . runInEmbeddedNeovim' def $ do+ bs0 <- vim_get_buffers+ liftIO $ length bs0 `shouldBe` 1+ vim_command "new"+ bs1 <- vim_get_buffers+ liftIO $ length bs1 `shouldBe` 2+ vim_command "new"+ bs2 <- vim_get_buffers+ liftIO $ length bs2 `shouldBe` 3++ 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" . runInEmbeddedNeovim' def $ do+ let getVariableValue = False <$ vim_get_var "notDefined"+ hasTrhownNeovimExceptionWithFunctionName <-+ getVariableValue `catchNeovimException` \case+ ErrorResult f _ -> pure $ docToText f == "vim_get_var"+ _ -> pure False+ liftIO $ hasTrhownNeovimExceptionWithFunctionName `shouldBe` True++ it "catches" . runInEmbeddedNeovim' def $ do+ let getUndefinedVariable = vim_get_var "notDefined"+ functionThatFailed <-+ getUndefinedVariable `catchNeovimException` \case+ ErrorResult f _ -> pure . toObject $ docToText f+ _ -> pure ObjectNil+ liftIO $ functionThatFailed `shouldBe` toObject ("vim_get_var" :: String)
+ tests/EventSubscriptionSpec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module EventSubscriptionSpec where++import Neovim+import Neovim.API.String+import Neovim.Test++import Test.Hspec++import UnliftIO (newEmptyMVar, putMVar, readMVar)++data BufLinesEvent = BufLinesEvent+ { bleBuffer :: Buffer+ , bleFirstLine :: Int+ , bleLastLine :: Int+ , bleLines :: [String]+ , bleMore :: Bool+ }+ deriving (Eq, Show)++parseBufLinesEvent :: [Object] -> Either (Doc AnsiStyle) BufLinesEvent+parseBufLinesEvent event = case event of+ [buf, _changedTick, firstline, lastline, linedata, more] -> do+ bleBuffer <- fromObject buf+ bleFirstLine <- fromObject firstline+ bleLastLine <- fromObject lastline+ bleLines <- fromObject linedata+ bleMore <- fromObject more+ pure BufLinesEvent{..}+ _ -> Left . pretty $ "Unexpected nvim_buf_lines_event: " ++ show event++spec :: Spec+spec = parallel $ do+ describe "Attaching to a buffer" $ do+ it "receives nvim_buf_lines_event" . runInEmbeddedNeovim' def $ do+ received <- newEmptyMVar+ subscription <- subscribe "nvim_buf_lines_event" $ putMVar received . parseBufLinesEvent+ buf <- nvim_create_buf True False+ isOk <- nvim_buf_attach buf True []++ liftIO $ do+ isOk `shouldBe` True+ Right BufLinesEvent{..} <- readMVar received+ bleBuffer `shouldBe` buf+ bleFirstLine `shouldBe` 0+ bleLastLine `shouldBe` -1+ bleLines `shouldBe` [""]+ bleMore `shouldBe` False+ unsubscribe subscription++ it "receives nvim_buf_detach_event" . runInEmbeddedNeovim' def $ do+ received <- newEmptyMVar+ subscription <- subscribe "nvim_buf_detach_event" $ putMVar received+ buf <- nvim_create_buf True False+ isOk <- nvim_buf_attach buf False []+ void $ nvim_buf_detach buf++ liftIO $ do+ isOk `shouldBe` True+ [buf'] <- readMVar received+ fromObjectUnsafe buf' `shouldBe` buf+ unsubscribe subscription
+ tests/Plugin/ClassesSpec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module Plugin.ClassesSpec where++import Neovim+import Neovim.Plugin.Classes++import Test.Hspec+import Test.QuickCheck++newtype RandomCommandArguments = RCA {getRandomCommandArguments :: CommandArguments}+ deriving (Eq, Ord, Show, Read)++instance Arbitrary RandomCommandArguments where+ arbitrary = do+ bang <- arbitrary+ range <- arbitrary+ count <- arbitrary+ register <- fmap (fmap getNonEmpty) arbitrary+ return . RCA $ CommandArguments{..}++newtype RandomCommandOption = RCO {getRandomCommandOption :: CommandOption}+ deriving (Eq, Ord, Show, Read)++instance Arbitrary RandomCommandOption where+ arbitrary = do+ a <- choose (0, 5) :: Gen Int+ o <- case a of+ -- XXX Most constructor arguments are not tested anyway, so they are+ -- hardcoded for now.+ 0 -> CmdSync <$> elements [Sync, Async]+ 1 -> return CmdRegister+ 2 -> return $ CmdNargs ""+ 3 -> CmdRange <$> elements [CurrentLine, WholeFile, RangeCount 1]+ 4 -> CmdCount <$> arbitrary+ _ -> return CmdBang+ return $ RCO o++newtype RandomCommandOptions = RCOs {getRandomCommandOptions :: CommandOptions}+ deriving (Eq, Ord, Show, Read)++instance Arbitrary RandomCommandOptions where+ arbitrary = do+ l <- choose (0, 20)+ RCOs . mkCommandOptions . map getRandomCommandOption <$> vectorOf l arbitrary++spec :: Spec+spec = do+ describe "Deserializing and serializing" $ do+ it "should be id for CommandArguments" . property $ do+ \args ->+ (fromObjectUnsafe . toObject . getRandomCommandArguments) args+ `shouldBe` getRandomCommandArguments args++ describe "If a sync option is set for commands" $ do+ let isSyncOption = \case+ CmdSync _ -> True+ _ -> False+ it "must be at the head of the list" . property $ do+ \(RCOs opts) ->+ any isSyncOption (getCommandOptions opts) ==> do+ length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1+ head (getCommandOptions opts) `shouldSatisfy` isSyncOption
+ tests/RPC/CommonSpec.hs view
@@ -0,0 +1,20 @@+module RPC.CommonSpec where++import Neovim.RPC.Common++import Test.Hspec++spec :: Spec+spec = do+ describe "Parsing of $NVIM environment variable" $ do+ it "is a UnixSocket if it doesn't contain a colon" $ do+ UnixSocket actual <- parseNvimEnvironmentVariable "/some/file"+ actual `shouldBe` "/some/file"+ it "is a tcp connection if it contains a colon" $ do+ TCP actualPort actualHostname <- parseNvimEnvironmentVariable "localhost:12345"+ actualPort `shouldBe` 12345+ actualHostname `shouldBe` "localhost"+ it "the last number after many colons is the port" $ do+ TCP actualPort actualHostname <- parseNvimEnvironmentVariable "the:cake:is:a:lie:777"+ actualPort `shouldBe` 777+ actualHostname `shouldBe` "the:cake:is:a:lie"
+ tests/RPC/SocketReaderSpec.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module RPC.SocketReaderSpec where++import Neovim+import Neovim.Plugin.Classes+import Neovim.RPC.SocketReader (parseParams)++import Test.Hspec++spec :: Spec+spec = do+ describe "parseParams" $ do+ it "should pass the inner argument list as is for functions" $ do+ parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) []+ `shouldBe` []++ let defCmdArgs = def :: CommandArguments+ it "should filter out implicit arguments" $ do+ parseParams+ (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray []]+ `shouldBe` [toObject defCmdArgs]+ parseParams+ (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray [ObjectBinary "7", ObjectInt 7]]+ `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7]++ it "should set the CommandOptions argument as expected" $ do+ parseParams+ ( Command+ (F "")+ ( mkCommandOptions+ [CmdRange WholeFile, CmdBang, CmdNargs "*"]+ )+ )+ [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil]+ , ObjectArray [ObjectInt 1, ObjectInt 12]+ , ObjectInt 1+ ]+ `shouldBe` [ toObject (defCmdArgs{bang = Just True, range = Just (1, 12)})+ , ObjectBinary "7"+ , ObjectBinary "8"+ , ObjectNil+ ]++ it "should pass this test" $ do+ parseParams+ (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang]))+ [ ObjectArray+ [ ObjectBinary "me"+ , ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ , ObjectArray+ [ ObjectInt 1+ , ObjectInt 27+ ]+ , ObjectInt 0+ ]+ `shouldBe` [ toObject (defCmdArgs{bang = Just False, range = Just (1, 27)})+ , ObjectBinary "me"+ , ObjectArray+ [ ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ ]
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}