diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,35 @@ +# 2.0.0.0 + +* Your configuration is now just a Haskell project. The dependency to Dyre has + been removed and you are now forced to write a line of vimL and add a normal + nvim-plugin to your setup. The template still does set everything up for you. + The distinction between a plugin and a personal nvim-hs configuration is now + gone and apart from settings things up, nothing has changed in this regard. + The nvim-plugin contains the necessary documentation on what to do and + should be available with `:help nvim-hs` when installed correctly. + +* Since basically all generated functions were throwing exceptions anyway, the + primed functions have become the default and if you want to explicitly handle + error cases, you have to surround your code with `catch` or something more + appropriate from `UnliftIO.Exception`. You have to remove `'` from your API + calls or you have to adjust your error handling. + +* There are now three flavors of APIs and you have to import one additionally to + importing the `Neovim` module: + + - *Neovim.API.Text*: This uses strict `Text` for strings and `Vector` as + lists. This is the recommended API to use. + + - *Neovim.API.String*: This is the same as before. Strings are `String` + and lists are `[]`. This is for the lazy and backwards-ish compatiblity. + + - *Neovim.API.ByteString*: This can be useful for really performance critical + stuff or if you`re writing a plugin for binary files. + +# 1.0.1.0 + +* The `Neovim.Debug` module is now more pleasant to use. + # 1.0.0.2 * With the api of neovim 0.3.0, a function was exposed that had a reserved diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -20,36 +20,34 @@ # How do I start using this? -First, you have to decide how you want to manage your plugins. Every section -of this chapter describes an alternative way to manage your plugins. It -starts with a list of pros and cons and then explains what you have to do to -get rolling and how you would install a `nvim-hs`-compatible plguin. The -general library documentation is in the haddocks on -([hackage](http://hackage.haskell.org/package/nvim-hs-0.2.0/docs/Neovim.html)). -If you are new to Haskell development or you don't really care how you manage -your plugins, I (saep) recommend the stack template approach. +You need to install a neovim plugin that manages starting of `nvim-hs` plugins. +Just follow the instructions here: +[nvim-hs.vim](https://github.com/neovimhaskell/nvim-hs.vim) -## Stack via the template +Once you have installed that plugin, you can use `nvim-hs` plugins as you would +normal vim plugins. Every plugin is started as a separate process which should +be fine unless you have a lot of them. -### Pros +You only have to read on if you want to start "scripting" functions or plugins +yourself in Haskell. -- Easy to setup because of the template -- Flexible dependency management; everything that stack supports can be done, this - includes packages on stackage, packages on hackage, local packages and repositories -- Reprobucible; if it works once, it will work in the future -- If you don't use stack just for neovim plugins and you have other projects with the - same (or a similiar) lts (long term support) version, you save compilation time on the - initial setup +# Scripting with Haskell -### Cons +The entry point for all Haskell-based scripts is a plugin. +An `nvim-hs` plugin is a plain Haskell project with two conventions: -- A bit verbose; you have to add dependencies twice if they are not in the stackage snapshot +1. You need an executable that starts a `msgpack-rpc` compatible client. -### Installation +2. You need a tiny bit of `vimL` in your runtime path that starts the plugin. -First, you must [install stack](https://docs.haskellstack.org/en/stable/README/). +The simplest way to get started is the stack template from this +repository/package inside your neovim configuration folder which +will be described here. (Alternatively, you can manually create a project +and do everything that is explained in `:help nvim-hs.txt` which should be +available if you installed the plugin mentioned in the previous section.) -You have to have installed neovim and the executable `nvim` must be on the path. +You need to [install stack](https://docs.haskellstack.org/en/stable/README/) +and have the neovim executable on the path. (The API code generation calls `nvim --api-info`.) Afterwards, you switch to your neovim configuration folder (typically `~/.config/nvim`) and @@ -59,150 +57,17 @@ > stack new my-nvim-hs https://raw.githubusercontent.com/neovimhaskell/nvim-hs/master/stack-template.hsfiles --bare --omit-packages --ignore-subdirs -Now, you have to compile everything. - -> stack setup - -> stack build - -If there are no errors (there shouldn't be any), you only have to tell neovim how to start this. -Add the following to your `init.vim`: - -```vimL -if has('nvim') " This way, you can also put this in your plain vim config - - " function which starts a nvim-hs instance with the supplied name - function! s:RequireHaskellHost(name) - " It is important that the current working directory (cwd) is where - " your configuration files are. - return jobstart(['stack', 'exec', 'nvim-hs', a:name.name], {'rpc': v:true, 'cwd': expand('$HOME') . '/.config/nvim'}) - endfunction - - " Register a plugin host that is started when a haskell file is opened - call remote#host#Register('haskell', "*.l\?hs", function('s:RequireHaskellHost')) - - " But if you need it for other files as well, you may just start it - " forcefully by requiring it - let hc=remote#host#Require('haskell') -endif -``` - -If you start neovim now, you can use the predefined functions from the template. +If you start neovim now, it will compile the example plugins which may take a +few minutes. Once it is started you can use the predefined functions from the +template. > :echo NextRandom() should print a random number. -### Installing a plugin from Hackage - -Let's take [nvim-hs-ghcid](http://hackage.haskell.org/package/nvim-hs-ghcid) -as an example. Let's also pretend, that it's not on stackage. -We have to declare the dependency -in the `my-nvim-hs.cabal` file and in the `stack.yaml` file. In the `.cabal` -file, add `nvim-hs-ghcid` to the `build-depends` section. It should look -like this: - -```cabal - build-depends: base >= 4.7 && < 5 - , nvim-hs >= 0.2.0 && < 1.0.0 - , nvim-hs-ghcid -``` - -You can omit the version number, since you will have to define it in the -`stack.yaml` file and you are managing you dependencies with stack anyways. -The `extra-deps` section of the `stack.yaml` should look like this: - -```yaml -extra-deps: -- nvim-hs-ghcid-0.2.0 -``` - -If `nvim-hs-ghcid` depended upon any other package that is not on stackage, -you would have to add those dependencies there as well. The output of -`stack build` should tell you which you have to add. You don't have to add -these transitive dependencies to the `build-depends` of the cabal file because -you are not accessing anything from these packages directly. - -Adding all these explicit versions seems to be the disadvantage of using stack. -However, the benefit is that you will have a -reproducible build in the future and you don't have to hunt down a working -set of version boundaries for every dependency you have. A little effort now -will save you more time later! - -To use the plugin, add it to the plugins list of the `nvim.hs` file in -`~/.config/nvim`: - -```haskell -import Neovim - -import qualified Neovim.Example.Plugin as Example -import qualified Neovim.Ghcid as Ghcid - -main :: IO () -main = do - neovim defaultConfig - { plugins = plugins defaultConfig ++ - [ Example.plugin - , Ghcid.plugin - ] - } -``` - -If you want to update a dependency/plugin, -you have to manually increment the version number in the stack.yaml file and -possibly fix the compilation errors that arise. If you want a rolling -release for a plugin, follow the instructions for installing a plugin from -git. - -### Installing a plugin from git - -This method is best suited for plugins that update a lot and for which you need -the most recent version most of the time. This also works for plugins that do not -have a hackage release. If you don't intend to work on the -code of that plugin repository, you can add it to the plugin list of your -plugin manager (e.g. [vim-plug](https://github.com/junegunn/vim-plug)). -This way, you get updates if you update all your normal vim plugins. -To stay with the example of the previous section, we use the `nvim-hs-ghcid` -plugin again. - -Add the plugin to your plugin manager (here with vim-plug as an example): - -```vimL -Plug 'saep/nvim-hs-ghcid', { 'for': ['haskell'] } -``` - -Once vim-plug has cloned or updated the repository, add the plugin to the -packages list of the `stackage.yaml` file. The packages list should look -like this: - -```yaml -packages: -- . -- plugged/nvim-hs-ghcid # or the appropriate relative path the folder you configured -``` - -As long as you have the repository in this list, you don't have to specify -it as a dependency anywhere else, you still have to add the plugins' -dependencies to the `stack.yaml` file, though. It chould look like this: - -```yaml -extra-deps: -- some-dependency-0.2.4 -- and-another-one-13.8.5.2 -``` - -Add the plugin to the plugins list in `nvim.hs` in exactly the same way as -described at the end of the previous chapter. - -The downside of this approach is that your compilation times will be longer the more -plugins you include this way. - -### Writing your own functions that you can call from neovim - -The stack template generated a few files for you that you can use as a -template to write your own plugins. If you edit them and make a mistake that -the Haskell compiler can detect, an item in the quickfix list should appear. -This is, unless you removed `plugins defaultConfig` from `nvim.hs`. +To start writing your own functions and plugins, read through the files +generated by the template accompanied by the +[library documentation on hackage](http://hackage.haskell.org/package/nvim-hs). # Contributing diff --git a/executable/Main.hs b/executable/Main.hs deleted file mode 100644 --- a/executable/Main.hs +++ /dev/null @@ -1,16 +0,0 @@ -{- | -Module : Main -Description : Main module for the haskell plugin provider -Copyright : (c) Sebastian Witte -License : Apache-2.0 - -Maintainer : woozletoff@gmail.com -Stability : experimental - --} -module Main where - -import Neovim (neovim, defaultConfig) - -main :: IO () -main = neovim defaultConfig diff --git a/library/Neovim.hs b/library/Neovim.hs --- a/library/Neovim.hs +++ b/library/Neovim.hs @@ -19,17 +19,16 @@ -- $installation -- * Tutorial - -- ** tl;dr - -- $tldrgettingstarted + -- ** Motivation + -- $overview + -- ** Combining existing plugins + -- $existingplugins Neovim, neovim, NeovimConfig(..), defaultConfig, - StartupConfig(..), def, - -- ** Using existing plugins - -- $existingplugins -- ** Creating a plugin -- $creatingplugins @@ -62,19 +61,14 @@ -- $remote wait, wait', - waitErr, - waitErr', err, errOnInvalidResult, NeovimException(..), - -- ** Generated functions for neovim interaction - module Neovim.API.String, -- * 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, - withCustomEnvironment, whenM, unlessM, docToObject, @@ -101,7 +95,6 @@ import Data.MessagePack (Object (..)) import Data.Monoid import Data.Word (Word, Word16, Word32, Word8) -import Neovim.API.String import Neovim.API.TH (autocmd, command, command', function, function') import Neovim.Classes (Dictionary, NvimObject (..), @@ -120,13 +113,10 @@ CommandOption (CmdBang, CmdCount, CmdRange, CmdRegister, CmdSync), RangeSpecification (..), Synchronous (..)) -import qualified Neovim.Plugin.ConfigHelper as ConfigHelper import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..), wrapPlugin) -import Neovim.Plugin.Startup (StartupConfig (..)) -import Neovim.RPC.FunctionCall (wait, wait', waitErr, waitErr') -import Neovim.Util (unlessM, whenM, - withCustomEnvironment) +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 @@ -139,88 +129,73 @@ -- 1}}} -- Tutorial {{{1 --- tl;dr {{{2 -{- $tldrgettingstarted -If you are proficient with Haskell, it may be sufficient to point you at some of the -important data structures and functions. So, I will do it here. If you need more -assistance, please skip to the next section and follow the links for functions or data -types you do not understand how to use. If you think that the documentation is lacking, -please create an issue on github (or even better, a pull request with a fix @;-)@). -The code sections that describe new functionality are followed by the source code -documentation of the used functions (and possibly a few more). +-- Overview {{{2 +{- $overview +An @nvim-hs@ plugin is just a collection of haskell functions that can be +called from neovim. -The config directory location adheres to the -. -Unless you have changed some \$XDG_\* environment variables, the configuration -directory on unixoid systems (e.g. MacOS X, most GNU/Linux distribution, most -BSD distributions) is @\$HOME\/.config\/nvim@. +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 +or . +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. -Create a file called @nvim.hs@ in @\$XDG_CONFIG_HOME\/nvim@ (usually -@~\/.config\/nvim@) with the following content: +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 (@~/.convig/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 with a main file that looks like this: + @ -import Neovim +import TestPlugin.ExamplePlugin (examplePlugin) -main = 'neovim' 'defaultConfig' +main = 'neovim' 'def' + { 'plugins' = [ examplePlugin ] ++ 'plugins' 'defaultConfig' + } @ -Adjust the fields in 'defaultConfig' according to the parameters in 'NeovimConfig'. -Depending on how you define the parameters, you may have to add some language extensions -which GHC should point you to. --} +/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 then look 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 = myPlugins ++ plugins defaultConfig +-- { plugins = plugins defaultConfig ++ myPlugins -- } -- @ -- defaultConfig :: NeovimConfig defaultConfig = Config - { plugins = [ ConfigHelper.plugin ] + { plugins = [] , logOptions = Nothing - , errorMessage = Nothing } -- 2}}} - --- Existing Plugins {{{2 -{- $existingplugins -/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 -configuration would then look like this: - -@ -import TestPlugin.ExamplePlugin (examplePlugin) - -main = 'neovim' 'def' - { 'plugins' = [ examplePlugin ] ++ 'plugins' 'defaultConfig' - } -@ - -That's all you have to do! Multiple plugins are simply imported and put in a -list. - -If the plugin is not packaged, you can also put the source files of the plugin -inside @\$XDG_CONFIG_HOME\/nvim\/lib@ (usually @~\/.config\/nvim\/lib@). -Assuming the same module name and plugin name, you can use the same configuration -file. The source for the plugin must be located at -@\$XDG_CONFIG_HOME\/nvim\/lib\/TestPlugin\/ExamplePlugin.hs@ and all source -files it depends on must follow the same structure. This is the standard way -how Haskell modules are defined in cabal projects. Having all plugins as source -files can increase the compilation times, so plugins should be put in a cabal -project once they are mature enough. This also makes them easy to share! - --} --- 2}}} -- Creating a plugin {{{2 {- $creatingplugins Creating plugins isn't difficult either. You just have to follow and survive the @@ -230,8 +205,11 @@ \#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, we must define +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. @@ -263,7 +241,7 @@ import "Neovim" import Fibonacci.Plugin (fibonacci) -plugin :: 'Neovim' ('StartupConfig' 'NeovimConfig') () 'NeovimPlugin' +plugin :: 'Neovim' () 'NeovimPlugin' plugin = 'wrapPlugin' Plugin { 'environment' = () , 'exports' = [ $('function'' 'fibonacci) 'Sync' ] @@ -296,8 +274,8 @@ 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 environment that 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 +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. @@ -305,7 +283,7 @@ 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 handly any environment. If you want to access the environment, you can call +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. @@ -321,10 +299,7 @@ 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 (which should happen automatically if you have put those -files at the appropriate places), you can restart /nvim-hs/ with the command -@:RestartNvimhs@ which is available as long as you do not remove the default -plugins from you rconfig. Afterwards, you can calculate the 2000th Fibonacci +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: @ @@ -339,6 +314,9 @@ \=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 @@ -378,7 +356,7 @@ tVarWithRandomNumbers <- 'ask' atomically $ do -- pick the head of our list of random numbers - r <- 'head' <$> 'readTVar' tVarWithRandomNumbers + 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 @@ -436,13 +414,11 @@ 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. The only slightly tedious thing was to define the 'statefulExports' -field because it is a list of triples which has a list of exported -functionalities as its third argument. Another noteworthy detail, in case you +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' ('StartupConfig' 'NeovimConfig') () something@. 'liftIO' lifts an +@'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). @@ -475,11 +451,10 @@ isValid <- 'buffer_is_valid' cb when isValid $ do let newName = "magic" - retval <- 'wait'' $ 'buffer_set_name' cb newName - case retval of - Right cbName | cbName == newName -> 'return' () - Right _ -> 'err' $ "Renaming the current buffer failed!" - Left e -> 'err' $ 'show' e + 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 @@ -490,9 +465,7 @@ 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. Since it is not unusual to -not know what to do if the remote function call failed, the functions 'waitErr' -and 'waitErr'' can save you from some typing and deeply nested case expressions. +message to neovim which the user immediately notices. That's pretty much all there is to it. -} diff --git a/library/Neovim/API/ByteString.hs b/library/Neovim/API/ByteString.hs new file mode 100644 --- /dev/null +++ b/library/Neovim/API/ByteString.hs @@ -0,0 +1,23 @@ +{-# 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) + diff --git a/library/Neovim/API/Parser.hs b/library/Neovim/API/Parser.hs --- a/library/Neovim/API/Parser.hs +++ b/library/Neovim/API/Parser.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings #-} {- | Module : Neovim.API.Parser Description : P.Parser for the msgpack output stram API @@ -21,15 +20,15 @@ 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.IO (hClose) -import System.Process +import System.Process.Typed import UnliftIO.Exception (SomeException, - bracket, catch) + catch) import Data.Text.Prettyprint.Doc (Doc, Pretty(..), (<+>)) import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) @@ -98,18 +97,8 @@ \ 'api' in the working directory as a substitute." decodeAPI :: IO (Either String Object) -decodeAPI = bracket queryNeovimAPI clean $ \(out, _) -> - decode <$> B.hGetContents out - - where - queryNeovimAPI = do - (_, Just out, _, ph) <- createProcess $ - (proc "nvim" ["--api-info"]) { std_out = CreatePipe } - return (out, ph) - - clean (out, ph) = do - hClose out - terminateProcess ph +decodeAPI = + decode . LB.toStrict <$> readProcessStdout_ (proc "nvim" ["--api-info"]) oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o diff --git a/library/Neovim/API/String.hs b/library/Neovim/API/String.hs --- a/library/Neovim/API/String.hs +++ b/library/Neovim/API/String.hs @@ -1,7 +1,8 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoOverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} {- | Module : Neovim.API.String Description : String based API @@ -21,5 +22,5 @@ import Neovim.API.TH -$(generateAPI defaultAPITypeToHaskellTypeMap) +$(generateAPI stringListTypeMap) diff --git a/library/Neovim/API/TH.hs b/library/Neovim/API/TH.hs --- a/library/Neovim/API/TH.hs +++ b/library/Neovim/API/TH.hs @@ -1,7 +1,6 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {- | Module : Neovim.API.TH Description : Template Haskell API generation module @@ -19,7 +18,9 @@ , command , command' , autocmd - , defaultAPITypeToHaskellTypeMap + , stringListTypeMap + , textVectorTypeMap + , bytestringVectorTypeMap , module UnliftIO.Exception , module Neovim.Classes @@ -57,6 +58,7 @@ import qualified Data.Set as Set import Data.Text (Text) import Data.Text.Prettyprint.Doc ((<+>), Doc, viaShow, Pretty(..)) +import Data.Vector (Vector) import UnliftIO.Exception import Prelude @@ -79,7 +81,7 @@ -- 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 :: Map String (Q Type) -> Q [Dec] +generateAPI :: TypeMap -> Q [Dec] generateAPI typeMap = do api <- either (fail . show) return =<< runIO parseAPI let exceptionName = mkName "NeovimExceptionGen" @@ -95,27 +97,57 @@ ] --- | Default type mappings for the requested API. -defaultAPITypeToHaskellTypeMap :: Map String (Q Type) -defaultAPITypeToHaskellTypeMap = Map.fromList +-- | 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|]) , ("Float" , [t|Double|]) + , ("String" , [t|String|]) , ("Array" , [t|[Object]|]) - , ("Dictionary", [t|Map Object 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|] -apiTypeToHaskellType :: Map String (Q Type) -> NeovimType -> Q Type -apiTypeToHaskellType typeMap at = case at of +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 listT $ apiTypeToHaskellType typeMap t + 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 typeMap + fromMaybe ((conT . mkName) t) $ Map.lookup t typesOfAPI -- | This function will create a wrapper function with neovim's function name @@ -143,30 +175,23 @@ -- ] -- @ -- -createFunction :: Map String (Q Type) -> NeovimFunction -> Q [Dec] +createFunction :: TypeMap -> NeovimFunction -> Q [Dec] createFunction typeMap nf = do let withDeferred | async nf = appT [t|STM|] | otherwise = id - withException' | canFail nf = appT [t|Either NeovimException|] - | otherwise = id - - callFns | async nf && canFail nf = [ [|acall|] ] - | async nf = [ [|acall'|] ] - | canFail nf = [ [|scall|], [|scallThrow|] ] - | otherwise = [ [|scall'|] ] + callFn | async nf = [|acall'|] + | otherwise = [|scall'|] - functionNames = map mkName [ name nf, name nf ++ "'" ] + functionName = mkName $ name nf toObjVar v = [|toObject $(varE v)|] - retTypes <- let env = (mkName "env") - createSig retTypeFun = - forallT [PlainTV env] (return []) - . appT ([t|Neovim $(varT env) |]) - . withDeferred . retTypeFun - . apiTypeToHaskellType typeMap $ returnType nf - in mapM createSig [ withException', id ] + retType <- let env = (mkName "env") + in forallT [PlainTV 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. @@ -178,7 +203,7 @@ <*> newName n) $ applyPrefixWithNumber nf - let impl functionName callFn retType = + sequence [ sigD functionName . return . foldr (AppT . AppT ArrowT) retType $ map fst vars , funD functionName @@ -190,8 +215,6 @@ [] ] ] - - sequence . concat $ zipWith3 impl functionNames callFns retTypes -- | @ createDataTypeWithObjectComponent SomeName [Foo,Bar]@ diff --git a/library/Neovim/API/Text.hs b/library/Neovim/API/Text.hs new file mode 100644 --- /dev/null +++ b/library/Neovim/API/Text.hs @@ -0,0 +1,23 @@ +{-# 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) + diff --git a/library/Neovim/Classes.hs b/library/Neovim/Classes.hs --- a/library/Neovim/Classes.hs +++ b/library/Neovim/Classes.hs @@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} #if __GLASGOW_HASKELL__ < 710 {-# LANGUAGE OverlappingInstances #-} @@ -36,39 +34,53 @@ , module Control.DeepSeq ) where -import Neovim.Exceptions (NeovimException (..)) +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 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 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.Text.Prettyprint.Doc.Render.Terminal + ( AnsiStyle + , renderStrict + ) import Data.Traversable hiding (forM, mapM) -import Data.Word (Word, Word16, - Word32, Word64, - Word8) +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 qualified Data.ByteString.UTF8 as UTF8 (fromString, toString) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import UnliftIO.Exception (throwIO) -import Prelude +import Prelude infixr 5 +: @@ -125,7 +137,9 @@ 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 @@ -292,6 +306,12 @@ 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. diff --git a/library/Neovim/Compat/Megaparsec.hs b/library/Neovim/Compat/Megaparsec.hs --- a/library/Neovim/Compat/Megaparsec.hs +++ b/library/Neovim/Compat/Megaparsec.hs @@ -2,7 +2,9 @@ module Neovim.Compat.Megaparsec ( Parser , module X +#if MIN_VERSION_megaparsec(7,0,0) , anyChar +#endif ) where diff --git a/library/Neovim/Config.hs b/library/Neovim/Config.hs --- a/library/Neovim/Config.hs +++ b/library/Neovim/Config.hs @@ -15,7 +15,6 @@ import Neovim.Context (Neovim) import Neovim.Plugin.Internal (NeovimPlugin) -import Neovim.Plugin.Startup (StartupConfig) import System.Log (Priority (..)) @@ -23,18 +22,12 @@ -- 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 (StartupConfig NeovimConfig) NeovimPlugin] + { 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. - - , errorMessage :: Maybe String - -- ^ Internally used field. Changing this has no effect. - -- - -- Used by 'Dyre' for storing compilation errors. - } diff --git a/library/Neovim/Context.hs b/library/Neovim/Context.hs --- a/library/Neovim/Context.hs +++ b/library/Neovim/Context.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE LambdaCase #-} {- | Module : Neovim.Context Description : The Neovim context diff --git a/library/Neovim/Context/Internal.hs b/library/Neovim/Context/Internal.hs --- a/library/Neovim/Context/Internal.hs +++ b/library/Neovim/Context/Internal.hs @@ -2,10 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Neovim.Context.Internal Description : Abstract description of the plugin provider's internal context diff --git a/library/Neovim/Debug.hs b/library/Neovim/Debug.hs --- a/library/Neovim/Debug.hs +++ b/library/Neovim/Debug.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} {- | Module : Neovim.Debug Description : Utilities to debug Neovim and nvim-hs functionality @@ -14,6 +13,8 @@ module Neovim.Debug ( debug, debug', + + NvimHSDebugInstance(..), develMain, quitDevelMain, restartDevelMain, @@ -61,7 +62,7 @@ -- automatically set. debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a) debug env a = disableLogger $ do - runPluginProvider def { envVar = True } Nothing transitionHandler Nothing + runPluginProvider def { envVar = True } Nothing transitionHandler where transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case Internal.Failure e -> @@ -83,13 +84,21 @@ -- | Run a 'Neovim'' function. -- -- @ --- debug' a = fmap fst <$> debug () () a +-- debug' = debug () -- @ -- -- See documentation for 'debug'. debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a) -debug' a = debug () 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. @@ -103,23 +112,30 @@ -- Example: -- -- @ --- λ 'Right' (tids, cfg) <- 'develMain' 'Nothing' +-- λ di <- 'develMain' 'Nothing' -- --- λ 'runNeovim'' cfg \$ vim_call_function \"getqflist\" [] +-- λ 'runNeovim'' di \$ vim_call_function \"getqflist\" [] -- 'Right' ('Right' ('ObjectArray' [])) -- -- λ :r -- --- λ 'Right' (tids, cfg) <- 'develMain' 'Nothing' +-- λ 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 - :: Maybe NeovimConfig - -> IO (Either (Doc AnsiStyle) [Async ()]) -develMain mcfg = lookupStore 0 >>= \case + :: NeovimConfig + -> IO (Maybe NvimHSDebugInstance) +develMain neovimConfig = lookupStore 0 >>= \case Nothing -> do - x <- disableLogger $ - runPluginProvider def { envVar = True } mcfg transitionHandler Nothing + x <- disableLogger $ runPluginProvider + def{ envVar = True } + (Just neovimConfig) + transitionHandler void $ newStore x return x @@ -127,13 +143,18 @@ readStore x where transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case - Internal.Failure e -> - return $ Left e + Internal.Failure e -> do + putDoc e + return Nothing Internal.InitSuccess -> do transitionHandlerThread <- async $ do void $ transitionHandler (tids) cfg - return $ Right (transitionHandlerThread:tids) + return . Just $ NvimHSDebugInstance + { threads = (transitionHandlerThread:tids) + , neovimConfig = neovimConfig + , internalConfig = cfg + } Internal.Quit -> do lookupStore 0 >>= \case @@ -144,38 +165,41 @@ deleteStore x mapM_ cancel tids - return . Left $ "Quit develMain" + putStrLn "Quit develMain" + return Nothing - _ -> - return . Left $ "Unexpected transition state for develMain." + _ -> do + putStrLn $ "Unexpected transition state for develMain." + return Nothing -- | Quit a previously started plugin provider. -quitDevelMain :: Internal.Config env -> IO () -quitDevelMain cfg = putMVar (Internal.transitionTo cfg) Internal.Quit +quitDevelMain :: NvimHSDebugInstance -> IO () +quitDevelMain NvimHSDebugInstance{internalConfig} = + putMVar (Internal.transitionTo internalConfig) Internal.Quit -- | Restart the development plugin provider. restartDevelMain - :: Internal.Config RPCConfig - -> Maybe NeovimConfig - -> IO (Either (Doc AnsiStyle) [Async ()]) -restartDevelMain cfg mcfg = do - quitDevelMain cfg - develMain mcfg + :: NvimHSDebugInstance + -> IO (Maybe NvimHSDebugInstance) +restartDevelMain di = do + quitDevelMain di + develMain (neovimConfig di) -- | Convenience function to run a stateless 'Neovim' function. runNeovim' :: NFData a - => Internal.Config env -> Neovim () a -> IO (Either (Doc AnsiStyle) a) -runNeovim' cfg = - runNeovim (Internal.retypeConfig () cfg) + => NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a) +runNeovim' NvimHSDebugInstance{internalConfig} = + runNeovim (Internal.retypeConfig () (internalConfig)) -- | Print the global function map to the console. -printGlobalFunctionMap :: Internal.Config env -> IO () -printGlobalFunctionMap cfg = do - es <- fmap Map.toList . atomically $ readTMVar (Internal.globalFunctionMap cfg) +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 diff --git a/library/Neovim/Exceptions.hs b/library/Neovim/Exceptions.hs --- a/library/Neovim/Exceptions.hs +++ b/library/Neovim/Exceptions.hs @@ -1,6 +1,4 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {- | Module : Neovim.Exceptions Description : General Exceptions diff --git a/library/Neovim/Main.hs b/library/Neovim/Main.hs --- a/library/Neovim/Main.hs +++ b/library/Neovim/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {- | Module : Neovim.Main Description : Wrapper for the actual main function @@ -15,28 +14,23 @@ import Neovim.Config import qualified Neovim.Context.Internal as Internal import Neovim.Log -import Neovim.Plugin as P -import Neovim.Plugin.Startup (StartupConfig (..)) +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 qualified Config.Dyre as Dyre -import qualified Config.Dyre.Relaunch as Dyre import Control.Concurrent -import Control.Concurrent.STM (atomically, putTMVar) +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 System.SetEnv -import UnliftIO.Async (Async, async, cancel) +import System.IO (stdin, stdout) +import UnliftIO.Async (Async, async) -import Prelude -import System.Environment +import Prelude logger :: String @@ -118,15 +112,7 @@ -- | 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 = - let params = Dyre.defaultParams - { Dyre.showError = \cfg errM -> cfg { errorMessage = Just errM } - , Dyre.projectName = "nvim" - , Dyre.realMain = realMain finishDyre (Just params) - , Dyre.statusOut = debugM "Dyre" - , Dyre.ghcOpts = ["-threaded", "-rtsopts", "-with-rtsopts=-N"] - } - in Dyre.wrapMain params +neovim = realMain standalone -- | A 'TransitionHandler' function receives the 'ThreadId's of all running @@ -141,14 +127,13 @@ -- using the "Config.Dyre" library while still using the /nvim-hs/ specific -- configuration facilities. realMain :: TransitionHandler a - -> Maybe (Dyre.Params NeovimConfig) -> NeovimConfig -> IO () -realMain transitionHandler mParams cfg = do +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 mParams + void $ runPluginProvider os (Just cfg) transitionHandler -- | Generic main function. Most arguments are optional or have sane defaults. @@ -156,9 +141,8 @@ :: CommandLineOptions -- ^ See /nvim-hs/ executables --help function or 'optParser' -> Maybe NeovimConfig -> TransitionHandler a - -> Maybe (Dyre.Params NeovimConfig) -> IO a -runPluginProvider os mcfg transitionHandler mDyreParams = case (hostPort os, unix os) of +runPluginProvider os mcfg transitionHandler = case (hostPort os, unix os) of (Just (h,p), _) -> createHandle (TCP p h) >>= \s -> run s s @@ -186,14 +170,8 @@ srTid <- async $ runSocketReader sockreaderHandle conf - ghcEnv <- forM ["GHC_PACKAGE_PATH","CABAL_SANDBOX_CONFIG"] $ \var -> do - val <- lookupEnv var - unsetEnv var - return (var, val) - let startupConf = Internal.retypeConfig - (StartupConfig mDyreParams ghcEnv) - conf - startPluginThreads startupConf allPlugins >>= \case + 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 @@ -207,18 +185,15 @@ transitionHandler (srTid:ehTid:pluginTids) conf --- | If the plugin provider is started with dyre, this handler is used to --- handle a restart. -finishDyre :: TransitionHandler () -finishDyre threads cfg = takeMVar (Internal.transitionTo cfg) >>= \case +standalone :: TransitionHandler () +standalone threads cfg = takeMVar (Internal.transitionTo cfg) >>= \case Internal.InitSuccess -> do - debugM logger "Waiting for threads to finish." - finishDyre threads cfg + debugM logger "Initialization Successful" + standalone threads cfg Internal.Restart -> do - debugM logger "Trying to restart nvim-hs" - mapM_ cancel threads - Dyre.relaunchMaster Nothing + errorM logger "Cannot restart" + standalone threads cfg Internal.Failure e -> errorM logger . show $ oneLineErrorMessage e diff --git a/library/Neovim/Plugin.hs b/library/Neovim/Plugin.hs --- a/library/Neovim/Plugin.hs +++ b/library/Neovim/Plugin.hs @@ -1,8 +1,5 @@ {-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Neovim.Plugin Description : Plugin and functionality registration code @@ -17,7 +14,6 @@ module Neovim.Plugin ( startPluginThreads, - StartupConfig, wrapPlugin, NeovimPlugin, Plugin(..), @@ -31,7 +27,6 @@ import Neovim.API.String import Neovim.Classes -import Neovim.Config import Neovim.Context import Neovim.Context.Internal (FunctionType (..), runNeovimInternal) @@ -39,7 +34,6 @@ import Neovim.Plugin.Classes hiding (register) import Neovim.Plugin.Internal import Neovim.Plugin.IPC.Classes -import qualified Neovim.Plugin.Startup as Plugin import Neovim.RPC.FunctionCall import Control.Applicative @@ -56,7 +50,7 @@ import System.Log.Logger import UnliftIO.Async (Async, async, race) import UnliftIO.Concurrent (threadDelay) -import UnliftIO.Exception (SomeException, try) +import UnliftIO.Exception (SomeException, try, catch) import UnliftIO.STM import Prelude @@ -66,17 +60,14 @@ logger = "Neovim.Plugin" -type StartupConfig = Plugin.StartupConfig NeovimConfig - - -startPluginThreads :: Internal.Config StartupConfig - -> [Neovim StartupConfig NeovimPlugin] +startPluginThreads :: Internal.Config () + -> [Neovim () NeovimPlugin] -> IO (Either (Doc AnsiStyle) ([FunctionMapEntry],[Async ()])) startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], []) where go :: ([FunctionMapEntry], [Async ()]) - -> Neovim StartupConfig NeovimPlugin - -> Neovim StartupConfig ([FunctionMapEntry], [Async ()]) + -> Neovim () NeovimPlugin + -> Neovim () ([FunctionMapEntry], [Async ()]) go (es, tids) iop = do NeovimPlugin p <- iop (es', tid) <- registerStatefulFunctionality p @@ -96,19 +87,20 @@ (\n -> ("remote#define#FunctionOnHost", toObject n)) (\c -> ("remote#define#FunctionOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction $ - host +: functionName +: s +: functionName +: (Map.empty :: Dictionary) +: [] - - case ret of - Left e -> do + reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register function: " ++ show functionName ++ show e return False - Right _ -> do + logSuccess = do liftIO . debugM logger $ "Registered function: " ++ show functionName return True + flip catch reportError $ do + void $ vim_call_function defineFunction $ + host +: functionName +: s +: functionName +: (Map.empty :: Dictionary) +: [] + logSuccess + Command (F functionName) copts -> do let sync = case getCommandOptions copts of -- This works because CommandOptions are sorted and CmdSync is @@ -121,18 +113,18 @@ (\n -> ("remote#define#CommandOnHost", toObject n)) (\c -> ("remote#define#CommandOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction $ - host +: functionName +: sync +: functionName +: copts +: [] - - case ret of - Left e -> do + reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register command: " ++ show functionName ++ show e return False - Right _ -> do + logSuccess = do liftIO . debugM logger $ "Registered command: " ++ show functionName return True + flip catch reportError $ do + void $ vim_call_function defineFunction $ + host +: functionName +: sync +: functionName +: copts +: [] + logSuccess Autocmd acmdType (F functionName) opts -> do pName <- getProviderName @@ -140,17 +132,18 @@ (\n -> ("remote#define#AutocmdOnHost", toObject n)) (\c -> ("remote#define#AutocmdOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction $ - host +: functionName +: Async +: acmdType +: opts +: [] - case ret of - Left e -> do + reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register autocmd: " ++ show functionName ++ show e return False - Right _ -> do + logSuccess = do liftIO . debugM logger $ "Registered autocmd: " ++ show functionName return True + flip catch reportError $ do + void $ vim_call_function defineFunction $ + host +: functionName +: Async +: acmdType +: opts +: [] + logSuccess -- | Return or retrive the provider name that the current instance is associated @@ -165,7 +158,8 @@ Nothing -> do api <- nvim_get_api_info case api of - Right (i:_) -> do + [] -> 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" @@ -174,10 +168,7 @@ liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId return . Right $ fromIntegral channelId - _ -> - err "Could not determine provider name." - registerFunctionality :: FunctionalityDescription -> ([Object] -> Neovim env Object) -> Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)) @@ -316,7 +307,7 @@ -> TVar (Map FunctionName ([Object] -> Neovim env Object)) -> Neovim env () listeningThread q route = do - msg <- liftIO . atomically $ readTQueue q + msg <- readSomeMessage q forM_ (fromMessage msg) $ \req@Request{..} -> do route' <- liftIO $ readTVarIO route @@ -334,7 +325,7 @@ (executeFunction f notArgs) case result of Left message -> - nvim_err_writeln' message + nvim_err_writeln message Right _ -> return () diff --git a/library/Neovim/Plugin/Classes.hs b/library/Neovim/Plugin/Classes.hs --- a/library/Neovim/Plugin/Classes.hs +++ b/library/Neovim/Plugin/Classes.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveGeneric #-} {- | @@ -310,6 +308,9 @@ 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 diff --git a/library/Neovim/Plugin/ConfigHelper.hs b/library/Neovim/Plugin/ConfigHelper.hs deleted file mode 100644 --- a/library/Neovim/Plugin/ConfigHelper.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} -{- | -Module : Neovim.Plugin.ConfigHelper -Description : Helper plugin to ease recompiling the nvim-hs config -Copyright : (c) Sebastian Witte -License : Apache-2.0 - -Maintainer : woozletoff@gmail.com -Stability : experimental -Portability : GHC - --} -module Neovim.Plugin.ConfigHelper - where - -import Neovim.API.TH -import Neovim.Config -import Neovim.Context -import Neovim.Plugin.Classes -import Neovim.Plugin.ConfigHelper.Internal -import Neovim.Plugin.Internal -import Neovim.Plugin.Startup - -import Config.Dyre.Paths (getPaths) -import Data.Default -import UnliftIO.STM - - -plugin :: Neovim (StartupConfig NeovimConfig) NeovimPlugin -plugin = asks dyreParams >>= \case - Nothing -> - wrapPlugin Plugin { environment = (), exports = [] } - - Just params -> do - ghcEnv <- asks ghcEnvironmentVariables - (_, _, cfgFile, _, libsDir) <- liftIO $ getPaths params - emptyQuickfixList <- newTVarIO [] - wrapPlugin Plugin - { environment = ConfigHelperEnv params ghcEnv emptyQuickfixList - , exports = - [ $(function' 'pingNvimhs) Sync - , $(autocmd 'recompileNvimhs) "BufWritePost" def - { acmdPattern = cfgFile - } - , $(autocmd 'recompileNvimhs) "BufWritePost" def - { acmdPattern = libsDir++"/*" - } - , $(command' 'restartNvimhs) [CmdSync Async, CmdBang, CmdRegister] - ] - } diff --git a/library/Neovim/Plugin/ConfigHelper/Internal.hs b/library/Neovim/Plugin/ConfigHelper/Internal.hs deleted file mode 100644 --- a/library/Neovim/Plugin/ConfigHelper/Internal.hs +++ /dev/null @@ -1,153 +0,0 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RecordWildCards #-} -{- | -Module : Neovim.Plugin.ConfigHelper.Internal -Description : Internals for a config helper plugin that helps recompiling nvim-hs -Copyright : (c) Sebastian Witte -License : Apache-2.0 - -Maintainer : woozletoff@gmail.com -Stability : experimental -Portability : GHC - --} -module Neovim.Plugin.ConfigHelper.Internal - where - -import Neovim.API.String (vim_command) -import Neovim.Config -import Neovim.Context -import Neovim.Plugin.Classes -import Neovim.Quickfix -import Neovim.Util (withCustomEnvironment) - -import Neovim.Compat.Megaparsec as P hiding (count) - -import Config.Dyre (Params) -import Config.Dyre.Compile -import Config.Dyre.Paths (getPaths) -import Control.Applicative hiding ((<|>)) -import Control.Monad (void, forM_) -import Data.Char -import System.SetEnv -import System.Directory (removeDirectoryRecursive) -import UnliftIO.STM - -import Prelude - - --- | Simple function that will return @"Pong"@ if the plugin provider is --- running. -pingNvimhs :: Neovim env String -pingNvimhs = return "Pong" - -data ConfigHelperEnv = ConfigHelperEnv - { dyreParameters :: Params NeovimConfig - , environmentVariables :: [(String, Maybe String)] - , quickfixList :: TVar [QuickfixListItem String] - } - --- | Recompile the plugin provider and put comile errors in the quickfix list. -recompileNvimhs :: Neovim ConfigHelperEnv () -recompileNvimhs = ask >>= \ConfigHelperEnv{..} -> - withCustomEnvironment environmentVariables $ do - mErrString <- liftIO $ do - customCompile dyreParameters - getErrorString dyreParameters - let qs = maybe [] parseQuickfixItems mErrString - atomically $ modifyTVar' quickfixList (const qs) - setqflist qs Replace - void $ vim_command "cwindow" - - --- | Note that restarting the plugin provider implies compilation because Dyre --- does this automatically. However, if the recompilation fails, the previously --- compiled binary is executed. This essentially means that restarting may take --- more time then you might expect. --- --- If you provide a bang to the command, the cache directory of /nvim-hs/ is --- forcibly removed. -restartNvimhs :: CommandArguments - -> Neovim ConfigHelperEnv () -restartNvimhs CommandArguments{..} = do - case bang of - Just True -> do - (_,_,_, cacheDir,_) <- liftIO . getPaths =<< asks dyreParameters - liftIO $ removeDirectoryRecursive cacheDir - - _ -> - return () - - recompileNvimhs - - envVars <- asks environmentVariables - forM_ envVars $ \(var, val) -> liftIO $ maybe (unsetEnv var) (setEnv var) val - restart - --- Parsing {{{1 --- See the tests in @test-suite\/Neovim\/Plugin\/ConfigHelperSpec.hs@ on how the --- error messages look like. -parseQuickfixItems :: String -> [QuickfixListItem String] -parseQuickfixItems s = - case parse (P.many pQuickfixListItem) "Quickfix parser" s of - Right qs -> qs - Left _ -> [] - - -pQuickfixListItem :: P.Parser (QuickfixListItem String) -pQuickfixListItem = do - _ <- P.many blankLine - (f,l,c) <- pLocation - - void $ P.many tabOrSpace - e <- pSeverity - desc <- try pShortDesrciption <|> pLongDescription - return $ (quickfixListItem (Right f) (Left l)) - { col = VisualColumn c - , text = desc - , errorType = e - } - -pSeverity :: P.Parser QuickfixErrorType -pSeverity = do - try (string "Warning:" *> return Warning) - <|> try (string "error:" *> return Error) - <|> return Error - -pShortDesrciption :: P.Parser String -pShortDesrciption = (:) - <$> (notFollowedBy blankLine *> anyChar) - <*> anyChar `manyTill` (void (P.some blankLine) <|> eof) - - -pLongDescription :: P.Parser String -pLongDescription = anyChar `manyTill` (blank <|> eof) - where - blank = try (try newline *> try blankLine) - - -tabOrSpace :: P.Parser Char -tabOrSpace = satisfy $ \c -> c == ' ' || c == '\t' - - -blankLine :: P.Parser () -blankLine = void . try $ P.many tabOrSpace >> newline - - --- | Skip anything until the next location information appears. --- --- The result will be a triple of filename, line number and column - --- | Try to parse location information. --- --- @\/some\/path\/to\/a\/file.hs:42:88:@ -pLocation :: P.Parser (String, Int, Int) -pLocation = (,,) - <$> P.some (noneOf ":\n\t\r") <* char ':' - <*> pInt <* char ':' - <*> pInt <* char ':' <* P.many tabOrSpace - - -pInt :: P.Parser Int -pInt = read <$> P.some (satisfy isDigit) --- 1}}} diff --git a/library/Neovim/Plugin/IPC/Classes.hs b/library/Neovim/Plugin/IPC/Classes.hs --- a/library/Neovim/Plugin/IPC/Classes.hs +++ b/library/Neovim/Plugin/IPC/Classes.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.Plugin.IPC.Classes @@ -20,6 +19,8 @@ FunctionCall(..), Request(..), Notification(..), + writeMessage, + readSomeMessage, UTCTime, getCurrentTime, @@ -30,13 +31,14 @@ 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 (Pretty (..), nest, hardline, (<+>), (<>), viaShow) import Prelude @@ -55,19 +57,28 @@ -- 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 Typeable message => Message message where +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) + deriving (Typeable, Generic) +instance NFData FunctionCall where + rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` () instance Message FunctionCall diff --git a/library/Neovim/Plugin/Startup.hs b/library/Neovim/Plugin/Startup.hs deleted file mode 100644 --- a/library/Neovim/Plugin/Startup.hs +++ /dev/null @@ -1,36 +0,0 @@ -{- | -Module : Neovim.Plugin.Startup -Description : Startup utilities for plugins -Copyright : (c) Sebastian Witte -License : Apache-2.0 - -Maintainer : woozletoff@gmail.com -Stability : experimental -Portability : GHC - -This plugin only exists due to cyclic dependencies. --} -module Neovim.Plugin.Startup - where - -import qualified Config.Dyre as Dyre - --- | This data type contains internal fields of /nvim-hs/ that may --- be useful for plugin authors. It is available via 'ask' inside --- the plugin startup code. -data StartupConfig cfg = StartupConfig - { dyreParams :: Maybe (Dyre.Params cfg) - -- ^ The configuration options for "Config.Dyre". This is always set if - -- /nvim-hs/ has been started via "Config.Dyre". Be sure to set up the - -- 'ghcEnvironmentVariables' correctly if you issue a recompilation via - -- the "Config.Dyre" API. - - , ghcEnvironmentVariables :: [(String, Maybe String)] - -- ^ The GHC environment variables with which /nvim-hs/ has been started. - -- This are mainly of significance if you want to use the same environment - -- for compilation or a REPL that /nvim-hs/ runs on. - -- - -- These variables have to be used if you want to invoke functionality of - -- "Config.Dyre" targeting /nvim-hs/. - } - diff --git a/library/Neovim/Quickfix.hs b/library/Neovim/Quickfix.hs --- a/library/Neovim/Quickfix.hs +++ b/library/Neovim/Quickfix.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveGeneric #-} {- | diff --git a/library/Neovim/RPC/Classes.hs b/library/Neovim/RPC/Classes.hs --- a/library/Neovim/RPC/Classes.hs +++ b/library/Neovim/RPC/Classes.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.Classes diff --git a/library/Neovim/RPC/Common.hs b/library/Neovim/RPC/Common.hs --- a/library/Neovim/RPC/Common.hs +++ b/library/Neovim/RPC/Common.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {- | Module : Neovim.RPC.Common diff --git a/library/Neovim/RPC/EventHandler.hs b/library/Neovim/RPC/EventHandler.hs --- a/library/Neovim/RPC/EventHandler.hs +++ b/library/Neovim/RPC/EventHandler.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {- | Module : Neovim.RPC.EventHandler Description : Event handling loop @@ -64,7 +63,7 @@ eventHandlerSource :: ConduitT () SomeMessage EventHandler () eventHandlerSource = asks Internal.eventQueue >>= \q -> - forever $ yield =<< atomically' (readTQueue q) + forever $ yield =<< readSomeMessage q eventHandler :: ConduitM SomeMessage EncodedResponse EventHandler () diff --git a/library/Neovim/RPC/FunctionCall.hs b/library/Neovim/RPC/FunctionCall.hs --- a/library/Neovim/RPC/FunctionCall.hs +++ b/library/Neovim/RPC/FunctionCall.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.FunctionCall @@ -19,8 +18,6 @@ atomically', wait, wait', - waitErr, - waitErr', respond, ) where @@ -30,7 +27,6 @@ import Neovim.Plugin.Classes (FunctionName) import Neovim.Plugin.IPC.Classes import qualified Neovim.RPC.Classes as MsgpackRPC -import Neovim.Exceptions (NeovimException(..), exceptionToDoc) import Control.Applicative import Control.Concurrent.STM @@ -69,7 +65,7 @@ q <- Internal.asks' Internal.eventQueue mv <- liftIO newEmptyTMVarIO timestamp <- liftIO getCurrentTime - atomically' . writeTQueue q . SomeMessage $ FunctionCall fn parameters mv timestamp + writeMessage q $ FunctionCall fn parameters mv timestamp return $ convertObject <$> readTMVar mv where convertObject :: (NvimObject result) @@ -130,29 +126,10 @@ wait' = void . wait --- | Wait for the result of the 'STM' action and call @'err' . (loc++) . show@ --- if the action returned an error. -waitErr :: String -- ^ Prefix error message with this. - -> Neovim env (STM (Either NeovimException result)) -- ^ Function call to neovim - -> Neovim env result -waitErr loc act = wait act >>= \case - Left e -> - err $ pretty loc <+> exceptionToDoc e - Right result -> - return result - - --- | 'waitErr' that discards the result. -waitErr' :: String - -> Neovim env (STM (Either NeovimException result)) - -> Neovim env () -waitErr' loc = void . waitErr loc - - -- | 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 - atomically' . writeTQueue q . SomeMessage . MsgpackRPC.Response reqId $ + writeMessage q . MsgpackRPC.Response reqId $ either (Left . toObject) (Right . toObject) result diff --git a/library/Neovim/RPC/SocketReader.hs b/library/Neovim/RPC/SocketReader.hs --- a/library/Neovim/RPC/SocketReader.hs +++ b/library/Neovim/RPC/SocketReader.hs @@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.SocketReader @@ -129,8 +128,8 @@ Nothing -> do let errM = "No provider for: " <> show functionToCall debugM logger errM - forM_ requestId $ \i -> atomically' . writeTQueue (Internal.eventQueue rpc) - . SomeMessage $ MsgpackRPC.Response i (Left (toObject errM)) + forM_ requestId $ \i -> writeMessage (Internal.eventQueue rpc) $ + MsgpackRPC.Response i (Left (toObject errM)) Just (copts, Internal.Stateful c) -> do now <- liftIO getCurrentTime @@ -140,12 +139,10 @@ case requestId of Just i -> do atomically' . modifyTVar q $ Map.insert i (now, reply) - atomically' . writeTQueue c . SomeMessage $ - Request functionToCall i (parseParams copts params) + writeMessage c $ Request functionToCall i (parseParams copts params) Nothing -> - atomically' . writeTQueue c . SomeMessage $ - Notification functionToCall (parseParams copts params) + writeMessage c $ Notification functionToCall (parseParams copts params) parseParams :: FunctionalityDescription -> [Object] -> [Object] diff --git a/library/Neovim/Test.hs b/library/Neovim/Test.hs --- a/library/Neovim/Test.hs +++ b/library/Neovim/Test.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} {- | Module : Neovim.Test Description : Testing functions @@ -17,28 +15,26 @@ ) where import Neovim -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, - putDoc) -import GHC.IO.Exception (ioe_filename) -import System.Directory -import System.Exit (ExitCode (..)) -import System.IO (Handle) -import System.Process -import UnliftIO.Async (async, cancel) -import UnliftIO.Concurrent (threadDelay) -import UnliftIO.Exception -import UnliftIO.STM (atomically, - putTMVar) +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, putDoc) +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 @@ -52,16 +48,16 @@ -- the desired state of neovim with the help of the functions in -- "Neovim.API.String". testWithEmbeddedNeovim - :: Maybe FilePath -- ^ 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 + :: 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 - (_, _, ph, cfg, cleanUp) <- startEmbeddedNvim file timeout + (nvimProcess, cfg, cleanUp) <- startEmbeddedNvim file timeout let testCfg = Internal.retypeConfig r cfg @@ -73,7 +69,7 @@ let Internal.Neovim q = vim_command "qa!" testRunner <- async . void $ runReaderT (runResourceT q) testCfg - waitForProcess ph >>= \case + waitExitCode nvimProcess >>= \case ExitFailure i -> fail $ "Neovim returned with an exit status of: " ++ show i @@ -95,34 +91,32 @@ throwIO e startEmbeddedNvim - :: Maybe FilePath + :: Maybe (Path b File) -> Seconds - -> IO (Handle, Handle, ProcessHandle, Internal.Config RPCConfig, IO ()) + -> 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. In case - -- it doesn't, please file a bug report! - unlessM (doesFileExist f) . fail $ "File not found: " ++ f - return [f] + -- 'fail' should work with most testing frameworks + unlessM (doesFileExist f) . fail $ "File not found: " ++ show f + return [toFilePath f] - (Just hin, Just hout, _, ph) <- - createProcess (proc "nvim" (["-n","-u","NONE","--embed"] ++ args)) - { std_in = CreatePipe - , std_out = CreatePipe - } + nvimProcess <- startProcess + $ setStdin createPipe + $ setStdout createPipe + $ proc "nvim" (["-n","-u","NONE","--embed"] ++ args) cfg <- Internal.newConfig (pure Nothing) newRPCConfig socketReader <- async . void $ runSocketReader - hout + (getStdout nvimProcess) (cfg { Internal.pluginSettings = Nothing }) eventHandler <- async . void $ runEventHandler - hin + (getStdin nvimProcess) (cfg { Internal.pluginSettings = Nothing }) atomically $ putTMVar @@ -131,9 +125,9 @@ timeoutAsync <- async . void $ do threadDelay $ (fromIntegral timeout) * 1000 * 1000 - getProcessExitCode ph >>= maybe (terminateProcess ph) (\_ -> return ()) + getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> return ()) let cleanUp = mapM_ cancel [socketReader, eventHandler, timeoutAsync] - return (hin, hout, ph, cfg, cleanUp) + return (nvimProcess, cfg, cleanUp) diff --git a/library/Neovim/Util.hs b/library/Neovim/Util.hs --- a/library/Neovim/Util.hs +++ b/library/Neovim/Util.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE LambdaCase #-} {- | Module : Neovim.Util Description : Utility functions @@ -11,41 +10,14 @@ -} module Neovim.Util ( - withCustomEnvironment, whenM, unlessM, oneLineErrorMessage, ) where -import Control.Monad (forM, forM_, when, unless) +import Control.Monad (when, unless) import Neovim.Context -import System.SetEnv -import System.Environment import qualified Data.Text as T -import UnliftIO (MonadUnliftIO) -import UnliftIO.Exception (bracket) - - --- | Execute the given action with a changed set of environment variables and --- restore the original state of the environment afterwards. -withCustomEnvironment - :: (Traversable t, MonadUnliftIO m) - => t (String, Maybe String) - -> m c - -> m c -withCustomEnvironment modifiedEnvironment action = - bracket saveAndSet unset (const action) - - where - saveAndSet = do - preservedValues <- forM modifiedEnvironment $ \(var, val) -> liftIO $ do - old <- lookupEnv var - maybe (unsetEnv var) (setEnv var) val - return (var, old) - return preservedValues - - unset preservedValues = forM_ preservedValues $ \(var, val) -> liftIO $ - maybe (unsetEnv var) (setEnv var) val -- | 'when' with a monadic predicate. diff --git a/nvim-hs.cabal b/nvim-hs.cabal --- a/nvim-hs.cabal +++ b/nvim-hs.cabal @@ -1,5 +1,5 @@ name: nvim-hs -version: 1.0.0.3 +version: 2.0.0.0 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write @@ -29,14 +29,8 @@ copyright: Copyright 2017-2018 Sebastian Witte category: Editor build-type: Simple -cabal-version: >=1.18 +cabal-version: 1.18 extra-source-files: nvim-hs-devel.sh - , test-files/compile-error-for-quickfix-test1 - , test-files/compile-error-for-quickfix-test2 - , test-files/compile-error-for-quickfix-test3 - , test-files/compile-error-for-quickfix-test4 - , test-files/compile-error-for-quickfix-test5 - , test-files/compile-error-for-quickfix-test6 , test-files/hello , apiblobs/0.1.7.msgpack , apiblobs/0.2.0.msgpack @@ -51,17 +45,9 @@ type: git location: https://github.com/neovimhaskell/nvim-hs -executable nvim-hs - main-is: Main.hs - hs-source-dirs: executable - default-language: Haskell2010 - build-depends: base >=4.9 && <5, nvim-hs, data-default - ghc-options: -threaded -rtsopts -with-rtsopts=-N - library exposed-modules: Neovim , Neovim.Quickfix - , Neovim.Plugin.ConfigHelper , Neovim.Debug , Neovim.Test -- Note that every module below this is considered internal and if you have to @@ -70,6 +56,8 @@ -- the Neovim module. Since we are still in a prototyping stage, every user of -- this library should have the freedom to do what she wants. , Neovim.API.String + , Neovim.API.Text + , Neovim.API.ByteString , Neovim.Classes , Neovim.Compat.Megaparsec , Neovim.Config @@ -88,12 +76,30 @@ , Neovim.RPC.EventHandler , Neovim.RPC.FunctionCall , Neovim.RPC.SocketReader - , Neovim.Plugin.Startup , Neovim.Util - , Neovim.Plugin.ConfigHelper.Internal , Neovim.API.Parser , Neovim.API.TH - other-extensions: DeriveGeneric + 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 , cereal @@ -102,9 +108,8 @@ , containers , data-default , deepseq >= 1.1 && < 1.5 - , directory - , dyre - , filepath + , path + , path-io , foreign-store , hslogger , messagepack >= 0.5.4 @@ -115,9 +120,7 @@ , megaparsec < 8 , prettyprinter >= 1.2 && < 2 , prettyprinter-ansi-terminal - , process , resourcet >= 1.1.11 - , setenv >= 0.1.1.3 , stm , streaming-commons , template-haskell @@ -125,9 +128,11 @@ , time , transformers , transformers-base + , typed-process , unliftio >= 0.2 , unliftio-core , utf8-string + , vector , void hs-source-dirs: library default-language: Haskell2010 @@ -138,6 +143,9 @@ type: exitcode-stdio-1.0 hs-source-dirs: test-suite main-is: Spec.hs + default-extensions: OverloadedStrings + , LambdaCase + , ScopedTypeVariables default-language: Haskell2010 build-depends: base >= 4.6 && < 5 , nvim-hs @@ -152,9 +160,8 @@ , conduit , containers , data-default - , directory - , dyre - , filepath + , path + , path-io , foreign-store , hslogger , mtl @@ -165,9 +172,8 @@ , megaparsec , prettyprinter , prettyprinter-ansi-terminal - , process + , typed-process >= 0.2.1.0 , resourcet - , setenv , stm , streaming-commons , text @@ -178,13 +184,13 @@ , unliftio , unliftio-core , utf8-string + , vector , HUnit other-modules: Neovim.API.THSpec , Neovim.API.THSpecFunctions , Neovim.EmbeddedRPCSpec , Neovim.Plugin.ClassesSpec - , Neovim.Plugin.ConfigHelperSpec , Neovim.RPC.SocketReaderSpec ghc-options: -threaded -rtsopts -with-rtsopts=-N diff --git a/test-files/compile-error-for-quickfix-test1 b/test-files/compile-error-for-quickfix-test1 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test1 +++ /dev/null @@ -1,7 +0,0 @@ - -/.config/nvim/nvim.hs:25:30: - Couldn't match expected type `Language.Haskell.TH.Syntax.Name' - with actual type `Double -> Neovim r0 st0 Double' - In the second argument of `function', namely `mySin' - In the expression: function "Sin" mySin - In the expression: $(function "Sin" mySin) diff --git a/test-files/compile-error-for-quickfix-test2 b/test-files/compile-error-for-quickfix-test2 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test2 +++ /dev/null @@ -1,3 +0,0 @@ - -/.config/nvim/lib/TestPlugins.hs:11:18: - Not in scope: `vim_function' diff --git a/test-files/compile-error-for-quickfix-test3 b/test-files/compile-error-for-quickfix-test3 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test3 +++ /dev/null @@ -1,2 +0,0 @@ - -/.config/nvim/nvim.hs:25:30: Not in scope: `mySin' diff --git a/test-files/compile-error-for-quickfix-test4 b/test-files/compile-error-for-quickfix-test4 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test4 +++ /dev/null @@ -1,4 +0,0 @@ - -/.config/nvim/lib/TestPlugins.hs:23:9: - Not in scope: ‘vim_call_dict_function’ - Perhaps you meant ‘vim_call_function’ (imported from Neovim) diff --git a/test-files/compile-error-for-quickfix-test5 b/test-files/compile-error-for-quickfix-test5 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test5 +++ /dev/null @@ -1,22 +0,0 @@ - -/.config/nvim/lib/TestPlugins.hs:23:9: Warning: - Couldn't match type ‘STM (Either Object Object)’ with ‘[Char]’ - Expected type: Neovim () () String - Actual type: Neovim () () (STM (Either Object Object)) - In the expression: - vim_call_dict_function "g:mydict" False "Greet" [toObject "World"] - In an equation for ‘greet’: - greet - = vim_call_dict_function - "g:mydict" False "Greet" [toObject "World"] - -/.config/nvim/lib/TestPlugins.hs:23:32:Warning: - Couldn't match expected type ‘Object’ with actual type ‘[Char]’ - In the first argument of ‘vim_call_dict_function’, namely - ‘"g:mydict"’ - In the expression: - vim_call_dict_function "g:mydict" False "Greet" [toObject "World"] - In an equation for ‘greet’: - greet - = vim_call_dict_function - "g:mydict" False "Greet" [toObject "World"] diff --git a/test-files/compile-error-for-quickfix-test6 b/test-files/compile-error-for-quickfix-test6 deleted file mode 100644 --- a/test-files/compile-error-for-quickfix-test6 +++ /dev/null @@ -1,5 +0,0 @@ - -/home/test/.config/nvim/nvim.hs:8:7: error: - • No instance for (Num String) arising from the literal ‘1’ - • In the expression: 1 - In an equation for ‘foo’: foo = 1 diff --git a/test-suite/Neovim/EmbeddedRPCSpec.hs b/test-suite/Neovim/EmbeddedRPCSpec.hs --- a/test-suite/Neovim/EmbeddedRPCSpec.hs +++ b/test-suite/Neovim/EmbeddedRPCSpec.hs @@ -1,66 +1,69 @@ -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} module Neovim.EmbeddedRPCSpec where -import Test.Hspec -import Test.HUnit +import Test.Hspec +import Test.HUnit import Neovim -import Neovim.Test -import qualified Neovim.Context.Internal as Internal +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.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 System.Directory -import System.Exit (ExitCode (..)) -import System.IO (hClose) -import System.Process +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.IO (hClose) +import System.Process.Typed spec :: Spec spec = parallel $ do - let helloFile = "test-files/hello" + let helloFile = [relfile|test-files/hello|] withNeovimEmbedded f a = testWithEmbeddedNeovim f (Seconds 3) () a describe "Read hello test file" . it "should match 'Hello, World!'" . withNeovimEmbedded (Just helloFile) $ do bs <- vim_get_buffers - l <- vim_get_current_line' + 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' + cl0 <- vim_get_current_line liftIO $ cl0 `shouldBe` "" - bs <- vim_get_buffers' + 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' + cl1 <- vim_get_current_line liftIO $ cl1 `shouldBe` testContent it "should create a new buffer" . withNeovimEmbedded Nothing $ do - bs0 <- vim_get_buffers' + bs0 <- vim_get_buffers liftIO $ length bs0 `shouldBe` 1 vim_command "new" - bs1 <- vim_get_buffers' + bs1 <- vim_get_buffers liftIO $ length bs1 `shouldBe` 2 vim_command "new" - bs2 <- vim_get_buffers' + 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 - Right q' <- vim_eval "getqflist()" + q' <- vim_eval "getqflist()" liftIO $ fromObjectUnsafe q' `shouldBe` [q] diff --git a/test-suite/Neovim/Plugin/ConfigHelperSpec.hs b/test-suite/Neovim/Plugin/ConfigHelperSpec.hs deleted file mode 100644 --- a/test-suite/Neovim/Plugin/ConfigHelperSpec.hs +++ /dev/null @@ -1,118 +0,0 @@ -module Neovim.Plugin.ConfigHelperSpec - where - -import Test.Hspec -import Test.HUnit (assertFailure) - -import Neovim.Plugin.ConfigHelper.Internal -import Neovim.Quickfix - -import Text.Megaparsec - -import qualified Data.ByteString as BS -import qualified Data.ByteString.UTF8 as BS - -isLeft :: Either a b -> Bool -isLeft (Left _) = True -isLeft _ = False - -isRight :: Either a b -> Bool -isRight = not . isLeft - - -readFileUTF8 :: FilePath -> IO String -readFileUTF8 = fmap BS.toString . BS.readFile - -spec :: Spec -spec = do - describe "parseQuickFfixItems" $ do - it "should match this test file 1" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test1" - let [qs] = parseQuickfixItems e - bufOrFile qs `shouldBe` Right "/.config/nvim/nvim.hs" - lnumOrPattern qs `shouldBe` Left 25 - col qs `shouldBe` VisualColumn 30 - nr qs `shouldBe` Nothing - errorType qs `shouldBe` Error - - it "should match this test file 2" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test2" - let [qs] = parseQuickfixItems e - bufOrFile qs `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs" - lnumOrPattern qs `shouldBe` Left 11 - col qs `shouldBe` VisualColumn 18 - nr qs `shouldBe` Nothing - errorType qs `shouldBe` Error - - it "should match this test file 3" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test3" - let [qs] = parseQuickfixItems e - bufOrFile qs `shouldBe` Right "/.config/nvim/nvim.hs" - lnumOrPattern qs `shouldBe` Left 25 - col qs `shouldBe` VisualColumn 30 - nr qs `shouldBe` Nothing - errorType qs `shouldBe` Error - - it "should match this test file 4" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test4" - let [qs] = parseQuickfixItems e - bufOrFile qs `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs" - lnumOrPattern qs `shouldBe` Left 23 - col qs `shouldBe` VisualColumn 9 - nr qs `shouldBe` Nothing - errorType qs `shouldBe` Error - - it "should match this test file 5" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test5" - let [q1,q2] = parseQuickfixItems e - bufOrFile q1 `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs" - bufOrFile q2 `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs" - lnumOrPattern q1 `shouldBe` Left 23 - lnumOrPattern q2 `shouldBe` Left 23 - col q1 `shouldBe` VisualColumn 9 - col q2 `shouldBe` VisualColumn 32 - nr q1 `shouldBe` Nothing - nr q2 `shouldBe` Nothing - errorType q1 `shouldBe` Warning - errorType q2 `shouldBe` Warning - - it "should match this test file 6" $ do - e <- readFileUTF8 "./test-files/compile-error-for-quickfix-test6" - let [q1] = parseQuickfixItems e - bufOrFile q1 `shouldBe` Right "/home/test/.config/nvim/nvim.hs" - lnumOrPattern q1 `shouldBe` Left 8 - col q1 `shouldBe` VisualColumn 7 - nr q1 `shouldBe` Nothing - errorType q1 `shouldBe` Error - - it "should parse all files concatenated" $ do - e1 <- readFileUTF8 "./test-files/compile-error-for-quickfix-test1" - e2 <- readFileUTF8 "./test-files/compile-error-for-quickfix-test2" - e3 <- readFileUTF8 "./test-files/compile-error-for-quickfix-test3" - let qs = parseQuickfixItems $ unlines [e1,e2,e3] - length qs `shouldBe` 3 - case qs of - [q1, q2, q3] -> do - lnumOrPattern q1 `shouldBe` Left 25 - lnumOrPattern q2 `shouldBe` Left 11 - lnumOrPattern q3 `shouldBe` Left 25 - _ -> assertFailure "Expected three quickfix list items." - - describe "pShortDesrciption" $ do - it "should fail for an empty input" $ - parse pShortDesrciption "" "" `shouldSatisfy` isLeft - it "should fail for an input solely consisting of spaces followed by a newline" $ - parse pShortDesrciption "" " \t \t\t \n" `shouldSatisfy` isLeft - it "should parse this simple expression" $ - parse pShortDesrciption "" "this simple expression\n" - `shouldBe` Right "this simple expression" - - describe "pLongDescription" $ do - it "should parse anything until there is a blank line" $ do - parse pLongDescription "" "\n\n" - `shouldBe` Right "" - parse pLongDescription "" "test\n \n" - `shouldBe` Right "test" - parse pLongDescription "" "test\n ibus\n \n" - `shouldBe` Right "test\n ibus" -