nvim-hs (empty) → 0.0.1
raw patch · 35 files changed
+3603/−0 lines, 35 filesdep +HUnitdep +QuickCheckdep +basesetup-changed
Dependencies added: HUnit, QuickCheck, base, bytestring, cereal, cereal-conduit, conduit, conduit-extra, containers, data-default, directory, dyre, filepath, hslogger, hspec, hspec-discover, lifted-base, messagepack, monad-control, mtl, network, nvim-hs, optparse-applicative, parsec, process, resourcet, stm, streaming-commons, template-haskell, text, time, transformers, transformers-base, utf8-string
Files
- LICENSE +202/−0
- Setup.hs +3/−0
- TestPlugins.hs +59/−0
- TestPlugins.vim +60/−0
- executable/Main.hs +17/−0
- library/Neovim.hs +485/−0
- library/Neovim/API/Parser.hs +192/−0
- library/Neovim/API/String.hs +20/−0
- library/Neovim/API/TH.hs +366/−0
- library/Neovim/Classes.hs +256/−0
- library/Neovim/Config.hs +44/−0
- library/Neovim/Context.hs +151/−0
- library/Neovim/Debug.hs +56/−0
- library/Neovim/Main.hs +137/−0
- library/Neovim/Plugin.hs +141/−0
- library/Neovim/Plugin/Classes.hs +238/−0
- library/Neovim/Plugin/ConfigHelper.hs +47/−0
- library/Neovim/Plugin/ConfigHelper/Internal.hs +101/−0
- library/Neovim/Plugin/IPC.hs +20/−0
- library/Neovim/Plugin/IPC/Classes.hs +30/−0
- library/Neovim/Plugin/IPC/Internal.hs +71/−0
- library/Neovim/Quickfix.hs +143/−0
- library/Neovim/RPC/Common.hs +136/−0
- library/Neovim/RPC/EventHandler.hs +97/−0
- library/Neovim/RPC/FunctionCall.hs +137/−0
- library/Neovim/RPC/SocketReader.hs +182/−0
- nvim-hs.cabal +148/−0
- nvim-hs.sh +24/−0
- test-files/compile-error-for-quickfix-test1 +7/−0
- test-files/compile-error-for-quickfix-test2 +3/−0
- test-files/compile-error-for-quickfix-test3 +2/−0
- test-files/compile-error-for-quickfix-test4 +4/−0
- test-files/compile-error-for-quickfix-test5 +22/−0
- test-files/hello +1/−0
- test-suite/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,202 @@+Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "{}"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright {yyyy} {name of copyright owner}++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.+
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ TestPlugins.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE OverloadedStrings #-}+import Neovim+import Neovim.Main (realMain)+import Neovim.Plugin.Classes++import System.Log.Logger++-- The script `TestPlugins.vim` comments how these functions should behave.++main :: IO ()+main = realMain def+ { plugins = [ randPlugin ]+ }++randPlugin :: IO NeovimPlugin+randPlugin = do+ -- This plugin was intended to use a real random number generator, but+ -- unfortunately a Travis build with other GHC versions failed to reproduce+ -- the same numbers. So we just chose from these three numbers. You better+ -- don't use this for cryptography!+ let randomNumbers = cycle [42,17,-666] :: [Int16]+ wrapPlugin Plugin+ { exports = [ EF (Function "Randoom" Sync, randoom)+ , EF (Function "Const42" Sync, const42)+ , EF (Function "PingNvimhs" Sync, pingNvimhs)+ ]+ , statefulExports =+ [((), randomNumbers,+ [ EF (Function "Random" Sync, rf)+ , EF (Function "InjectNumber" Sync, inj)+ ])+ ]+ }++rf :: [Object] -> Neovim cfg [Int16] Object+rf _ = do+ r <- gets head+ modify tail+ return $ ObjectInt (fromIntegral r)++inj :: [Object] -> Neovim cfg [Int16] Object+inj [x] = case fromObject x of+ Right n -> do+ liftIO . debugM "TestPlugins.hs" $ "updating map"+ modify (n:)+ startofints <- gets (take 10)+ liftIO . debugM "TestPlugins.hs" $ "Updated map to: " <> show startofints+ return ObjectNil+ Left _ -> liftIO (debugM "TestPlugin.hs" ("wrong argument type " ++ show x)) >> return ObjectNil+inj x = liftIO (debugM "TestPlugin.hs" ("wrong argument form " ++ show x)) >> return ObjectNil++randoom :: [Object] -> Neovim cfg st Object+randoom _ = err "Function not supported"++const42 :: [Object] -> Neovim cfg st Object+const42 _ = return $ ObjectInt 42++pingNvimhs :: [Object] -> Neovim cfg st Object+pingNvimhs _ = return $ ObjectString "Pong"
+ TestPlugins.vim view
@@ -0,0 +1,60 @@+" This script tests the intoroperability with all plugins defined in+" TestPlugins.hs+"+" TODO Define functions that return error messages for the assertions.+" For now, if the tests fail you should check the test log file for error+" messages (something like dist/test/nvim-hs-0.0.1-hspec.log).++" Initialize the plugin provider+call remote#host#Register('test', "*.l\?hs", rpcstart('./nvim-hs.sh', ['test']))+let haskellChannel = remote#host#Require('test')+" We need to issue a synchornous request to make sure that the function+" hooks are registered before we try to call them. Issueing this as late as+" possible will improve startup time because this is a blocking operation.+" TODO think about hooking into a general undefined function autocmd.+try+ if "Pong" != rpcrequest(haskellChannel, 'PingNvimhs', [])+ echom 'Ping function not properly registered'+ cq!+ endif+catch+ echom 'Functions not properly registered aborting'+ cq!+endtry++if haskellChannel < 1+ echom 'Failure to initialize the haskell channel for remote procedure calls'+ cq!+endif++" The test plugin random number generator is initialized with a static seed+if Random() != 42+ echom 'Expected Value of 42 but got: ' . Random()+ cq!+endif+if Random() != 17+ echom 'Expected Value of 17 but got: ' . Random()+ cq!+endif+if Random() != -666+ echom 'Expected Value of -666 but got: ' . Random()+ cq!+endif++" Test notifications+call InjectNumber(7)+if Random() != 7+ echom 'Expected Value of 7 but got: ' . Random()+ cq!+endif+++let notsorandomvalue = Const42()+if notsorandomvalue != 42+ echom 'Expected the ultimate answer, but got: ' . notsorandomvalue+ cq!+endif++" Everything works, exit normally+q!+
+ executable/Main.hs view
@@ -0,0 +1,17 @@+{- |+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 Data.Default+import Neovim (neovim)++main :: IO ()+main = neovim def
+ library/Neovim.hs view
@@ -0,0 +1,485 @@+{- |+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 enable you to write plugins.+The chapters in this module start with a tl;dr paragraph that sums things up,+which is useful to get an idea whether you should actually read the chapter and+which will reduce your reading time if you just want to refresh your memory.+-}+module Neovim (+ -- * Installation+ -- ** tl;dr+ -- $tldrinstallation++ -- ** Explained+ -- $explainedinstallation++ -- * Tutorial+ -- ** tl;dr+ -- $tldrtutorial+ Neovim,+ Neovim',+ neovim,+ NeovimConfig(..),+ def,++ -- ** Using existing plugins+ -- $existingplugins++ -- ** Creating a plugin+ -- $creatingplugins+ NeovimPlugin(..),+ Plugin(..),+ NvimObject,+ Dictionary,+ Object(..),+ toObject,+ fromObject,+ wrapPlugin,+ function,+ function',+ command,+ command',+ autocmd,+ Synchronous(..),+ CommandOptions(..),+ AutocmdOptions(..),++ -- TODO make Neovim a newtype wrapper with MonadReader and MonadState+ -- implementation?+ ask,+ asks,+ put,+ get,+ gets,+ modify,++ -- ** Creating a stateful plugin+ -- $statefulplugin++ -- ** Calling remote functions+ -- $remote+ wait,+ wait',+ waitErr,+ waitErr',+ err,+ -- ** 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,+ module Control.Applicative,+ module Data.Monoid,+ module Data.Int,++ ) where++import Control.Applicative+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.Text ()+import Neovim.API.String+import Neovim.API.TH (autocmd, command, command', function,+ function')+import Neovim.Classes (Dictionary, NvimObject (..))+import Neovim.Config (NeovimConfig (..))+import Neovim.Context (Neovim, Neovim', ask, asks, err, get,+ gets, modify, put)+import Neovim.Main (neovim)+import Neovim.Plugin.Classes (AutocmdOptions (..),+ CommandOptions (..),+ NeovimPlugin (..), Plugin (..),+ Synchronous (..), wrapPlugin)+import Neovim.RPC.FunctionCall (wait, wait', waitErr, waitErr')++-- Installation {{{1+-- tl;dr installation {{{2+{- $tldrinstallation++Since this is still very volatile, I recommend using a sandbox.++__Make sure that neovim's executable (@nvim@) is on your @\$PATH@ during the following steps!__++Install `nvim-hs` from git (example assumes you clone to @\$HOME\/git\/nvim-hs@)+using a sandbox:++@+\$ mkdir -p ~\/git ; cd ~\/git+\$ git clone https:\/\/github.com\/saep\/nvim-hs+\$ cd nvim-hs+\$ git sandbox init+\$ cabal install+@++Create this executable script (e.g. @\$HOME\/bin\/nvim-hs@):++@+\#!\/bin\/sh++sandbox_directory=\$HOME\/git\/nvim-hs+old_pwd="`pwd`"+cd "$sandbox_directory"+env CABAL_SANDBOX_CONFIG="$sandbox_directory"\/cabal.sandbox.config cabal \\+ exec "$sandbox_directory\/.cabal-sandbox\/bin\/nvim-hs" -- "$@"+cd "$old_pwd"+@++Put this in your neovim config file (typically @~\/.nvimrc@ or @~\/.nvim\/nvimrc@):++@+if has(\'nvim\') \" This way you can also put it in your vim config file+ function! s:RequireHaskellHost(name)+ \" If the nvim-hs script/executable is not on your path, you should give the full path here+ return rpcstart(\'nvim-hs\', [a:name.name])+ endfunction++ \" You can replace \'haskell\' in the following lines with any name you like.+ call remote\#host\#Register(\'haskell\', \'*.[cl]\\?hs\', function(\'s:RequireHaskellHost\'))+ \" Blocks until nvim-hs has started (optional)+ call rpcrequest(remote\#host\#Require(\'haskell\'),+ \\ \'PingNvimhs\', [])+endif+@++-}+-- 2}}}++-- Explained {{{2+{- $explainedinstallation++You essentially have to follow the instructions of the tl;dr subsection above,+but this subsections tells you why you need those steps and it gives you the+required knowledge do deviate from those instructions.++If you want to use or write plugins written in haskell for /nvim-hs/, you first+have to make sure that neovim is installed and that it is available on your+@\$PATH@ during the compilation of /nvim-hs/. Neovim emits information about its+remotely callable API if you call it with the `--api-info` argument. This output+is used to generate the API functions you desperately need to create useful+plugins. Also, some internal functionality requires some of these functions.++The instructions to install /nvim-hs/ should be self-explanatory. In any case, I+(saep) recommend using a sandbox for now since there is no stable hackage+release yet and a few librarier are newer than what is currently in stackage+(namely mtl, which is a big deal). Using a sandbox requires you to install all+the libraries you want or have to use in your plugins to be installed inside the+sandbox! Some Vim plugins (e.g. ghc-mod) may show weird errors inside neovim for+your configuration file because the sandbox is not inside your configuration folder.+For /nvim-hs/ you don't need to worry about that, though, because it has a+builtin plugin which puts all compile-errors in the quickfix+list automatically after you save your configuration file, so you don't need+another plugin to detect compile time errors here. But we will discuss this+later in more detail. The executable script sets up the build environment for+/nvim-hs/ to use the sandbox. You should only have to adjust the path for the+`sandbox_directory` variable there if you did not install /nvim-hs/ in a sandbox+located at `\$HOME\/git\/nvim-hs`.++The Vim-script snippet is a bit lengthy, but the comments should explain how it+works. In any case, the snippet can be put anywhere in your neovim configuration+file and the last call of `rpcrequest` is not needed if you don't call any+functionality before /nvim-hs/ has started properly. Removing the call can+improve the startup time. If you only need some functionality for haskell source+files, you could move those last (or the last two) lines at the top of+@\$HOME\/.nvim\/ftplugin\/haskell.vim@. You may wonder why we have to explicitly+call 'PingNvimhs' with the function `rpcrequest` here. The short answer is:+The internals for registering functions from a remote host require this. The+longer answer is as follows: Registering functions from a remote host does not+define a function directly. It instead installs a hook via an autocmd that+defines the function. This way, only functions that are actually used are+registered and this probably was implemented this way for performance reasons.+Buf, if we try to call a function from a remote host too early, the hooks may+not yet be in place and we receive error messages. Since we do not generate any+Vim-script files which contain those hooks, /nvim-hs/ must be started and+initialized and create those hooks. So the best way to make sure that /nvim-hs/+is initialized is to try to call some functionon the msgpack-rpc channel that+/nvim-hs/ listens on. The function must not even exist, but not throwing an+error message is probably nicer, so /nvim-hs/ provides a function \"PingNvimhs\"+which takes no arguments and returns @\"Pong\"@.++Using /nvim-hs/ essentially means to use a static binary that incorporates all+plugins. It is generated using the 'Dyre' library and the binary itself is found+in @\$XDG_CACHE_DIR\/nvim@ (usually @~\/.cache\/nvim). The 'Dyre' library makes+it feel more like a scripting language, because the binary is automatically+created and executed without having to restart neovim.++-}+-- 2}}}+-- 1}}}++-- Tutorial {{{1+-- tl;dr {{{2+{- $tldrgettingstarted+Create a file called @nvim.hs@ in @\$XDG_CONFIG_HOME\/nvim@ (usually+@~\/.config\/nvim@ with the following content:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}+import Neovim++main = 'neovim' 'def'+@++Adjust the fields in @def@ according to the the parameters in 'NeovimConfig'.++-}+-- 2}}}++-- Existing Plugins {{{2+{- $existingplugins+/nvim-hs/ is all about importing and creating plugins. This is done following+simple and 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:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}++import TestPlugin.ExamplePlugin (examplePlugin)++main = 'neovim' 'def'+ { plugins = [examplePlugin]+ }+@++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 a simple API+and not be surprised about 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, we must define+our functions in a different module than @\$XDG_CONFIG_HOME\/nvim\/nvim.hs@.+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\/MyFirstPlugin.hs@++@+module MyFirstPlugin+ ( fibonacci+ ) where++import Neovim++fibonacci :: 'Int' -> Neovim' 'String'+fibonacci n = 'show' $ fibs !! n+ where+ fibs :: ['Integer']+ fibs = 1:1:'scanl1' (+) fibs+@++File @~\/.config\/nvim\/nvim.hs@:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}++import MyFirstPlugin (fibonacci)++fibonacciPlugin = 'wrapPlugin'+ { 'exports' = [ $('function'' 'fibonacci) 'Sync' ]+ }++main = 'neovim' 'def'+ { 'plugins' = [fibonacciPlugin]+ }+@++Let's analyze how it works. The module @MyFirstPlugin@ 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' r st 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 @fibonacciPlugin@+in @~\/.config\/nvim\/nvim.hs@, shows what a plugin is. It is essentially two+lists of stateless and stateful functionality. A functionality can currently be one+of three things: a function, a command and an autocmd in the context of vim+terminology. In the end, all of those functionalities map to a function at the side+of /nvim-hs/. If you really want to know what the distinction between those, 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 distinction+between __stateful__ and __stateless__. A stateless function can be called at any+time and it does not share any of its internals with other functions. A stateful+function on the other hand can share a well-defined amount of state with other+functions and in the next section I will show you a simple example for that.+Anyhow, if you take a look at the type alias for 'Neovim', you notice the two+type variables @r@ and @st@. These can be accessed with different semantics+each. A value of type @r@ can only be read. It is more or less a static value+you can query with 'ask' or 'asks' if you+are inside a 'Neovim' environment. The value @st@ can be changed and those+changes will be available to other functions which run in the same environment.+You can get the current value with 'get', you can replace an existing value with+'put' and you can also apply a function to the current state with 'modify'.+Notice how 'Neovim'' is just a specialization of 'Neovim' with its @r@ and+@st@ set to @()@.++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 from 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 calculate the 287323rd Fibonacci number+like this:++@+:echo Fibonacci(287323)+@++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(287323)+@++-}+-- 2}}}+-- Creating a stateful plugin {{{2+{- $remote+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\/MyRandomNumberGenerator.hs@:++@+module MyRandomNumberGenerator+ ( nextRand+ , setNextNumber+ ) where++nextRand :: 'Neovim' r ['Int16'] Int16+nextRand = do+ r <- gets head+ modify tail+ return r++setNextNumber :: Int16 -> 'Neovim' r ['Int16'] ()+setNextNumber n = modify (n:)+@++File @~\/.config\/nvim\/nvim.hs@:++@+\{\-\# LANGUAGE TemplateHaskell \#\-\}++import MyRandomNumberGenerator (nextRand, setNextNumber)+import System.Random (newStdGen, randoms)++randPlugin = do+ g <- newStdGen -- initialize with a random seed+ let randomNumbers = randoms g -- an infite list of random numbers+ 'wrapPlugin'+ { 'statefulExports' =+ [ ((), randomNumbers,+ [ $('function'' 'nextRand) 'Sync'+ , $('function'' 'setNextNumber) 'Async'+ ])+ ]+ }++main = 'neovim' 'def'+ { 'plugins' = [randPlugin]+ }+@++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 'statefulExpors'+field because it is a list of triples which has a list of exported functionality+as its third argument.++-}+-- 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' r st ()+inspectBuffer = do+ cb <- 'vim_get_current_buffer'+ 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+@++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. 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.++That's pretty much all there is to it.+-}+-- 2}}}+-- 1}}}++-- vim: foldmethod=marker
+ library/Neovim/API/Parser.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE OverloadedStrings #-}+{- |+Module : Neovim.API.Parser+Description : 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.Exception.Lifted+import Control.Monad.Except+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as U+import Data.Map (Map)+import qualified Data.Map as Map+import Data.MessagePack+import Data.Monoid+import Data.Serialize+import System.IO (hClose)+import System.Process+import Text.Parsec as P++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.+ , deferred :: 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 String NeovimAPI)+parseAPI = join . fmap (runExcept . extractAPI) <$> runExceptT decodeAPI++extractAPI :: Object -> Except String NeovimAPI+extractAPI apiObj = NeovimAPI+ <$> extractErrorTypes apiObj+ <*> extractCustomTypes apiObj+ <*> extractFunctions apiObj++decodeAPI :: ExceptT String IO Object+decodeAPI = bracket queryNeovimAPI clean $ \(out, _) ->+ either throwError return =<< decode <$> lift (B.hGetContents out)++ where+ queryNeovimAPI = do+ (_, Just out, _, ph) <- lift . createProcess $+ (proc "nvim" ["--api-info"]) { std_out = CreatePipe }+ return (out, ph)++ clean (out, ph) = lift $ do+ hClose out+ terminateProcess ph++oMap :: Object -> Except String (Map Object Object)+oMap o = case o of+ ObjectMap m -> return m+ _ -> throwError $ "Object is not a map: " ++ show o++oLookup :: Object -> Object -> Except String Object+oLookup qry o = oMap o+ >>= maybe (throwError ("No entry for" <> show qry)) return+ . Map.lookup qry++oLookupDefault :: Object -> Object -> Object -> Except String Object+oLookupDefault d qry o = oMap o+ >>= maybe (return d) return . Map.lookup qry++-- | Extract a 'String' from on 'Object'.+--+-- Works on @ObjectBinary@ and @ObjectString@ constructor.+oToString :: Object -> Except String String+oToString o = case o of+ ObjectBinary bs -> return $ U.toString bs+ ObjectString t -> return $ U.toString t+ _ -> throwError $ show o <> " is not convertible to a String."++-- | Extract an 'Int64' from an @Object@.+--+oInt :: Object -> Except String Int64+oInt o = case o of+ ObjectInt i -> return i+ _ -> throwError $ show o <> " is not an Int64."++oArr :: Object -> Except String [Object]+oArr o = case o of+ ObjectArray os -> return os+ _ -> throwError $ show o <> " is not an Array."++oToBool :: Object -> Except String Bool+oToBool o = case o of+ ObjectBool b -> return b+ _ -> throwError $ show o <> " is not a boolean."++extractErrorTypes :: Object -> Except String [(String, Int64)]+extractErrorTypes objAPI =+ extractTypeNameAndID =<< oLookup (ObjectBinary "error_types") objAPI++extractTypeNameAndID :: Object -> Except String [(String, Int64)]+extractTypeNameAndID m = do+ types <- Map.toList <$> oMap m+ forM types $ \(errName, idMap) -> do+ n <- oToString errName+ i <- oInt =<< oLookup (ObjectBinary "id") idMap+ return (n,i)++extractCustomTypes :: Object -> Except String [(String, Int64)]+extractCustomTypes objAPI =+ extractTypeNameAndID =<< oLookup (ObjectBinary "types") objAPI++extractFunctions :: Object -> Except String [NeovimFunction]+extractFunctions objAPI = do+ funList <- oArr =<< oLookup (ObjectBinary "functions") objAPI+ forM funList extractFunction++toParameterlist :: [Object] -> Except String [(NeovimType, String)]+toParameterlist ps = forM ps $ \p -> do+ [t, n] <- mapM oToString =<< oArr p+ t' <- parseType t+ return (t', n)++extractFunction :: Object -> Except String NeovimFunction+extractFunction funDefMap = NeovimFunction+ <$> (oLookup (ObjectBinary "name") funDefMap >>= oToString)+ <*> (oLookup (ObjectBinary "parameters") funDefMap+ >>= oArr >>= toParameterlist)+ <*> (oLookupDefault (ObjectBool False) (ObjectBinary "can_fail") funDefMap+ >>= oToBool)+ <*> (oLookup (ObjectBinary "deferred") funDefMap >>= oToBool)+ <*> (oLookup (ObjectBinary "return_type") funDefMap+ >>= oToString >>= parseType)++parseType :: String -> Except String NeovimType+parseType s = either (throwError . show) return $ parse (pType <* eof) s s++pType :: Parsec String u NeovimType+pType = pArray P.<|> pVoid P.<|> pSimple++pVoid :: Parsec String u NeovimType+pVoid = const Void <$> (P.try (string "void") <* eof)++pSimple :: Parsec String u NeovimType+pSimple = SimpleType <$> many1 (noneOf ",)")++pArray :: Parsec String u NeovimType+pArray = NestedType <$> (P.try (string "ArrayOf(") *> pType)+ <*> optionMaybe pNum <* char ')'++pNum :: Parsec String u Int+pNum = read <$> (P.try (char ',') *> spaces *> many1 (oneOf ['0'..'9']))+
+ library/Neovim/API/String.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# 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++-}+module Neovim.API.String+ where++import Neovim.API.TH++$(generateAPI defaultAPITypeToHaskellTypeMap)+
+ library/Neovim/API/TH.hs view
@@ -0,0 +1,366 @@+{-# LANGUAGE OverloadedStrings #-}+{-# 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+ , defaultAPITypeToHaskellTypeMap+ , module Control.Exception.Lifted+ , module Neovim.Classes+ , module Data.Data+ , module Data.MessagePack+ ) where++import Neovim.API.Parser+import Neovim.Classes+import Neovim.Context+import Neovim.Plugin.Classes (CommandOptions (..),+ ExportedFunctionality (..),+ FunctionalityDescription (..))+import Neovim.RPC.FunctionCall++import Language.Haskell.TH++import Control.Applicative+import Control.Arrow+import Control.Concurrent.STM (STM)+import Control.Exception+import Control.Exception.Lifted+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 Data.Text (pack)++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 :: Map String (Q Type) -> Q [Dec]+generateAPI typeMap = do+ api <- either fail return =<< runIO parseAPI+ let exceptionName = mkName "NeovimExceptionGen"+ exceptions = (\(n,i) -> (mkName ("Neovim" <> n), i)) <$> errorTypes api+ customTypesN = first mkName <$> customTypes api+ join <$> sequence+ [ fmap return . createDataTypeWithByteStringComponent exceptionName $ fst <$> exceptions+ , exceptionInstance exceptionName+ , customTypeInstance exceptionName exceptions+ , mapM (\n -> createDataTypeWithByteStringComponent n [n]) $ fst <$> customTypesN+ , join <$> mapM (\(n,i) -> customTypeInstance n [(n,i)]) customTypesN+ , fmap join . mapM (createFunction typeMap) $ functions api+ ]+++-- | Default type mappings for the requested API.+defaultAPITypeToHaskellTypeMap :: Map String (Q Type)+defaultAPITypeToHaskellTypeMap = Map.fromList+ [ ("Boolean" , [t|Bool|])+ , ("Integer" , [t|Int64|])+ , ("Float" , [t|Double|])+ , ("Array" , [t|[Object]|])+ , ("Dictionary", [t|Map Object Object|])+ , ("void" , [t|()|])+ ]+++apiTypeToHaskellType :: Map String (Q Type) -> NeovimType -> Q Type+apiTypeToHaskellType typeMap at = case at of+ Void -> [t|()|]+ NestedType t Nothing ->+ appT listT $ 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+++-- | 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 :: Map String (Q Type) -> NeovimFunction -> Q [Dec]+createFunction typeMap nf = do+ let withDeferred | deferred nf = appT [t|STM|]+ | otherwise = id+ withException | canFail nf = appT [t|Either Object|]+ | otherwise = id++ callFn | deferred nf && canFail nf = [|acall|]+ | deferred nf = [|acall'|]+ | canFail nf = [|scall|]+ | otherwise = [|scall'|]++ functionName = (mkName . name) nf+ toObjVar v = [|toObject $(varE v)|]+++ ret <- let (r,st) = (mkName "r", mkName "st")+ in forallT [PlainTV r, PlainTV st] (return [])+ . appT ([t|Neovim $(varT r) $(varT st) |])+ . withDeferred . withException+ . apiTypeToHaskellType typeMap $ returnType nf++ vars <- mapM (\(t,n) -> (,) <$> apiTypeToHaskellType typeMap t+ <*> newName n)+ $ parameters nf+ sequence+ [ sigD functionName . return+ . foldr (AppT . AppT ArrowT) ret $ map fst vars+ , funD functionName+ [ clause+ (map (varP . snd) vars)+ (normalB (callFn+ `appE` ([| 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|]+ dataD+ (return [])+ nme+ []+ (map (\n-> normalC n [return (IsStrict, tObject)]) cs)+ (mkName <$> ["Typeable", "Eq", "Show"])+++-- | If the first parameter is @mkName NeovimException@, this function will+-- generate @instance Exception NeovimException"@.+exceptionInstance :: Name -> Q [Dec]+exceptionInstance exceptionName = return <$>+ instanceD+ (return [])+ ([t|Exception|] `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 =+ 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 [|Left $ "Object is not convertible to: " <> n <> " Received: " <> show $(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)|])+ []++ in return <$> instanceD+ (return [])+ ([t|NvimObject|] `appT` conT typeName)+ [ funD (mkName "toObject") $ map (uncurry toObjectClause) nis+ , funD (mkName "fromObject")+ $ map (uncurry fromObjectClause) nis+ <> [fromObjectErrorClause]+ ]+++-- | Define an exported function by providing a cutom name and referencing the+-- function you want to export.+--+-- Note that the name must start with an upper case letter.+--+-- Example: @ $(function "MyExportedFunction" 'myDefinedFunction) def @+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 (pack $(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+++-- | 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.+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 capiatl letter: " <> show customFunctionName+ | otherwise = do+ (nargs, fun) <- functionImplementation functionName+ [|\copts -> EF (Command (pack $(litE (StringL customFunctionName))) (copts { cmdNargs = nargs }), $(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+++-- | Define an autocmd. 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 functions and pass it as an arguments.+autocmd :: Name -> Q Exp+autocmd functionName =+ let (c:cs) = nameBase functionName+ in do+ (_, fun) <- functionImplementation functionName+ [|\t acmdOpts -> EF (Autocmd t (pack $(litE (StringL (toUpper c : cs)))) acmdOpts, $(return fun))|]+++-- | 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 (Int, Exp)+functionImplementation functionName = do+ fInfo <- reify functionName+ -- We only need the number of arguments to generate the appropriate function+ let nargs = 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 -> Int+ determineNumberOfArguments ft = case ft of+ ForallT _ _ t -> determineNumberOfArguments t+ AppT (AppT ArrowT _) r -> 1 + determineNumberOfArguments r+ _ -> 0+ -- \args -> case args of ...+ topLevelCase :: Int -> Q Exp+ topLevelCase n = newName "args" >>= \args ->+ lamE [varP args] (caseE (varE args) [matchingCase n, errorCase])++ -- _ -> err "Wrong number of arguments"+ errorCase :: Q Match+ errorCase = match wildP+ (normalB [|err $ "Wrong number of arguments for function: "+ ++ $(litE (StringL (nameBase functionName))) |]) []++ -- [x,y] -> case pure add <*> fromObject x <*> fromObject y of ...+ matchingCase :: Int -> Q Match+ matchingCase n = mapM (\_ -> newName "x") [1..n] >>= \vars ->+ match (listP (map varP vars))+ (normalB+ (caseE+ (foldl genArgumentCast [|pure $(varE functionName)|]+ (zip vars (repeat [|(<*>)|])))+ [successfulEvaluation, failedEvaluation]))+ []++ genArgumentCast :: Q Exp -> (Name, Q Exp) -> Q Exp+ genArgumentCast e (v,op) = infixE (Just e) op (Just [|fromObject $(varE v)|])++ 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)|])+ []+
+ library/Neovim/Classes.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverlappingInstances #-}+{-# 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++ , module Data.Int+ ) where++import Neovim.Context++import Control.Applicative+import Control.Arrow+import Control.Monad.Except+import Data.ByteString (ByteString)+import Data.Int (Int16, Int32, Int64)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.MessagePack+import Data.Monoid+import Data.Text as Text (Text)+import Data.Traversable hiding (forM, mapM)++import Prelude++-- FIXME saep 2014-11-28 Is assuming UTF-8 reasonable?+import qualified Data.ByteString.UTF8 as U (fromString, toString)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+++-- | 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 = Map ByteString Object+++-- | Conversion from 'Object' files to Haskell types and back with respect+-- to neovim's interpretation.+class NvimObject o where+ toObject :: o -> Object+ fromObjectUnsafe :: Object -> o+ fromObjectUnsafe o = case fromObject o of+ Left e -> error $ unwords+ [ "Not the expected object:"+ , show o , "(", e, ")"+ ]+ Right obj -> obj+ fromObject :: (NvimObject o) => Object -> Either String o+ fromObject = return . fromObjectUnsafe++-- Instances for NvimObject {{{1+instance NvimObject () where+ toObject _ = ObjectNil+ fromObject ObjectNil = return ()+ fromObject o = throwError $ "Expected ObjectNil, but got " <> show 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 ObjectNil = 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 o = throwError $ "Expected ObjectDouble, but got " <> show o++instance NvimObject Integer where+ toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt o) = return $ toInteger o+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected ObjectInt, but got " <> show o++instance NvimObject Int64 where+ toObject = ObjectInt+ fromObject (ObjectInt i) = return i+ fromObject (ObjectDouble o) = return $ round o+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got " <> show o++instance NvimObject Int32 where+ toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt 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 " <> show o++instance NvimObject Int16 where+ toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt 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 " <> show o++instance NvimObject Int where+ toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt 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 " <> show o++instance NvimObject Char where+ toObject c = ObjectBinary . U.fromString $ [c]+ fromObject str = case fromObject str of+ Right [c] -> return c+ _ -> throwError $ "Expected one element string but got: " <> show str++instance NvimObject [Char] where+ toObject = ObjectBinary . U.fromString+ fromObject (ObjectBinary o) = return $ U.toString o+ fromObject (ObjectString o) = return $ U.toString o+ fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o++instance NvimObject o => NvimObject [o] where+ toObject = ObjectArray . map toObject+ fromObject (ObjectArray os) = return $ map fromObjectUnsafe os+ fromObject o = throwError $ "Expected ObjectArray, but got " <> show 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 (Ord key, NvimObject key, NvimObject val)+ => NvimObject (Map key val) where+ toObject = ObjectMap+ . Map.fromList . map (toObject *** toObject) . Map.toList+ fromObject (ObjectMap om) = Map.fromList <$>+ (sequenceA+ . map (uncurry (liftA2 (,))+ . (fromObject *** fromObject))+ . Map.toList) om++ fromObject o = throwError $ "Expected ObjectMap, but got " <> show 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 " <> show o++instance NvimObject ByteString where+ toObject = ObjectBinary+ fromObject (ObjectBinary o) = return o+ fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o++instance NvimObject Object where+ toObject = id+ fromObject = return+ fromObjectUnsafe = id++-- By the magic of vim, i will create these.+instance NvimObject o => NvimObject (o, o) where+ toObject (o1, o2) = ObjectArray $ map toObject [o1, o2]+ fromObject (ObjectArray [o1, o2]) = (,)+ <$> fromObject o1+ <*> fromObject o2+ fromObject o = throwError $ "Expected ObjectArray, but got " <> show o++instance NvimObject o => NvimObject (o, o, o) where+ toObject (o1, o2, o3) = ObjectArray $ map toObject [o1, o2, o3]+ fromObject (ObjectArray [o1, o2, o3]) = (,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ fromObject o = throwError $ "Expected ObjectArray, but got " <> show o++instance NvimObject o => NvimObject (o, o, o, o) where+ toObject (o1, o2, o3, o4) = ObjectArray $ map toObject [o1, o2, o3, o4]+ fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ fromObject o = throwError $ "Expected ObjectArray, but got " <> show o++instance NvimObject o => NvimObject (o, o, o, o, o) where+ toObject (o1, o2, o3, o4, o5) = ObjectArray $ map toObject [o1, o2, o3, o4, 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 " <> show o++instance NvimObject o => NvimObject (o, o, o, o, o, o) where+ toObject (o1, o2, o3, o4, o5, o6) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, 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 " <> show o++instance NvimObject o => NvimObject (o, o, o, o, o, o, o) where+ toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, 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 " <> show o++instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o) where+ toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, 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 " <> show o++instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o, o) where+ toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, o8, 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 " <> show o++-- 1}}}
+ library/Neovim/Config.hs view
@@ -0,0 +1,44 @@+{- |+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 Data.Default,+ module System.Log,+ ) where++import Neovim.Plugin.Classes (NeovimPlugin)++import qualified Config.Dyre as Dyre+import Data.Default (Default (def))+import System.Log (Priority (..))++data NeovimConfig = Config+ { plugins :: [IO 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'.+ , errorMessage :: Maybe String+ -- ^ Used by 'Dyre' for storing compilation errors.+ , logOptions :: Maybe (FilePath, Priority)+ -- ^ Set the general logging options.+ , dyreParams :: Maybe (Dyre.Params NeovimConfig)+ -- ^ Parmaeters used by 'Dyre'. This is only used for the+ -- "Neovim.Plugin.ConfigHelper" plugin.+ }++instance Default NeovimConfig where+ def = Config+ { plugins = []+ , errorMessage = Nothing+ , logOptions = Nothing+ , dyreParams = Nothing+ }+
+ library/Neovim/Context.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# 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 (+ asks,+ ask,+ eventQueue,++ get,+ put,+ modify,+ gets,++ Neovim,+ Neovim',+ NeovimException(..),+ ConfigWrapper(..),+ runNeovim,+ forkNeovim,+ err,+ restart,+ quit,+ QuitAction(..),++ throwError,+ module Control.Monad.IO.Class,+ ) where+++import Control.Concurrent (MVar, ThreadId, forkIO, putMVar)+import Control.Concurrent.STM+import Control.Exception+import Control.Monad.Except+import Control.Monad.IO.Class+import Control.Monad.Reader hiding (ask, asks)+import qualified Control.Monad.Reader as R+import Control.Monad.State+import Data.Data (Typeable)+import Neovim.Plugin.IPC (SomeMessage)+import System.Log.Logger+++-- | A wrapper for a reader value that contains extra fields required to+-- communicate with the messagepack-rpc components.+data ConfigWrapper a = ConfigWrapper+ { _eventQueue :: TQueue SomeMessage+ -- ^ A queue of messages that the event handler will propagate to+ -- appropriate threads and handlers.+ , _quit :: MVar QuitAction+ -- ^ 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+ -- 'QuitAction'.+ , _providerName :: String+ -- ^ Name that is used to identify this provider. Assigning such a name is+ -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).+ , customConfig :: a+ -- ^ Plugin author supplyable custom configuration. It can be queried via+ -- 'myConf'.+ }+++data QuitAction = Quit+ -- ^ Quit the plugin provider.+ | Restart+ -- ^ Restart the plugin provider.+ deriving (Show, Read, Eq, Ord, Enum, Bounded)+++eventQueue :: Neovim r st (TQueue SomeMessage)+eventQueue = R.asks _eventQueue+++-- | This is the environment in which all plugins are initially started.+-- Stateless functions use '()' for the static configuration and the mutable+-- state and there is another type alias for that case: 'Neovim''.+--+-- 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.+type Neovim r st = StateT st (ReaderT (ConfigWrapper r) IO)+++-- | Convenience alias for @'Neovim' () ()@.+type Neovim' = Neovim () ()+++-- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.+runNeovim :: ConfigWrapper r+ -> st+ -> Neovim r st a+ -> IO (Either String (a, st))+runNeovim r st a = (try . runReaderT (runStateT a st)) r >>= \case+ Left e -> do+ liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e+ return . Left $ show (e :: SomeException)+ Right res -> return $ Right res+++-- | Fork a neovim thread with the given custom config value and a custom+-- state. The result of the thread is discarded and only the 'ThreadId' is+-- returend immediately.+forkNeovim :: ir -> ist -> Neovim ir ist a -> Neovim r st ThreadId+forkNeovim r st a = do+ cfg <- R.ask+ liftIO . forkIO . void $ runNeovim (cfg { customConfig = r }) st a+++data NeovimException+ = ErrorMessage String+ deriving (Typeable, Show)++instance Exception NeovimException+++-- | @throw . ErrorMessage@+err :: String -> Neovim r st a+err = throw . ErrorMessage+++-- | Retrieve something from the configuration with respect to the first+-- function. Works exactly like 'R.asks'.+asks :: (r -> a) -> Neovim r st a+asks q = R.asks (q . customConfig)+++-- | Retrieve the Cunfiguration (i.e. read-only state) from the 'Neovim'+-- context.+ask :: Neovim r st r+ask = R.asks customConfig+++-- | Initiate a restart of the plugin provider.+restart :: Neovim r st ()+restart = liftIO . flip putMVar Restart =<< R.asks _quit+++-- | Initiate the termination of the plugin provider.+quit :: Neovim r st ()+quit = liftIO . flip putMVar Quit =<< R.asks _quit+
+ library/Neovim/Debug.hs view
@@ -0,0 +1,56 @@+{- |+Module : Neovim.Debug+Description : Debugging facilities+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental++-}+module Neovim.Debug (+ 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 view
@@ -0,0 +1,137 @@+{-# LANGUAGE LambdaCase #-}+{- |+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 Neovim.Plugin as P+import qualified Neovim.Plugin.ConfigHelper as ConfigHelper++import qualified Config.Dyre as Dyre+import qualified Config.Dyre.Relaunch as Dyre+import Control.Concurrent+import Control.Concurrent.STM+import Data.Monoid+import Neovim.Context+import Neovim.Debug+import Neovim.RPC.Common as RPC+import Neovim.RPC.EventHandler+import Neovim.RPC.SocketReader+import Options.Applicative+import System.IO (stdin, stdout)++data CommandLineOptions =+ Opt { providerName :: String+ , hostPort :: Maybe (String, Int)+ , unix :: Maybe FilePath+ , env :: Bool+ , logOpts :: Maybe (FilePath, Priority)+ }++optParser :: Parser CommandLineOptions+optParser = Opt+ <$> strArgument+ (metavar "NAME"+ <> help "Name that associates the plugin provider with neovim")+ <*> 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 the "Config.Dyre" for the configuration..+neovim :: NeovimConfig -> IO ()+neovim conf =+ let params = Dyre.defaultParams+ { Dyre.showError = \cfg errM -> cfg { errorMessage = Just errM }+ , Dyre.projectName = "nvim"+ , Dyre.realMain = realMain+ , Dyre.statusOut = debugM "Dyre"+ , Dyre.ghcOpts = ["-threaded", "-rtsopts", "-with-rtsopts=-N"]+ }+ in Dyre.wrapMain params (conf { dyreParams = Just params })++realMain :: NeovimConfig -> IO ()+realMain cfg = do+ os <- execParser opts+ maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do+ logM "Neovim.Main" DEBUG "Starting up neovim haskell plguin provider"+ runPluginProvider os cfg++runPluginProvider :: CommandLineOptions -> NeovimConfig -> IO ()+runPluginProvider os = case (hostPort os, unix os) of+ (Just (h,p), _) -> let s = TCP p h in run s s+ (_, Just fp) -> let s = UnixSocket fp in run s s+ _ | env os -> run Environment Environment+ _ -> run (Stdout stdout) (Stdout stdin)++ where+ run evHandlerSocket sockreaderSocket cfg = do+ rpcConfig <- newRPCConfig+ q <- newTQueueIO+ quitter <- newEmptyMVar+ let conf = ConfigWrapper q quitter (providerName os) ()+ allPlugins = maybe id ((:) . ConfigHelper.plugin) (dyreParams cfg) $ plugins cfg+ startPluginThreads (conf { customConfig = RPC.functions rpcConfig }) allPlugins >>= \case+ Left e -> errorM "Neovim.Main" $ "Error initializing plugins: " <> e+ Right pluginTidsWithQueues -> do+ let rpcEnv = conf { customConfig = rpcConfig }+ ehTid <- forkIO $ runEventHandler evHandlerSocket rpcEnv+ _ <- forkIO $ register (conf { customConfig = RPC.functions rpcConfig }) pluginTidsWithQueues+ let pluginTids = concatMap (map fst . snd) pluginTidsWithQueues+ rTid <- forkIO $ runSocketReader sockreaderSocket rpcEnv+ debugM "Neovim.Main" "Waiting for threads to finish."+ finish (rTid:ehTid:pluginTids) =<< readMVar quitter++finish :: [ThreadId] -> QuitAction -> IO ()+finish threads = \case+ Restart -> do+ debugM "Neovim.Main" "Trying to restart nvim-hs"+ mapM_ killThread threads+ Dyre.relaunchMaster Nothing+ Quit -> return ()
+ library/Neovim/Plugin.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{- |+Module : Neovim.Plugin+Description :+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC++-}+module Neovim.Plugin (+ startPluginThreads,+ register,+ wrapPlugin,+ NeovimPlugin,+ Plugin(..),+ Synchronous(..),+ CommandOptions(..),+ ) where++import Neovim.API.String+import Neovim.Classes+import Neovim.Context+import Neovim.Plugin.Classes+import Neovim.Plugin.IPC+import Neovim.Plugin.IPC.Internal+import Neovim.RPC.Common+import Neovim.RPC.FunctionCall++import Control.Arrow (first, (&&&))+import Control.Concurrent (ThreadId)+import Control.Concurrent.STM+import Control.Exception.Lifted (SomeException, try)+import Control.Monad (foldM, forM, void)+import qualified Control.Monad.Reader as R+import Data.ByteString (ByteString)+import Data.Foldable (forM_)+import qualified Data.Map as Map+import Data.MessagePack+import Data.Text (unpack)+import System.Log.Logger++logger :: String+logger = "Neovim.Plugin"++startPluginThreads :: ConfigWrapper r+ -> [IO NeovimPlugin]+ -> IO (Either String [(NeovimPlugin, [(ThreadId, [(FunctionalityDescription, FunctionType)])])])+startPluginThreads cfg = fmap (fmap fst) . runNeovim cfg () . foldM go []+ where+ go :: [(NeovimPlugin, [(ThreadId, [(FunctionalityDescription, FunctionType)])])]+ -> IO NeovimPlugin+ -> Neovim r () [(NeovimPlugin, [(ThreadId, [(FunctionalityDescription, FunctionType)])])]+ go pluginThreads iop = do+ NeovimPlugin p <- liftIO iop+ tids <- mapM registerStatefulFunctionality (statefulExports p)+ return $ (NeovimPlugin p, tids) : pluginThreads++register :: ConfigWrapper (TMVar FunctionMap)+ -> [(NeovimPlugin, [(ThreadId, [(FunctionalityDescription, FunctionType)])])]+ -> IO ()+register (cfg@ConfigWrapper{ customConfig = sem }) ps = void . runNeovim cfg () $ do+ registeredFunctions <- forM ps $ \(NeovimPlugin p, fs) -> do+ let statefulFunctionsToRegister = concatMap snd fs+ statelessFunctionsToRegister =+ map (getDescription &&& Stateless . getFunction) $ exports p+ functionsToRegister = statefulFunctionsToRegister ++ statelessFunctionsToRegister+ mapM_ (registerWithNeovim . fst) functionsToRegister+ return $ map (first name) functionsToRegister+ liftIO . atomically . putTMVar sem . Map.fromList $ concat registeredFunctions++registerWithNeovim :: FunctionalityDescription -> Neovim customConfig () ()+registerWithNeovim = \case+ Function functionName s -> do+ pName <- R.asks _providerName+ ret <- wait $ vim_call_function "remote#define#FunctionOnHost"+ [ toObject pName, toObject functionName, toObject s+ , toObject functionName, toObject (Map.empty :: Map.Map ByteString Object)+ ]+ case ret of+ Left e -> liftIO . errorM logger $+ "Failed to register function: " ++ unpack functionName ++ show e+ Right _ -> liftIO . debugM logger $+ "Registered function: " ++ unpack functionName+ Command functionName copts -> do+ pName <- R.asks _providerName+ ret <- wait $ vim_call_function "remote#define#CommandOnHost"+ [ toObject pName, toObject functionName, toObject (cmdSync copts)+ , toObject functionName, toObject copts+ ]+ case ret of+ Left e -> liftIO . errorM logger $+ "Failed to register command: " ++ unpack functionName ++ show e+ Right _ -> liftIO . debugM logger $+ "Registered command: " ++ unpack functionName+ Autocmd acmdType functionName opts -> do+ pName <- R.asks _providerName+ ret <- wait $ vim_call_function "remote#define#AutocmdOnHost"+ [ toObject pName, toObject functionName, toObject (acmdSync opts)+ , toObject acmdType , toObject opts+ ]+ case ret of+ Left e -> liftIO . errorM logger $+ "Failed to register autocmd: " ++ unpack functionName ++ show e+ Right _ -> liftIO . debugM logger $+ "Registered autocmd: " ++ unpack functionName++-- | Create a listening thread for events and add update the 'FunctionMap' with+-- the corresponding 'TQueue's (i.e. communication channels).+registerStatefulFunctionality+ :: (r, st, [ExportedFunctionality r st])+ -> Neovim customcConfig () (ThreadId, [(FunctionalityDescription, FunctionType)])+registerStatefulFunctionality (r, st, fs) = do+ q <- liftIO newTQueueIO+ tid <- forkNeovim r st (listeningThread q)+ return (tid, map (\n -> (getDescription n, Stateful q)) fs)+ where+ functionRoutes = foldr updateRoute Map.empty fs+ updateRoute = uncurry Map.insert . (name &&& getFunction)++ executeFunction+ :: ([Object] -> Neovim r st Object)+ -> [Object]+ -> Neovim r st (Either String Object)+ executeFunction f args = try (f args) >>= \case+ Left e -> let e' = e :: SomeException+ in return . Left $ show e'+ Right res -> return $ Right res+ listeningThread q = do+ msg <- liftIO . atomically $ readTQueue q+ forM_ (fromMessage msg) $ \req@Request{..} ->+ forM_ (Map.lookup reqMethod functionRoutes) $ \f ->+ respond req =<< executeFunction f reqArgs+ forM_ (fromMessage msg) $ \Notification{..} ->+ forM_ (Map.lookup notMethod functionRoutes) $ \f ->+ void $ executeFunction f notArgs+ listeningThread q+
+ library/Neovim/Plugin/Classes.hs view
@@ -0,0 +1,238 @@+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{- |+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 (+ ExportedFunctionality(..),+ getFunction,+ getDescription,+ FunctionalityDescription(..),+ FunctionName(..),+ NeovimPlugin(..),+ Plugin(..),+ wrapPlugin,+ Synchronous(..),+ CommandOptions(..),+ AutocmdOptions(..),+ ) where++import Neovim.Classes+import Neovim.Context++import Data.Default+import qualified Data.Map as Map+import Data.Maybe+import Data.MessagePack+import Data.Text (Text)++-- | This data type is used in the plugin registration to properly register the+-- functions.+newtype ExportedFunctionality r st+ = EF (FunctionalityDescription, [Object] -> Neovim r st Object)+++-- | Extract the description of an 'ExportedFunctionality'.+getDescription :: ExportedFunctionality r st -> FunctionalityDescription+getDescription (EF (d,_)) = d+++-- | Extract the function of an 'ExportedFunctionality'.+getFunction :: ExportedFunctionality r st -> [Object] -> Neovim r st Object+getFunction (EF (_, f)) = f+++-- | 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 Text 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 Text 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 Text Text 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.+ -- TODO Should this be enforced somehow? Possibly via the TH generator.+ --+ -- * Type of the autocmd (e.g. \"BufWritePost\")+ -- * Name for the function to call++ deriving (Show, Read, Eq, Ord)+++-- | 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. For comands it means that the GUI will (probably) not+ -- allow any user input until a reult is received. Functions run+ -- asynchronously inside neovim (or in one of its plugin providers) can use+ -- these functions concurrently.+ deriving (Show, Read, Eq, Ord, Enum)+++instance Default Synchronous where+ def = Sync++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 that can be optionally set for commands.+--+-- TODO Determine which of these make sense, how they are transmitted back and+-- which options are still missing.+-- (see remote#define#CommandOnHost in runtime\/autoload\/remote\/define.vim))+data CommandOptions = CommandOptions+ { cmdSync :: Synchronous+ -- ^ Option to indicate whether vim shuould block until the command has+ -- completed. (default: 'Sync')++ , cmdRange :: Maybe Text+ -- ^ Vim expression for the range (or count). (default: \"\")++ , cmdCount :: Bool+ -- ^ If true,++ , cmdNargs :: Int+ -- ^ Number of arguments. Note that all arguments have to be a string type.+ --+ -- TODO Check this in the Template Haskell functions.+ --+ -- If you're using the template haskell functions for registering commands,+ -- this field is overridden by it.++ , cmdBang :: Bool+ -- ^ Behavior changes when using a bang.+ }+ deriving (Show, Read, Eq, Ord)+++instance Default CommandOptions where+ def = CommandOptions+ { cmdSync = Sync+ , cmdRange = Nothing+ , cmdCount = False+ , cmdNargs = 0+ , cmdBang = False+ }+++instance NvimObject CommandOptions where+ toObject (CommandOptions{..}) =+ (toObject :: Dictionary -> Object) . Map.fromList . catMaybes $+ [ cmdRange >>= \r -> Just ("range", toObject r)+ , if cmdCount then Just ("count", toObject True) else Nothing+ , if cmdNargs > 0 then Just ("nargs", toObject cmdNargs) else Nothing+ , if cmdBang then Just ("bang", toObject True) else Nothing+ ]+ fromObject o = throwError $+ "Did not expect to receive a CommandOptions object: " ++ show o+++data AutocmdOptions = AutocmdOptions+ { acmdSync :: Synchronous+ -- ^ Option to indicate whether vim shuould block until the function has+ -- completed. (default: 'Sync')++ , acmdPattern :: Text+ -- ^ Pattern to match on. (default: \"*\")++ , acmdNested :: Bool+ -- ^ Nested autocmd. (default: False)+ --+ -- See @:h autocmd-nested@+ }+ deriving (Show, Read, Eq, Ord)+++instance Default AutocmdOptions where+ def = AutocmdOptions+ { acmdSync = Sync+ , acmdPattern = "*"+ , acmdNested = False+ }+++instance NvimObject AutocmdOptions where+ toObject (AutocmdOptions{..}) =+ (toObject :: Dictionary -> Object) . Map.fromList $+ [ ("pattern", toObject acmdPattern)+ , ("nested", toObject acmdNested)+ ]+ fromObject o = throwError $+ "Did not expect to receive an AutocmdOptions object: " ++ show o++-- | Conveniennce class to extract a name from some value.+class FunctionName a where+ name :: a -> Text+++instance FunctionName FunctionalityDescription where+ name = \case+ Function n _ -> n+ Command n _ -> n+ Autocmd _ n _ -> n+++instance FunctionName (ExportedFunctionality r st) where+ name = name . getDescription+++-- | This data type contains meta information for the plugin manager.+--+data Plugin r st = Plugin+ { exports :: [ExportedFunctionality () ()]+ , statefulExports :: [(r, st, [ExportedFunctionality r st])]+ }+++data NeovimPlugin = forall r st. NeovimPlugin (Plugin r st)+++-- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple+-- list.+wrapPlugin :: Monad m => Plugin r st -> m NeovimPlugin+wrapPlugin = return . NeovimPlugin+
+ library/Neovim/Plugin/ConfigHelper.hs view
@@ -0,0 +1,47 @@+{-# 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 Config.Dyre (Params)+import Config.Dyre.Paths (getPaths)+import Neovim.API.TH+import Neovim.Config+import Neovim.Plugin.Classes+import Neovim.Plugin.ConfigHelper.Internal+import Data.Text (pack)++-- | Note that you cannot really use this plugin by hand. It is automatically+-- loaded for all Neovim instances.+plugin :: Params NeovimConfig -> IO NeovimPlugin+plugin params = do+ (_, _, cfgFile, _, libsDir) <- getPaths params+ wrapPlugin Plugin+ { exports =+ [ $(function' 'pingNvimhs) Sync+ , $(command' 'restartNvimhs) def { cmdSync = Async }+ ]+ , statefulExports =+ [ (params, [],+ [ $(autocmd 'recompileNvimhs) "BufWritePost" def+ { acmdSync = Async+ , acmdPattern = pack cfgFile+ }+ , $(autocmd 'recompileNvimhs) "BufWritePost" def+ { acmdSync = Async+ , acmdPattern = pack (libsDir++"/.*")+ }+ ])+ ]+ }
+ library/Neovim/Plugin/ConfigHelper/Internal.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE LambdaCase #-}+{- |+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.Quickfix+import Neovim.RPC.FunctionCall++import Config.Dyre (Params)+import Config.Dyre.Compile+import Control.Applicative hiding (many, (<|>))+import Control.Monad (void)+import Data.Char+import Text.Parsec+import Text.Parsec.String++-- | Simple function that will return @"Pong"@ if the plugin provider is+-- running.+pingNvimhs :: Neovim' String+pingNvimhs = return "Pong"++-- | Recompile the plugin provider and put comile errors in the quickfix list.+recompileNvimhs :: Neovim (Params NeovimConfig) [QuickfixListItem String] ()+recompileNvimhs = do+ cfg <- ask+ mErrString <- liftIO (customCompile cfg >> getErrorString cfg)+ let qs = maybe [] parseQuickfixItems mErrString+ put qs+ setqflist qs Replace+ wait' $ vim_command "cwindow"++-- | Note that restarting the plugin provider implies compilation because Dyre+-- does this automatically. However, if the recompilation fails, the previously+-- compiled bynary is executed. This essentially means that restarting may take+-- more time then you might expect.+restartNvimhs :: Neovim r st ()+restartNvimhs = restart++-- 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 (many pQuickfixListItem) "Quickfix parser" s of+ Right qs -> qs+ Left _ -> []++pQuickfixListItem :: Parser (QuickfixListItem String)+pQuickfixListItem = do+ _ <- many blankLine+ (f,l,c) <- pLocation+ desc <- try pShortDesrciption <|> pLongDescription+ return $ (quickfixListItem (Right f) (Left l))+ { col = Just (c, True)+ , text = desc+ , errorType = "E" -- TODO determine actual type+ }++pShortDesrciption :: Parser String+pShortDesrciption = (:)+ <$> (many spaceChar *> notFollowedBy blankLine *> anyChar)+ <*> anyChar `manyTill` (void (many1 blankLine) <|> eof)++pLongDescription :: Parser String+pLongDescription = anyChar `manyTill` (blank <|> eof)+ where+ blank = try (try newline *> try blankLine)++spaceChar :: Parser Char+spaceChar = satisfy $ \c -> c == ' ' || c == '\t'++blankLine :: Parser ()+blankLine = void . try $ many spaceChar >> 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 :: Parser (String, Int, Int)+pLocation = (,,)+ <$> many1 (noneOf ":\n\t\r") <* char ':'+ <*> pInt <* char ':'+ <*> pInt <* char ':' <* many spaceChar++pInt :: Parser Int+pInt = read <$> many1 (satisfy isDigit)
+ library/Neovim/Plugin/IPC.hs view
@@ -0,0 +1,20 @@+{- |+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 view
@@ -0,0 +1,30 @@+{-# LANGUAGE ExistentialQuantification #-}+{- |+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+ where++import Data.Data (Typeable, cast)++-- | 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++class 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+
+ library/Neovim/Plugin/IPC/Internal.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DeriveDataTypeable #-}+{- |+Module : Neovim.Plugin.IPC.Internal+Description : Internally used parts of the inter plugin communication+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC++-}+module Neovim.Plugin.IPC.Internal+ ( RPCMessage(..)+ , Request(..)+ , Notification(..)++ , module Data.Int+ , module Data.Time+ ) where++import Control.Concurrent.STM+import Data.Data (Typeable)+import Data.Int (Int64)+import Data.MessagePack+import Data.Text (Text)+import Data.Time+import Neovim.Plugin.IPC.Classes++-- | Haskell representation of supported Remote Procedure Call messages.+data RPCMessage+ = FunctionCall Text [Object] (TMVar (Either Object Object)) UTCTime+ -- ^ Method name, parameters, callback, timestamp+ | Response !Int64 Object Object+ -- ^ Response sent to indicate the result of a function call.+ --+ -- * identfier of the message as 'Word32'+ -- * Error value+ -- * Result value+ | NotificationCall Text [Object]+ -- ^ Method name and parameters.+ deriving (Typeable)++instance Message RPCMessage++-- | 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 :: Text+ -- ^ 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 (Typeable)++instance Message Request++-- | 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 :: Text+ -- ^ Name of the function to call.+ , notArgs :: [Object]+ -- ^ Argumentse for the function.+ } deriving (Typeable)++instance Message Notification+
+ library/Neovim/Quickfix.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{- |+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 Neovim.RPC.FunctionCall++setqflist :: (Monoid strType, NvimObject strType)+ => [QuickfixListItem strType] -> QuickfixAction -> Neovim r st ()+setqflist qs a =+ void . wait' $ vim_call_function "setqflist" [toObject qs, toObject a]++-- | 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 :: Maybe (Int, Bool)+ -- ^ 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 :: strType+ -- ^ TODO replace with enum, but too lazy for now.+ } deriving (Eq, Show)++-- | 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 = Nothing+ , nr = Nothing+ , text = mempty+ , errorType = mempty+ }++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)+ ] ++ catMaybes+ [ (\n -> ("nr", toObject n)) <$> nr+ , (\(c,_) -> ("col", toObject c)) <$> col+ , (\(_,t) -> ("vcol", toObject t)) <$> col+ ]++ fromObject objectMap@(ObjectMap _) = do+ m <- fromObject objectMap+ let l :: NvimObject o => ByteString -> Either String o+ l key = case Map.lookup key m of+ Just o -> fromObject o+ Nothing -> Left "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 of search pattern inside quickfix list item."+ let l' :: NvimObject o => ByteString -> Either String (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 = do+ c' <- c+ v' <- v+ case c' of+ 0 -> Nothing+ _ -> Just (c',v')+ text <- fromMaybe mempty <$> l' "text"+ errorType <- fromMaybe mempty <$> l' "type"+ return QFItem{..}+ fromObject o = throwError $ "Could not deserialize QuickfixListItem, expected a map but received: " ++ show 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)++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/Common.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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.Text (Text)+import Data.Time+import Neovim.Plugin.IPC+import Network.Socket as N hiding (SocketType)+import System.Environment (getEnv)+import System.IO (BufferMode (..), Handle, IOMode,+ hClose, hSetBuffering)+import System.Log.Logger++import Prelude++-- | 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 Text FunctionType++data FunctionType+ = Stateless ([Object] -> Neovim' Object)+ | Stateful (TQueue SomeMessage)++-- | 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.+ , functions :: TMVar FunctionMap+ -- ^ A map that contains the function names which are registered to this+ -- plugin manager. Putting the map in a 'TMVar' ensures that all+ -- functionality is registered properly before answering to requests send+ -- by neovim.+ }++-- | 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 newEmptyTMVarIO++-- | 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)+ => IOMode+ -> SocketType+ -> io Handle+createHandle ioMode socketType = case socketType of+ Stdout h -> do+ liftIO $ hSetBuffering h (BlockBuffering Nothing)+ return h+ UnixSocket f -> createHandle ioMode . Stdout+ =<< createUnixSocketHandle f+ TCP p h -> createHandle ioMode . Stdout+ =<< createTCPSocketHandle p h+ Environment -> createHandle ioMode . Stdout+ =<< createSocketHandleFromEnvironment++ where+ createUnixSocketHandle :: (MonadIO io) => FilePath -> io Handle+ createUnixSocketHandle f =+ liftIO $ getSocketUnix f >>= flip socketToHandle ioMode++ createTCPSocketHandle :: (Functor io, MonadIO io) => Int -> String -> io Handle+ createTCPSocketHandle p h = liftIO $ getSocketTCP (fromString h) p+ >>= flip socketToHandle ioMode . fst++ createSocketHandleFromEnvironment = do+ listenAddress <- liftIO (getEnv "NVIM_LISTEN_ADDRESS")+ case words listenAddress of+ [unixSocket] -> createHandle ioMode (UnixSocket unixSocket)+ [h,p] -> createHandle ioMode (TCP (read p) h)+ _ -> do+ let errMsg = unlines+ [ "Unhandled socket type from environment variable: "+ , "\t" <> listenAddress+ ]+ liftIO $ errorM "createHandle" errMsg+ error errMsg+++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 view
@@ -0,0 +1,97 @@+{-# 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+import Neovim.Context hiding (ask, asks)+import Neovim.Plugin.IPC+import Neovim.Plugin.IPC.Internal+import Neovim.RPC.Common+import Neovim.RPC.FunctionCall++import Control.Applicative+import Control.Concurrent.STM hiding (writeTQueue)+import Control.Monad.Reader+import Control.Monad.State.Strict+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import Data.Conduit as C+import Data.Conduit.Binary (sinkHandle)+import qualified Data.Map as Map+import Data.MessagePack+import Data.Serialize (encode)+import System.IO (IOMode (WriteMode))++import Prelude++-- | This function will establish a connection to the given socket and write+-- msgpack-rpc requests to it.+runEventHandler :: SocketType+ -> ConfigWrapper RPCConfig+ -> IO ()+runEventHandler socketType env =+ runEventHandlerContext env $ do+ h <- createHandle WriteMode socketType+ eventHandlerSource+ $= eventHandler+ $$ addCleanup (cleanUpHandle h) (sinkHandle h)++-- | Convenient monad transformer stack for the event handler+newtype EventHandler a =+ EventHandler (ResourceT (ReaderT (ConfigWrapper RPCConfig) (StateT Int64 IO)) a)+ deriving ( Functor, Applicative, Monad, MonadState Int64, MonadIO+ , MonadReader (ConfigWrapper RPCConfig))++runEventHandlerContext :: ConfigWrapper RPCConfig -> EventHandler a -> IO a+runEventHandlerContext env (EventHandler a) =+ evalStateT (runReaderT (runResourceT a) env) 1++eventHandlerSource :: Source EventHandler SomeMessage+eventHandlerSource = asks _eventQueue >>= \q ->+ forever $ yield =<< atomically' (readTQueue q)++eventHandler :: ConduitM SomeMessage ByteString EventHandler ()+eventHandler = await >>= \case+ Nothing -> return () -- i.e. close the conduit -- TODO signal shutdown globally+ Just message -> handleMessage (fromMessage message) >> eventHandler++handleMessage :: Maybe RPCMessage -> ConduitM i ByteString EventHandler ()+handleMessage = \case+ Just (FunctionCall fn params reply time) -> do+ i <- get+ modify succ+ rs <- asks (recipients . customConfig)+ atomically' . modifyTVar rs $ Map.insert i (time, reply)+ yield . encode $ ObjectArray+ [ toObject (0 :: Int64)+ , ObjectInt i+ , toObject fn+ , toObject params+ ]+ Just (Response i e res) ->+ yield . encode $ ObjectArray+ [ toObject (1 :: Int64)+ , ObjectInt i+ , toObject e+ , toObject res+ ]+ Just (NotificationCall fn params) ->+ yield . encode $ ObjectArray+ [ ObjectInt 2+ , toObject fn+ , toObject params+ ]+ Nothing -> return () -- i.e. skip to next message+
+ library/Neovim/RPC/FunctionCall.hs view
@@ -0,0 +1,137 @@+{-# 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,+ acall',+ scall,+ scall',+ atomically',+ wait,+ wait',+ waitErr,+ waitErr',+ respond,+ ) where++import Neovim.Classes+import Neovim.Context+import Neovim.Plugin.IPC+import Neovim.Plugin.IPC.Internal++import Control.Applicative+import Control.Concurrent.STM+import Control.Monad.Reader as R+import Data.MessagePack+import Data.Monoid+import Data.Text++unexpectedException :: String -> err -> a+unexpectedException fn _ = error $+ "Function threw an exception even though it was declared not to throw one: "+ <> fn+++withIgnoredException :: (Functor f, NvimObject result)+ => Text -- ^ Function name for better error messages+ -> f (Either err result)+ -> f result+withIgnoredException fn = fmap (either ((unexpectedException . unpack) 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)+ => Text+ -> [Object]+ -> Neovim r st (STM (Either Object result))+acall fn parameters = do+ q <- eventQueue+ mv <- liftIO newEmptyTMVarIO+ timestamp <- liftIO getCurrentTime+ atomically' . writeTQueue q . SomeMessage $ FunctionCall fn parameters mv timestamp+ return $ convertObject <$> readTMVar mv+ where+ convertObject = \case+ Left e -> Left e+ Right o -> case fromObject o of+ Left e -> Left (toObject e)+ Right r -> Right r+++acall' :: (NvimObject result)+ => Text+ -> [Object]+ -> Neovim r st (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)+ => Text -- ^ Function name+ -> [Object] -- ^ Parameters in an 'Object' array+ -> Neovim r st (Either Object result)+ -- ^ result value of the call or the thrown exception+scall fn parameters = acall fn parameters >>= atomically'+++scall' :: NvimObject result => Text -> [Object] -> Neovim r st 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 r st (STM result) -> Neovim r st result+wait = (=<<) atomically'+++-- | Variant of 'wait' that discards the result.+wait' :: Neovim r st (STM result) -> Neovim r st ()+wait' = void . wait+++-- | Wait for the result of the 'STM' action and call @'err' . (loc++) . show@+-- if the action returned an error.+waitErr :: (Show e)+ => String -- ^ Prefix error message with this.+ -> Neovim r st (STM (Either e result)) -- ^ Function call to neovim+ -> Neovim r st result+waitErr loc act = wait act >>= either (err . (loc++) . show) return+++-- | 'waitErr' that discards the result.+waitErr' :: (Show e)+ => String+ -> Neovim r st (STM (Either e result))+ -> Neovim r st ()+waitErr' loc = void . waitErr loc+++-- | Send the result back to the neovim instance.+respond :: (NvimObject result) => Request -> Either String result -> Neovim r st ()+respond Request{..} result = do+ q <- eventQueue+ atomically' . writeTQueue q . SomeMessage $ uncurry (Response reqId) oResult++ where+ oResult = case result of+ Left e -> (toObject e, toObject ())+ Right r -> (toObject (), toObject r)+
+ library/Neovim/RPC/SocketReader.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# 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,+ ) where++import Neovim.Classes+import Neovim.Context hiding (ask, asks)+import Neovim.Plugin.IPC+import Neovim.Plugin.IPC.Internal+import Neovim.RPC.Common+import Neovim.RPC.FunctionCall++import Control.Applicative+import Control.Concurrent (forkIO)+import Control.Concurrent.STM+import Control.Monad (void)+import Control.Monad.Reader (MonadReader, ask, asks)+import Control.Monad.Trans.Resource+import Data.Conduit as C+import Data.Conduit.Binary+import Data.Conduit.Cereal+import Data.Foldable (forM_)+import qualified Data.Map as Map+import Data.MessagePack+import Data.Monoid+import qualified Data.Serialize (get)+import Data.Text (Text, unpack)+import System.IO (IOMode (ReadMode))+import System.Log.Logger++import Prelude++logger :: String+logger = "Socket Reader"++-- | This function will establish a connection to the given socket and read+-- msgpack-rpc events from it.+runSocketReader :: SocketType -> ConfigWrapper RPCConfig -> IO ()+runSocketReader socketType env = do+ h <- createHandle ReadMode socketType+ runSocketHandler env $+ -- addCleanup (cleanUpHandle h) (sourceHandle h)+ -- TODO test whether/how this should be handled+ -- this has been commented out because I think that restarting the+ -- plugin provider should not cause the stdin and stdout handles to be+ -- closed since that would cause neovim to stop the plugin provider (I+ -- think).+ sourceHandle h+ $= conduitGet Data.Serialize.get+ $$ messageHandlerSink++-- | Convenient transformer stack for the socket reader.+newtype SocketHandler a =+ SocketHandler (ResourceT (Neovim RPCConfig ()) a)+ deriving ( Functor, Applicative, Monad , MonadIO+ , MonadReader (ConfigWrapper RPCConfig), MonadThrow)++runSocketHandler :: ConfigWrapper RPCConfig -> SocketHandler a -> IO ()+runSocketHandler r (SocketHandler a) =+ void $ runNeovim r () (runResourceT a >> quit)++-- | Sink that delegates the messages depending on their type.+-- <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>+messageHandlerSink :: Sink Object SocketHandler ()+messageHandlerSink = awaitForever $ \rpc -> do+ liftIO . debugM logger $ "Received: " <> show rpc+ case rpc of+ ObjectArray [ObjectInt msgType, ObjectInt fi, e, result] ->+ handleResponseOrRequest msgType fi e result+ ObjectArray [ObjectInt msgType, method, params] ->+ handleNotification msgType method params+ obj -> liftIO . errorM logger $+ "Unhandled rpc message: " <> show obj++handleResponseOrRequest :: Int64 -> Int64 -> Object -> Object+ -> Sink a SocketHandler ()+handleResponseOrRequest msgType i+ | msgType == 1 = handleResponse i+ | msgType == 0 = handleRequestOrNotification (Just i)+ | otherwise = \_ _ -> do+ liftIO . errorM logger $ "Invalid message type: " <> show msgType+ return ()++handleResponse :: Int64 -> Object -> Object -> Sink a SocketHandler ()+handleResponse i e result = do+ answerMap <- asks (recipients . customConfig)+ 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 $ case e of+ ObjectNil -> Right result+ _ -> Left e++-- | 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 -> Object -> Object -> Sink a SocketHandler ()+handleRequestOrNotification mi method (ObjectArray params) = case fromObject method of+ Left e -> liftIO . errorM logger $ show e+ -- Fork everything so that we do not block.+ --+ -- XXX If the functions never return, we may end up with a lot of idle+ -- threads. Maybe we should gather the ThreadIds and kill them after some+ -- amount of time if they are still around. Maybe resourcet provides such a+ -- facility for threads already.+ Right m -> void . liftIO . forkIO . handle m =<< ask++ where+ lookupFunction :: Text -> RPCConfig -> STM (Maybe FunctionType)+ lookupFunction m rpc = Map.lookup m <$> readTMVar (functions rpc)++ handle m rpc = atomically (lookupFunction m (customConfig rpc)) >>= \case+ Nothing -> do+ let errM = "No provider for: " <> unpack m+ debugM logger errM+ forM_ mi $ \i -> atomically' . writeTQueue (_eventQueue rpc)+ . SomeMessage $ Response i (toObject errM) ObjectNil+ Just (Stateless f) -> do+ liftIO . debugM logger $ "Executing stateless function with ID: " <> show mi+ -- Stateless function: Create a boring state object for the+ -- Neovim context.+ -- drop the state of the result with (fmap fst <$>)+ res <- fmap fst <$> runNeovim (rpc { customConfig = () }) () (f $ parseParams params)+ -- Send the result to the event handler+ forM_ mi $ \i -> atomically' . writeTQueue (_eventQueue rpc)+ . SomeMessage . uncurry (Response i) $ responseResult res+ Just (Stateful c) -> do+ now <- liftIO getCurrentTime+ reply <- liftIO newEmptyTMVarIO+ let q = (recipients . customConfig) rpc+ liftIO . debugM logger $ "Executing stateful function with ID: " <> show mi+ case mi of+ Just i -> do+ atomically' . modifyTVar q $ Map.insert i (now, reply)+ atomically' . writeTQueue c . SomeMessage $ Request m i (parseParams params)+ Nothing ->+ atomically' . writeTQueue c . SomeMessage $ Notification m (parseParams params)+ responseResult (Left !e) = (toObject e, ObjectNil)+ responseResult (Right !res) = (ObjectNil, toObject res)++handleRequestOrNotification _ _ params = liftIO . errorM logger $+ "Parmaeters in request are not in an object array: " <> show params++-- TODO implement proper handling for additional parameters+parseParams :: [Object] -> [Object]+parseParams = \case+ -- 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 -> args+++handleNotification :: Int64 -> Object -> Object -> Sink a SocketHandler ()+handleNotification 2 method params = do+ liftIO . debugM logger $ "Received notification: " <> show method <> show params+ handleRequestOrNotification Nothing method params+handleNotification msgType fn params = liftIO . errorM logger $+ "Message is not a noticiation. Received msgType: " <> show msgType+ <> " The expected value was 2. The following arguments were given: "+ <> show fn <> " and " <> show params++
+ nvim-hs.cabal view
@@ -0,0 +1,148 @@+name: nvim-hs+version: 0.0.1+synopsis: Haskell plugin backend for neovim+description:+ This package provides a plugin provider for neovim. It allows you to write+ plugins for one of the great editors of our time in the best programming+ language of our time! ;-)+ .+ You should find all the documentation you need inside the "Neovim" module. All+ other modules are considered internal, so don't be annoyed if using things+ from there may break your code.+ .+ If you spot any errors or if you have great ideas, feel free to open an issue+ on github.+homepage: https://github.com/saep/nvim-hs+license: Apache-2.0+license-file: LICENSE+author: Sebastian Witte+maintainer: woozletoff@gmail.com+copyright: Copyright (C) Sebastian Witte+category: Editor+build-type: Simple+cabal-version: >=1.10+extra-source-files: TestPlugins.vim+ , TestPlugins.hs+ , nvim-hs.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/hello+source-repository head+ type: git+ location: https://github.com/saep/nvim-hs++executable nvim-hs+ main-is: Main.hs+ hs-source-dirs: executable+ default-language: Haskell2010+ build-depends: base ==4.*, nvim-hs, data-default+ ghc-options: -threaded -rtsopts -with-rtsopts=-N++library+ exposed-modules: Neovim+ -- Note that every module below this is considered internal and if you have to+ -- import it somewhere in your code and you think it should be generally+ -- available , you should open a ticket about inclusion in the export list of+ -- 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.Classes+ , Neovim.Context+ , Neovim.Plugin+ , Neovim.Plugin.Classes+ , Neovim.Plugin.IPC+ , Neovim.Plugin.IPC.Internal+ , Neovim.Plugin.IPC.Classes+ , Neovim.Config+ , Neovim.Debug+ , Neovim.Main+ , Neovim.RPC.Common+ , Neovim.RPC.EventHandler+ , Neovim.RPC.FunctionCall+ , Neovim.RPC.SocketReader+ , Neovim.Plugin.ConfigHelper+ , Neovim.Quickfix++ other-modules: Neovim.Plugin.ConfigHelper.Internal+ , Neovim.API.Parser+ , Neovim.API.TH+ -- other-extensions:+ build-depends: base ==4.*+ , bytestring+ , cereal+ , cereal-conduit+ , conduit+ , conduit-extra+ , containers+ , data-default+ , directory+ , dyre+ , filepath+ , hslogger+ , messagepack >= 0.4+ , monad-control+ , network+ , lifted-base+ , mtl >= 2.2.1 && < 2.3+ , optparse-applicative+ , parsec ==3.*+ , process+ , resourcet+ , stm+ , streaming-commons+ , template-haskell+ , text+ , time+ , transformers+ , transformers-base+ , utf8-string+ hs-source-dirs: library+ default-language: Haskell2010+ ghc-options: -Wall+++test-suite hspec+ type: exitcode-stdio-1.0+ hs-source-dirs: test-suite, library+ main-is: Spec.hs+ default-language: Haskell2010+ build-depends: base+ , nvim-hs++ , hspec ==2.*+ , hspec-discover+ , QuickCheck >=2.6++ , bytestring+ , cereal+ , cereal-conduit+ , conduit+ , conduit-extra+ , containers+ , data-default+ , directory+ , dyre+ , filepath+ , hslogger+ , lifted-base+ , mtl >= 2.2.1 && < 2.3+ , messagepack >= 0.4+ , network+ , optparse-applicative+ , parsec+ , process+ , resourcet+ , stm+ , streaming-commons+ , text+ , template-haskell+ , time+ , transformers+ , utf8-string+ , HUnit++ ghc-options: -threaded -rtsopts -with-rtsopts=-N+
+ nvim-hs.sh view
@@ -0,0 +1,24 @@+#!/bin/sh++# Shell script that starts a plugin provider which is interpreted from the+# TestPlugins.hs file inside this repository.++if ! type cabal > /dev/null 2>&1 ; then+ echo "cabal not installed or on PATH"+ echo $PATH+ exit 1+fi++if ! type runghc > /dev/null 2>&1 ; then+ echo "runghc not installed or on PATH"+ echo $PATH+ exit 1+fi++if [ -d ".cabal-sandbox/" ] ; then+ # Use `cabal exec` if we are in a sandbox+ exec cabal exec runghc TestPlugins.hs -- $1 -l test-log.txt -v DEBUG+else+ exec runghc TestPlugins.hs -- $1 -l test-log.txt -v DEBUG+fi+
+ test-files/compile-error-for-quickfix-test1 view
@@ -0,0 +1,7 @@++/.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)
+ test-files/compile-error-for-quickfix-test2 view
@@ -0,0 +1,3 @@++/.config/nvim/lib/TestPlugins.hs:11:18:+ Not in scope: `vim_function'
+ test-files/compile-error-for-quickfix-test3 view
@@ -0,0 +1,2 @@++/.config/nvim/nvim.hs:25:30: Not in scope: `mySin'
+ test-files/compile-error-for-quickfix-test4 view
@@ -0,0 +1,4 @@++/.config/nvim/lib/TestPlugins.hs:23:9:+ Not in scope: ‘vim_call_dict_function’+ Perhaps you meant ‘vim_call_function’ (imported from Neovim)
+ test-files/compile-error-for-quickfix-test5 view
@@ -0,0 +1,22 @@++/.config/nvim/lib/TestPlugins.hs:23:9:+ 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:+ 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"]
+ test-files/hello view
@@ -0,0 +1,1 @@+Hello, World!
+ test-suite/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}