├── .github └── workflows │ └── ci.yml ├── .gitignore ├── CHANGELOG.md ├── HLint.hs ├── LICENSE ├── README.md ├── RELEASE.md ├── Setup.hs ├── api ├── apiblobs ├── 0.1.7.msgpack ├── 0.10.4.msgpack ├── 0.11.0-nightly.msgpack ├── 0.2.0.msgpack ├── 0.3.0.msgpack ├── 0.4.3.msgpack ├── 0.5.0.msgpack ├── 0.6.1.msgpack ├── 0.8.0.msgpack └── README.md ├── example ├── lib │ ├── Fibonacci.hs │ ├── Fibonacci │ │ └── Plugin.hs │ ├── Random.hs │ └── Random │ │ └── Plugin.hs └── nvim.hs ├── flake.lock ├── flake.nix ├── fourmolu.yaml ├── nvim-hs.cabal ├── src ├── Neovim.hs └── Neovim │ ├── API │ ├── ByteString.hs │ ├── Parser.hs │ ├── String.hs │ ├── TH.hs │ └── Text.hs │ ├── Classes.hs │ ├── Compat │ └── Megaparsec.hs │ ├── Config.hs │ ├── Context.hs │ ├── Context │ └── Internal.hs │ ├── Debug.hs │ ├── Exceptions.hs │ ├── Log.hs │ ├── Main.hs │ ├── Plugin.hs │ ├── Plugin │ ├── Classes.hs │ ├── IPC.hs │ ├── IPC │ │ └── Classes.hs │ └── Internal.hs │ ├── Quickfix.hs │ ├── RPC │ ├── Classes.hs │ ├── Common.hs │ ├── EventHandler.hs │ ├── FunctionCall.hs │ └── SocketReader.hs │ ├── Test.hs │ └── Util.hs ├── srcos ├── unix │ └── Neovim │ │ └── OS.hs └── windows │ └── Neovim │ └── OS.hs ├── stack-ghc-9.4.yaml ├── stack-ghc-9.6.yaml ├── stack-ghc-9.8.yaml ├── stack-template.hsfiles ├── stack.yaml ├── test-files └── hello └── tests ├── API ├── THSpec.hs └── THSpecFunctions.hs ├── AsyncFunctionSpec.hs ├── EmbeddedRPCSpec.hs ├── EventSubscriptionSpec.hs ├── Plugin └── ClassesSpec.hs ├── RPC ├── CommonSpec.hs └── SocketReaderSpec.hs └── Spec.hs /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | on: 3 | pull_request: 4 | push: 5 | branches: 6 | - main 7 | workflow_call: 8 | outputs: 9 | version: 10 | value: ${{ jobs.build_prod.outputs.version }} 11 | 12 | jobs: 13 | stack_test: 14 | strategy: 15 | matrix: 16 | stack_yaml: 17 | - stack-ghc-9.6.yaml 18 | - stack-ghc-9.8.yaml 19 | # technically redundant, since this should be a symlink, 20 | # but just to be extra sure 21 | - stack.yaml 22 | 23 | name: 'stack_test: ${{ matrix.stack_yaml }}' 24 | runs-on: ubuntu-22.04 25 | env: 26 | STACK_YAML: ${{ matrix.stack_yaml }} 27 | 28 | steps: 29 | - uses: actions/checkout@v4.2.2 30 | - uses: actions/cache@v4.2.3 31 | with: 32 | path: ~/.stack 33 | key: ${{ runner.os }}-stack_test-${{ matrix.stack_yaml }}-${{ hashFiles(matrix.stack_yaml, 'nvim-hs.cabal') }} 34 | 35 | - run: stack test --test-arguments="--format=checks" 36 | 37 | - name: Check that Cabal file was generated 38 | run: git diff --exit-code '*.cabal' 39 | 40 | cabal_test: 41 | strategy: 42 | matrix: 43 | ghc_version: 44 | - '9.6' 45 | - '9.8' 46 | - '9.10' 47 | 48 | name: 'cabal_test: ghc-${{ matrix.ghc_version }}' 49 | runs-on: ubuntu-latest 50 | steps: 51 | - uses: actions/checkout@v4.2.2 52 | - uses: ConorMacBride/install-package@v1.1.0 53 | with: 54 | apt: neovim # for api generation 55 | - uses: haskell/actions/setup@v2 56 | with: 57 | ghc-version: ${{ matrix.ghc_version }} 58 | - run: cabal update 59 | - run: cabal freeze 60 | - run: echo "CURR_MONTH=$(date +%B)" | tee -a "$GITHUB_ENV" 61 | - uses: actions/cache@v4.2.3 62 | with: 63 | path: ~/.cabal/store 64 | key: ${{ runner.os }}-cabal-cache-${{ env.CURR_MONTH }}-${{ matrix.ghc_version }}-${{ hashFiles('cabal.project.freeze') }} 65 | restore-keys: | 66 | ${{ runner.os }}-cabal-cache-${{ env.CURR_MONTH }}-${{ matrix.ghc_version }}- 67 | - run: cabal install --overwrite-policy=always hspec-discover 68 | - run: cabal test --test-show-details=streaming --test-options="--format=checks" 69 | 70 | build_haddock: 71 | runs-on: ubuntu-latest 72 | steps: 73 | - uses: actions/checkout@v4.2.2 74 | - uses: actions/cache@v4.2.3 75 | with: 76 | path: ~/.stack 77 | key: ${{ runner.os }}-build_haddock-${{ hashFiles('stack.yaml', 'nvim-hs.cabal') }} 78 | 79 | - name: Build haddock 80 | # just a sanity check, so no need to build third-party docs 81 | run: stack haddock --fast --no-haddock-deps 82 | 83 | - name: Bundle haddock docs 84 | run: tar czf nvim-hs-docs.tar.gz -C "$(find .stack-work/dist -regex '.*/doc/html/[^/]*')" . 85 | 86 | - uses: actions/upload-artifact@v4.6.2 87 | with: 88 | name: nvim-hs-docs 89 | path: nvim-hs-docs.tar.gz 90 | 91 | check_sdist: 92 | runs-on: ubuntu-latest 93 | steps: 94 | - uses: actions/checkout@v4.2.2 95 | - uses: actions/cache@v4.2.3 96 | with: 97 | path: ~/.stack 98 | key: ${{ runner.os }}-check_sdist-${{ hashFiles('stack.yaml') }} 99 | - name: Create sdist bundle 100 | run: stack sdist --test-tarball --tar-dir . 101 | - uses: actions/upload-artifact@v4.6.2 102 | with: 103 | name: nvim-hs-sdist 104 | path: nvim-hs-*.tar.gz 105 | 106 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virtualenv 8 | .hsenv 9 | .cabal-sandbox/ 10 | cabal.sandbox.config 11 | cabal.config 12 | /.stack-work/ 13 | .direnv/ 14 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 2.3.1.0 2 | 3 | * Add `subscribe` and `unsubscribe` function. Neovim doesn't automatically send 4 | event notifications to nvim-hs (or any other remote plugin) and for the 5 | callback of the `subscribe` funtion to trigger, you have to call a specific 6 | function before (e.g. `nvim_buf_attach`). In any case, if you want to subscribe 7 | to a specific event, you have to read the documentation of the neovim 8 | documentation. Some events are still better handled with autocommands. 9 | 10 | # 2.3.0.0 11 | 12 | * Windows is now rudimentarily supported. Since I couldn't find a library to 13 | connect to named pipes on windows and I didn't want to extend or write one, 14 | you have to use TCP sockets or Standard in and out to communicate with 15 | neovim. If you start neovim with `nvim --listen localhost:`, it will set the 16 | `NVIM` environment variable, so that nvim-hs can automatically connect to the 17 | neovim instance without passing any arguments. 18 | 19 | # 2.2.0.0 20 | 21 | * NeovimException are now thrown from (synchronous) remote functions and are no 22 | longer suppressed with an `error` call that also had a terrible error message. 23 | A function `catchNeovimException` (specialized `catch`) has been added that 24 | catches these errors. 25 | * The return type of asynchronous functions is now alwas 26 | `STM (Either NeovimException result)` and errors have to be handled by the 27 | caller explicitly. 28 | 29 | # 2.1.0.2 30 | 31 | * Exported functions and commands now can have the same name. 32 | 33 | # 2.1.0.0 34 | 35 | * Autocommands now take an additional parameter of type `Synchronous`, allowing 36 | them to execute synchronous (previously hardcoded as `Async`). 37 | In order to adapt to this, change ` $(autocmd 'handler) opts` to 38 | `$(autocmd 'handler) Async opts`. 39 | 40 | # 2.0.0.0 41 | 42 | * Your configuration is now just a Haskell project. The dependency to Dyre has 43 | been removed and you are now forced to write a line of vimL and add a normal 44 | nvim-plugin to your setup. The template still does set everything up for you. 45 | The distinction between a plugin and a personal nvim-hs configuration is now 46 | gone and apart from settings things up, nothing has changed in this regard. 47 | The nvim-plugin contains the necessary documentation on what to do and 48 | should be available with `:help nvim-hs` when installed correctly. 49 | 50 | * Since basically all generated functions were throwing exceptions anyway, the 51 | primed functions have become the default and if you want to explicitly handle 52 | error cases, you have to surround your code with `catch` or something more 53 | appropriate from `UnliftIO.Exception`. You have to remove `'` from your API 54 | calls or you have to adjust your error handling. 55 | 56 | * There are now three flavors of APIs and you have to import one additionally to 57 | importing the `Neovim` module: 58 | 59 | - *Neovim.API.Text*: This uses strict `Text` for strings and `Vector` as 60 | lists. This is the recommended API to use. 61 | 62 | - *Neovim.API.String*: This is the same as before. Strings are `String` 63 | and lists are `[]`. This is for the lazy and backwards-ish compatiblity. 64 | 65 | - *Neovim.API.ByteString*: This can be useful for really performance critical 66 | stuff or if you`re writing a plugin for binary files. 67 | 68 | # 1.0.1.0 69 | 70 | * The `Neovim.Debug` module is now more pleasant to use. 71 | 72 | # 1.0.0.2 73 | 74 | * With the api of neovim 0.3.0, a function was exposed that had a reserved 75 | haskell keyword as a parameter name. The code generation did not sanitize 76 | this. This bugfix releases resolves this. 77 | 78 | # 1.0.0.0 79 | 80 | * Each plugin (type) now defines an environment which is similar to how 81 | stateful plugins have been declared in previous versions. If you need 82 | multiple different environments for different functions, you can make them 83 | fields of a bigger environment or define multiple plugin values. 84 | 85 | The type `Neovim r st a` has become `Neovim env a` where `env` is 86 | technically equivalent to the previous `r`. 87 | I was mainly motivated by this blog post: 88 | 89 | https://www.fpcomplete.com/blog/2017/06/readert-design-pattern 90 | 91 | * Only works with ghc >= 8. I removed some backwards compatibility. If you 92 | need older ghc versions, just use the previous version (0.2.5) as the 93 | feature set hasn't really changed. 94 | 95 | * A different pretty printer library is now used and may surface at some 96 | places. 97 | 98 | * Functions do now time out after some time, 10 seconds for those that block 99 | neovim and 10 minutes for background functions. 100 | 101 | * A few types have been adjusted. 102 | 103 | * Some improvement in error reporting. 104 | 105 | # 0.2.5 106 | 107 | * Older versions of `nvim-hs` may not function if some versions of a 108 | dependency are used. This version has proper bounds for the dependency and 109 | should cause a compile time failure if an incompatible version of the 110 | dependency is used (see #61). 111 | 112 | # 0.2.0 113 | 114 | * Replace error code of remote functions to return 115 | `Either NeovimException a` instead of a generic messagepack `Object` 116 | 117 | * Export API functions that throw a `NeovimException` instead of returning 118 | `Either NeovimExeception a`. 119 | 120 | * Replace three element tuple for stateful function declaration (#53) 121 | 122 | * Add a stack template for easier setup 123 | 124 | * Exceptions from pure code are now caught (#48) 125 | 126 | # 0.1.0 127 | 128 | * Adjust parser for output of `nvim --api-info` 129 | 130 | * Adjust parser of ConfigHelper plugin 131 | 132 | # 0.0.7 133 | 134 | * Adjust handling of string sent by neovim in API generation. 135 | 136 | # 0.0.6 137 | 138 | * Noteworthy new API functions for the user's convenience: 139 | 140 | - `errOnInvalidResult` 141 | - `(:+)` 142 | 143 | * ansi-wl-pprint is used for pretty printing of various things now. Most 144 | notably, the error type has been changed from `String` to `Doc`. 145 | This is a breaking change, but it was kind of announced in the issues 146 | list. In any case, uses of `err` can be fixed by enabling the 147 | `OverloadedStrings` extension. Other breakages have to be fixed by hand. 148 | 149 | # 0.0.5 150 | 151 | * Documentation received some love. 152 | 153 | * A few renames of repurposed internals. 154 | 155 | # 0.0.3 156 | 157 | * Debugging facilities for ghci have been added. Check out the 158 | `Neovim.Debug` module! These few functions are very valuable to debug your 159 | code or even the code of nvim-hs itself. 160 | 161 | * Startup code now has a special `Neovim` environment which has access to 162 | some of the internals that may or may not be useful. This change allowed 163 | the ConfigHelper plugin to be included as a normal, separable plugin. 164 | Unfortunately, this potentially breaks the plugin startup code of some 165 | existing plugins. 166 | 167 | * Neovim context is no longer a type synonym, but a newtype wrapper around 168 | the previous type synonym with an added `ResourceT` wrapper. The functions 169 | from `MonadReader` are now actually exported as those. 170 | 171 | As a consequence, some of your code may break if you lack some specific 172 | instances which were auto-derived before. Send a PR or open a ticket to 173 | resolve this. 174 | 175 | * Add handling for some kind of variadic arguments handling. 176 | 177 | A command or function will be passed `Nothing` as it's 178 | last arguments if the argument type is wrapped in `Maybe` 179 | and the invocation on the side of neovim did not pass those 180 | arguments. 181 | 182 | # 0.0.2 183 | 184 | * Add handling for special command options 185 | 186 | This breaks code that used `command` or `command'` to export 187 | functionality. You should replace the options with a list 188 | of `CommandOptions`. 189 | 190 | An export like `$(command' foo) def { cmdSync = Async }` must be redefined 191 | to `$(command' foo) [CmdSync Async]`. 192 | 193 | # 0.0.1 194 | 195 | * Usable prototype implementation 196 | -------------------------------------------------------------------------------- /HLint.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE PackageImports #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | 4 | import "hint" HLint.Default 5 | import "hint" HLint.Dollar 6 | 7 | ignore "Use import/export shortcut" 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2015 Sebastian Witte 2 | 3 | Licensed under the Apache License, Version 2.0 (the "License"); 4 | you may not use this file except in compliance with the License. 5 | You may obtain a copy of the License at 6 | 7 | http://www.apache.org/licenses/LICENSE-2.0 8 | 9 | Unless required by applicable law or agreed to in writing, software 10 | distributed under the License is distributed on an "AS IS" BASIS, 11 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 12 | See the License for the specific language governing permissions and 13 | limitations under the License. 14 | 15 | 16 | Apache License 17 | Version 2.0, January 2004 18 | http://www.apache.org/licenses/ 19 | 20 | TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION 21 | 22 | 1. Definitions. 23 | 24 | "License" shall mean the terms and conditions for use, reproduction, 25 | and distribution as defined by Sections 1 through 9 of this document. 26 | 27 | "Licensor" shall mean the copyright owner or entity authorized by 28 | the copyright owner that is granting the License. 29 | 30 | "Legal Entity" shall mean the union of the acting entity and all 31 | other entities that control, are controlled by, or are under common 32 | control with that entity. For the purposes of this definition, 33 | "control" means (i) the power, direct or indirect, to cause the 34 | direction or management of such entity, whether by contract or 35 | otherwise, or (ii) ownership of fifty percent (50%) or more of the 36 | outstanding shares, or (iii) beneficial ownership of such entity. 37 | 38 | "You" (or "Your") shall mean an individual or Legal Entity 39 | exercising permissions granted by this License. 40 | 41 | "Source" form shall mean the preferred form for making modifications, 42 | including but not limited to software source code, documentation 43 | source, and configuration files. 44 | 45 | "Object" form shall mean any form resulting from mechanical 46 | transformation or translation of a Source form, including but 47 | not limited to compiled object code, generated documentation, 48 | and conversions to other media types. 49 | 50 | "Work" shall mean the work of authorship, whether in Source or 51 | Object form, made available under the License, as indicated by a 52 | copyright notice that is included in or attached to the work 53 | (an example is provided in the Appendix below). 54 | 55 | "Derivative Works" shall mean any work, whether in Source or Object 56 | form, that is based on (or derived from) the Work and for which the 57 | editorial revisions, annotations, elaborations, or other modifications 58 | represent, as a whole, an original work of authorship. For the purposes 59 | of this License, Derivative Works shall not include works that remain 60 | separable from, or merely link (or bind by name) to the interfaces of, 61 | the Work and Derivative Works thereof. 62 | 63 | "Contribution" shall mean any work of authorship, including 64 | the original version of the Work and any modifications or additions 65 | to that Work or Derivative Works thereof, that is intentionally 66 | submitted to Licensor for inclusion in the Work by the copyright owner 67 | or by an individual or Legal Entity authorized to submit on behalf of 68 | the copyright owner. For the purposes of this definition, "submitted" 69 | means any form of electronic, verbal, or written communication sent 70 | to the Licensor or its representatives, including but not limited to 71 | communication on electronic mailing lists, source code control systems, 72 | and issue tracking systems that are managed by, or on behalf of, the 73 | Licensor for the purpose of discussing and improving the Work, but 74 | excluding communication that is conspicuously marked or otherwise 75 | designated in writing by the copyright owner as "Not a Contribution." 76 | 77 | "Contributor" shall mean Licensor and any individual or Legal Entity 78 | on behalf of whom a Contribution has been received by Licensor and 79 | subsequently incorporated within the Work. 80 | 81 | 2. Grant of Copyright License. Subject to the terms and conditions of 82 | this License, each Contributor hereby grants to You a perpetual, 83 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 84 | copyright license to reproduce, prepare Derivative Works of, 85 | publicly display, publicly perform, sublicense, and distribute the 86 | Work and such Derivative Works in Source or Object form. 87 | 88 | 3. Grant of Patent License. Subject to the terms and conditions of 89 | this License, each Contributor hereby grants to You a perpetual, 90 | worldwide, non-exclusive, no-charge, royalty-free, irrevocable 91 | (except as stated in this section) patent license to make, have made, 92 | use, offer to sell, sell, import, and otherwise transfer the Work, 93 | where such license applies only to those patent claims licensable 94 | by such Contributor that are necessarily infringed by their 95 | Contribution(s) alone or by combination of their Contribution(s) 96 | with the Work to which such Contribution(s) was submitted. If You 97 | institute patent litigation against any entity (including a 98 | cross-claim or counterclaim in a lawsuit) alleging that the Work 99 | or a Contribution incorporated within the Work constitutes direct 100 | or contributory patent infringement, then any patent licenses 101 | granted to You under this License for that Work shall terminate 102 | as of the date such litigation is filed. 103 | 104 | 4. Redistribution. You may reproduce and distribute copies of the 105 | Work or Derivative Works thereof in any medium, with or without 106 | modifications, and in Source or Object form, provided that You 107 | meet the following conditions: 108 | 109 | (a) You must give any other recipients of the Work or 110 | Derivative Works a copy of this License; and 111 | 112 | (b) You must cause any modified files to carry prominent notices 113 | stating that You changed the files; and 114 | 115 | (c) You must retain, in the Source form of any Derivative Works 116 | that You distribute, all copyright, patent, trademark, and 117 | attribution notices from the Source form of the Work, 118 | excluding those notices that do not pertain to any part of 119 | the Derivative Works; and 120 | 121 | (d) If the Work includes a "NOTICE" text file as part of its 122 | distribution, then any Derivative Works that You distribute must 123 | include a readable copy of the attribution notices contained 124 | within such NOTICE file, excluding those notices that do not 125 | pertain to any part of the Derivative Works, in at least one 126 | of the following places: within a NOTICE text file distributed 127 | as part of the Derivative Works; within the Source form or 128 | documentation, if provided along with the Derivative Works; or, 129 | within a display generated by the Derivative Works, if and 130 | wherever such third-party notices normally appear. The contents 131 | of the NOTICE file are for informational purposes only and 132 | do not modify the License. You may add Your own attribution 133 | notices within Derivative Works that You distribute, alongside 134 | or as an addendum to the NOTICE text from the Work, provided 135 | that such additional attribution notices cannot be construed 136 | as modifying the License. 137 | 138 | You may add Your own copyright statement to Your modifications and 139 | may provide additional or different license terms and conditions 140 | for use, reproduction, or distribution of Your modifications, or 141 | for any such Derivative Works as a whole, provided Your use, 142 | reproduction, and distribution of the Work otherwise complies with 143 | the conditions stated in this License. 144 | 145 | 5. Submission of Contributions. Unless You explicitly state otherwise, 146 | any Contribution intentionally submitted for inclusion in the Work 147 | by You to the Licensor shall be under the terms and conditions of 148 | this License, without any additional terms or conditions. 149 | Notwithstanding the above, nothing herein shall supersede or modify 150 | the terms of any separate license agreement you may have executed 151 | with Licensor regarding such Contributions. 152 | 153 | 6. Trademarks. This License does not grant permission to use the trade 154 | names, trademarks, service marks, or product names of the Licensor, 155 | except as required for reasonable and customary use in describing the 156 | origin of the Work and reproducing the content of the NOTICE file. 157 | 158 | 7. Disclaimer of Warranty. Unless required by applicable law or 159 | agreed to in writing, Licensor provides the Work (and each 160 | Contributor provides its Contributions) on an "AS IS" BASIS, 161 | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or 162 | implied, including, without limitation, any warranties or conditions 163 | of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A 164 | PARTICULAR PURPOSE. You are solely responsible for determining the 165 | appropriateness of using or redistributing the Work and assume any 166 | risks associated with Your exercise of permissions under this License. 167 | 168 | 8. Limitation of Liability. In no event and under no legal theory, 169 | whether in tort (including negligence), contract, or otherwise, 170 | unless required by applicable law (such as deliberate and grossly 171 | negligent acts) or agreed to in writing, shall any Contributor be 172 | liable to You for damages, including any direct, indirect, special, 173 | incidental, or consequential damages of any character arising as a 174 | result of this License or out of the use or inability to use the 175 | Work (including but not limited to damages for loss of goodwill, 176 | work stoppage, computer failure or malfunction, or any and all 177 | other commercial damages or losses), even if such Contributor 178 | has been advised of the possibility of such damages. 179 | 180 | 9. Accepting Warranty or Additional Liability. While redistributing 181 | the Work or Derivative Works thereof, You may choose to offer, 182 | and charge a fee for, acceptance of support, warranty, indemnity, 183 | or other liability obligations and/or rights consistent with this 184 | License. However, in accepting such obligations, You may act only 185 | on Your own behalf and on Your sole responsibility, not on behalf 186 | of any other Contributor, and only if You agree to indemnify, 187 | defend, and hold each Contributor harmless for any liability 188 | incurred by, or claims asserted against, such Contributor by reason 189 | of your accepting any such warranty or additional liability. 190 | 191 | END OF TERMS AND CONDITIONS 192 | 193 | APPENDIX: How to apply the Apache License to your work. 194 | 195 | To apply the Apache License to your work, attach the following 196 | boilerplate notice, with the fields enclosed by brackets "{}" 197 | replaced with your own identifying information. (Don't include 198 | the brackets!) The text should be enclosed in the appropriate 199 | comment syntax for the file format. We also recommend that a 200 | file or class name and description of purpose be included on the 201 | same "printed page" as the copyright notice for easier 202 | identification within third-party archives. 203 | 204 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nvim-hs 2 | 3 | Neovim API for Haskell plugins as well as a plugin provider. 4 | This library and executable should provide a basis for developing 5 | plugins. This package should only contain broadly useful interfaces 6 | to write plugins for Neovim in haskell. The design goal is to create 7 | an easy to use API that avoids most of the boilerplate while still retaining 8 | some sense of reliability and type safety. Since Template Haskell is used 9 | to generate the neovim bindings and to avoid some of the boilerplate 10 | handy work, some exotic operating systems and architectures may not work. 11 | 12 | [![Hackage version](https://img.shields.io/hackage/v/nvim-hs.svg?style=flat)](https://hackage.haskell.org/package/nvim-hs) 13 | [![nvim-hs on latest Stackage LTS](http://stackage.org/package/nvim-hs/badge/lts)](http://stackage.org/lts/package/nvim-hs) 14 | [![nvim-hs on Stackage Nightly](http://stackage.org/package/nvim-hs/badge/nightly)](http://stackage.org/nightly/package/nvim-hs) 15 | 16 | # What do I have to expect if I were to use it now? 17 | 18 | Check the issue list here on github. 19 | 20 | ## For Windows users 21 | 22 | Named pipes are not supported at the momend #103. You therefore have to start 23 | `nvim-hs` instances by connecting to STDIN and STDOUT or TCP. By default `nvim-hs` 24 | connects to the listen socket pointed to by the `NVIM` environment variable and 25 | the functions in the module `Neovim.Debug` rely on that. If you want to be able to 26 | run these functions, start Neovim with `nvim --listen localhost:` or similar 27 | (This example command starts neovim with a socket listening on `localhost` and 28 | random a random TCP port.) 29 | 30 | # How do I start using this? 31 | 32 | You need to install `nvim-hs.vim`, a plugin that manages starting of `nvim-hs` plugins. 33 | To do that, just follow the instructions outlined [here](https://github.com/neovimhaskell/nvim-hs.vim). 34 | 35 | Once you have installed `nvim-hs.vim`, you can use `nvim-hs` plugins as you would 36 | normal vim plugins. Note that every plugin you install is started as a separate process, 37 | which should be fine unless you have a lot of them. 38 | 39 | # Scripting with Haskell 40 | 41 | The entry point for all Haskell-based scripts is a plugin. 42 | An `nvim-hs` plugin is a plain Haskell project with two conventions: 43 | 44 | 1. You need an executable that starts a `msgpack-rpc` compatible client. 45 | 46 | 2. You need a tiny bit of `vimL` in your runtime path that starts the plugin. 47 | 48 | The simplest way to get started is using the stack template from this 49 | repository/package inside your Neovim configuration folder, but you can also 50 | manually create a project by doing everything that is explained in `:help nvim-hs.txt` 51 | (which should be available if you installed `nvim-hs.vim` as mentioned in the previous section). 52 | 53 | To use that template, you'll first need to [install stack](https://docs.haskellstack.org/en/stable/README/) 54 | and have the Neovim executable on the path (the API code generation calls `nvim --api-info` so it needs access to `nvim`). 55 | 56 | After you've done that, you can run these commands to setup the template (assuming your Neovim configuration folder 57 | is in `$XDG_CONFIG_HOME/nvim`): 58 | 59 | ``` 60 | $ cd $XDG_CONFIG_HOME/nvim 61 | $ stack new my-nvim-hs \ 62 | https://raw.githubusercontent.com/neovimhaskell/nvim-hs/master/stack-template.hsfiles \ 63 | --bare --omit-packages --ignore-subdirs 64 | ``` 65 | 66 | If you start Neovim now, it will compile the example plugins which may take a 67 | few minutes. Once it is started you can use the predefined functions from the 68 | template, for example by running `:echo NextRandom()`, which should print a random number. 69 | 70 | To start writing your own functions and plugins, read through the files 71 | generated by the template and also check out the 72 | [library documentation on hackage](http://hackage.haskell.org/package/nvim-hs). 73 | 74 | # Contributing 75 | 76 | Documentation, typo fixes, and the like will almost always be merged. 77 | 78 | If you want to bring forward new features or convenience libraries 79 | for interacting with Neovim, you should create an issue first. The features 80 | of this (cabal) project should be kept small as this helps 81 | reduce the development time. (For some tests it is 82 | necessary to issue `cabal install`, so any change to to a module can 83 | significantly increase the compilation time.) 84 | If your idea solves a general problem, feel free to open an issue in the 85 | library project of `nvim-hs`, 86 | [`nvim-hs-contrib`](https://github.com/neovimhaskell/nvim-hs-contrib). 87 | 88 | -------------------------------------------------------------------------------- /RELEASE.md: -------------------------------------------------------------------------------- 1 | # Steps to do during a release 2 | 3 | 1. Make sure the version in the cabal file matches the planned release 4 | number 5 | 6 | 2. Adjust the stack template with that version and test whether it works 7 | 8 | 3. Run the test suite for good measure 9 | 10 | 4. Create the haddocks and fix errors/warnings 11 | 12 | 5. Update the `CHANGELOG.md` file 13 | 14 | 6. Commit and push everything (do not tag yet) 15 | 16 | 7. Create a distribution tarball and build/test with the contents 17 | 18 | 8. Tag if travis build is okay 19 | 20 | 9. Generate the haddock documentation (unless you know you don't have to) 21 | 22 | 10. Generate a distribution tarball 23 | 24 | 11. Upload tarball and documentation 25 | 26 | 12. Create a new commit where the version numbers are incremented 27 | 28 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | 3 | main = defaultMain 4 | -------------------------------------------------------------------------------- /api: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/api -------------------------------------------------------------------------------- /apiblobs/0.1.7.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.1.7.msgpack -------------------------------------------------------------------------------- /apiblobs/0.10.4.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.10.4.msgpack -------------------------------------------------------------------------------- /apiblobs/0.11.0-nightly.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.11.0-nightly.msgpack -------------------------------------------------------------------------------- /apiblobs/0.2.0.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.2.0.msgpack -------------------------------------------------------------------------------- /apiblobs/0.3.0.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.3.0.msgpack -------------------------------------------------------------------------------- /apiblobs/0.4.3.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.4.3.msgpack -------------------------------------------------------------------------------- /apiblobs/0.5.0.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.5.0.msgpack -------------------------------------------------------------------------------- /apiblobs/0.6.1.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.6.1.msgpack -------------------------------------------------------------------------------- /apiblobs/0.8.0.msgpack: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/neovimhaskell/nvim-hs/d6745c8ac45fa8eb195a4a9fd26409df67290bac/apiblobs/0.8.0.msgpack -------------------------------------------------------------------------------- /apiblobs/README.md: -------------------------------------------------------------------------------- 1 | This directory contains the output of `nvim --api-info` for different 2 | versions of neovim. This allows building this package without neovim being 3 | installed. This is mainly useful for CI systems or to test compatibility 4 | with previous versions of the API. 5 | -------------------------------------------------------------------------------- /example/lib/Fibonacci.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Fibonacci (plugin) where 4 | 5 | import Fibonacci.Plugin (fibonacci) 6 | import Neovim 7 | 8 | plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin 9 | plugin = 10 | wrapPlugin 11 | Plugin 12 | { exports = [$(function' 'fibonacci) Sync] 13 | , statefulExports = [] 14 | } 15 | -------------------------------------------------------------------------------- /example/lib/Fibonacci/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Fibonacci.Plugin (fibonacci) where 2 | 3 | import Neovim 4 | 5 | -- | Neovim is not really good with big numbers, so we return a 'String' here. 6 | fibonacci :: Int -> Neovim' String 7 | fibonacci n = return . show $ fibs !! n 8 | where 9 | fibs :: [Integer] 10 | fibs = 0 : 1 : scanl1 (+) fibs 11 | -------------------------------------------------------------------------------- /example/lib/Random.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | 3 | module Random (plugin) where 4 | 5 | import Neovim 6 | import Random.Plugin (nextRandom, setNextRandom) 7 | import System.Random (newStdGen, randoms) 8 | 9 | plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin 10 | plugin = do 11 | g <- liftIO newStdGen -- initialize with a random seed 12 | let randomNumbers = randoms g -- an infinite list of random numbers 13 | wrapPlugin 14 | Plugin 15 | { exports = [] 16 | , statefulExports = 17 | [ 18 | ( () 19 | , randomNumbers 20 | , 21 | [ $(function' 'nextRandom) Sync 22 | , $(function "SetNextRandom" 'setNextRandom) Async 23 | ] 24 | ) 25 | ] 26 | } 27 | -------------------------------------------------------------------------------- /example/lib/Random/Plugin.hs: -------------------------------------------------------------------------------- 1 | module Random.Plugin (nextRandom, setNextRandom) where 2 | 3 | import Neovim 4 | 5 | import System.Random (newStdGen, randoms) 6 | import UnliftIO.STM (TVar, atomically, modifyTVar, newTVarIO, readTVar) 7 | 8 | -- You may want to define a type alias for your plugin, so that if you change 9 | -- your environment, you don't have to change all type signatures. 10 | -- 11 | -- If I were to write a real plugin, I would probably also create a data type 12 | -- instead of directly using a TVar here. 13 | -- 14 | type MyNeovim a = Neovim (TVar [Int16]) a 15 | 16 | -- This function will create an initial environment for our random number 17 | -- generator. Note that the return type is the type of our environment. 18 | randomNumbers :: Neovim startupEnv (TVar [Int16]) 19 | randomNumbers = do 20 | g <- liftIO newStdGen -- Create a new seed for a pseudo random number generator 21 | newTVarIO (randoms g) -- Put an infinite list of random numbers into a TVar 22 | 23 | -- | Get the next random number and update the state of the list. 24 | nextRandom :: MyNeovim Int16 25 | nextRandom = do 26 | tVarWithRandomNumbers <- ask 27 | atomically $ do 28 | -- pick the head of our list of random numbers 29 | r <- head <$ readTVar tVarWithRandomNumbers 30 | 31 | -- Since we do not want to return the same number all over the place 32 | -- remove the head of our list of random numbers 33 | modifyTVar tVarWithRandomNumbers tail 34 | 35 | return r 36 | -------------------------------------------------------------------------------- /example/nvim.hs: -------------------------------------------------------------------------------- 1 | import Neovim 2 | 3 | import qualified Fibonacci as Fibonacci 4 | import qualified Random as Random 5 | 6 | main :: IO () 7 | main = 8 | neovim 9 | defaultConfig 10 | { plugins = plugins defaultConfig ++ [Fibonacci.plugin, Random.plugin] 11 | } 12 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "flake-utils": { 4 | "inputs": { 5 | "systems": "systems" 6 | }, 7 | "locked": { 8 | "lastModified": 1731533236, 9 | "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", 10 | "owner": "numtide", 11 | "repo": "flake-utils", 12 | "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", 13 | "type": "github" 14 | }, 15 | "original": { 16 | "owner": "numtide", 17 | "repo": "flake-utils", 18 | "type": "github" 19 | } 20 | }, 21 | "nixpkgs": { 22 | "locked": { 23 | "lastModified": 1739866667, 24 | "narHash": "sha256-EO1ygNKZlsAC9avfcwHkKGMsmipUk1Uc0TbrEZpkn64=", 25 | "owner": "NixOS", 26 | "repo": "nixpkgs", 27 | "rev": "73cf49b8ad837ade2de76f87eb53fc85ed5d4680", 28 | "type": "github" 29 | }, 30 | "original": { 31 | "id": "nixpkgs", 32 | "ref": "nixos-unstable", 33 | "type": "indirect" 34 | } 35 | }, 36 | "root": { 37 | "inputs": { 38 | "flake-utils": "flake-utils", 39 | "nixpkgs": "nixpkgs" 40 | } 41 | }, 42 | "systems": { 43 | "locked": { 44 | "lastModified": 1681028828, 45 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 46 | "owner": "nix-systems", 47 | "repo": "default", 48 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 49 | "type": "github" 50 | }, 51 | "original": { 52 | "owner": "nix-systems", 53 | "repo": "default", 54 | "type": "github" 55 | } 56 | } 57 | }, 58 | "root": "root", 59 | "version": 7 60 | } 61 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "nvim-hs"; 3 | 4 | inputs = { 5 | nixpkgs.url = "nixpkgs/nixos-unstable"; 6 | 7 | flake-utils = { 8 | url = "github:numtide/flake-utils"; 9 | }; 10 | }; 11 | 12 | outputs = { self, nixpkgs, flake-utils }: 13 | flake-utils.lib.eachSystem [ "x86_64-linux" ] (system: 14 | let 15 | pkgs = import nixpkgs { 16 | inherit system; 17 | }; 18 | haskellPackages = pkgs.haskellPackages; 19 | t = pkgs.lib.trivial; 20 | hl = pkgs.haskell.lib; 21 | 22 | # Parameter buildTools is used to share most of the boilerplate code 23 | # between the package and the devShell. 24 | project = { buildTools ? [ ] }: 25 | let addBuildTools = (t.flip hl.addBuildTools) buildTools; 26 | in 27 | haskellPackages.developPackage { 28 | root = nixpkgs.lib.sourceFilesBySuffices ./. [ ".cabal" ".hs" ]; 29 | name = "nvim-hs"; 30 | returnShellEnv = !(buildTools == [ ]); 31 | 32 | modifier = package: t.pipe package [ 33 | addBuildTools 34 | hl.enableStaticLibraries 35 | hl.justStaticExecutables 36 | hl.disableLibraryProfiling 37 | hl.disableExecutableProfiling 38 | ]; 39 | }; 40 | in 41 | { 42 | packages.pkg = project { }; 43 | defaultPackage = self.packages.${system}.pkg; 44 | devShell = with haskellPackages; project { 45 | buildTools = [ 46 | cabal-fmt 47 | cabal-install 48 | fourmolu 49 | haskell-language-server 50 | hlint 51 | ]; 52 | }; 53 | }); 54 | } 55 | -------------------------------------------------------------------------------- /fourmolu.yaml: -------------------------------------------------------------------------------- 1 | indentation: 4 2 | function-arrows: trailing 3 | comma-style: leading 4 | import-export-style: diff-friendly 5 | indent-wheres: false 6 | record-brace-space: false 7 | newlines-between-decls: 1 8 | haddock-style: multi-line 9 | haddock-style-module: 10 | let-style: auto 11 | in-style: right-align 12 | respectful: true 13 | fixities: [] 14 | unicode: never 15 | -------------------------------------------------------------------------------- /nvim-hs.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | name: nvim-hs 3 | version: 2.3.2.5 4 | synopsis: Haskell plugin backend for neovim 5 | description: 6 | This package provides a plugin provider for neovim. It allows you to write 7 | plugins for one of the great editors of our time in the best programming 8 | language of our time! ;-) 9 | . 10 | You should find all the documentation you need inside the "Neovim" module. 11 | Most other modules are considered internal, so don't be annoyed if using 12 | things from there may break your code! 13 | . 14 | The following modules may also be of interest and they should not change 15 | their API: "Neovim.Quickfix" 16 | . 17 | If you want to write unit tests that interact with neovim, "Neovim.Test" 18 | provides some useful functions for that. 19 | . 20 | If you are keen to debug /nvim-hs/ or a module you are writing, take a look 21 | at the "Neovim.Debug" module. 22 | . 23 | If you spot any errors or if you have great ideas, feel free to open an issue 24 | on github. 25 | homepage: https://github.com/neovimhaskell/nvim-hs 26 | license: Apache-2.0 27 | license-file: LICENSE 28 | author: Sebastian Witte 29 | maintainer: woozletoff@gmail.com 30 | copyright: Copyright 2017-2022 Sebastian Witte 31 | category: Editor 32 | build-type: Simple 33 | extra-source-files: test-files/hello 34 | , apiblobs/0.1.7.msgpack 35 | , apiblobs/0.2.0.msgpack 36 | , apiblobs/0.3.0.msgpack 37 | , apiblobs/0.4.3.msgpack 38 | , apiblobs/0.5.0.msgpack 39 | , apiblobs/0.6.1.msgpack 40 | , apiblobs/0.8.0.msgpack 41 | , apiblobs/0.10.4.msgpack 42 | , apiblobs/0.11.0-nightly.msgpack 43 | , api 44 | 45 | extra-doc-files: CHANGELOG.md 46 | , README.md 47 | , apiblobs/README.md 48 | 49 | source-repository head 50 | type: git 51 | location: https://github.com/neovimhaskell/nvim-hs 52 | 53 | common defaults 54 | default-language: Haskell2010 55 | default-extensions: BangPatterns 56 | , ScopedTypeVariables 57 | , StrictData 58 | other-extensions: DeriveDataTypeable 59 | , DeriveGeneric 60 | , DerivingVia 61 | , ExistentialQuantification 62 | , FlexibleContexts 63 | , FlexibleInstances 64 | , GADTs 65 | , GeneralizedNewtypeDeriving 66 | , LambdaCase 67 | , MultiParamTypeClasses 68 | , NamedFieldPuns 69 | , NoOverloadedStrings 70 | , NoRebindableSyntax 71 | , OverloadedLists 72 | , OverloadedStrings 73 | , PackageImports 74 | , RankNTypes 75 | , RecordWildCards 76 | , TemplateHaskell 77 | ghc-options: -Wall -Wincomplete-uni-patterns -Wincomplete-record-updates 78 | build-depends: base >=4.9 && < 5 79 | , containers 80 | , data-default 81 | , deepseq >= 1.1 && < 2 82 | , prettyprinter 83 | , prettyprinter-ansi-terminal 84 | , unliftio >= 0.2 85 | , unliftio-core >= 0.2 86 | , vector 87 | , void 88 | 89 | library 90 | import: defaults 91 | exposed-modules: Neovim 92 | , Neovim.Quickfix 93 | , Neovim.Debug 94 | , Neovim.Test 95 | -- Note that every module below this is considered internal and if you have to 96 | -- import it somewhere in your code and you think it should be generally 97 | -- available , you should open a ticket about inclusion in the export list of 98 | -- the Neovim module. Since we are still in a prototyping stage, every user of 99 | -- this library should have the freedom to do what she wants. 100 | , Neovim.API.String 101 | , Neovim.API.Text 102 | , Neovim.API.ByteString 103 | , Neovim.Classes 104 | , Neovim.Compat.Megaparsec 105 | , Neovim.Config 106 | , Neovim.Context 107 | , Neovim.Context.Internal 108 | , Neovim.Exceptions 109 | , Neovim.Plugin 110 | , Neovim.Plugin.Classes 111 | , Neovim.Plugin.Internal 112 | , Neovim.Plugin.IPC 113 | , Neovim.Plugin.IPC.Classes 114 | , Neovim.Log 115 | , Neovim.Main 116 | , Neovim.OS 117 | , Neovim.RPC.Classes 118 | , Neovim.RPC.Common 119 | , Neovim.RPC.EventHandler 120 | , Neovim.RPC.FunctionCall 121 | , Neovim.RPC.SocketReader 122 | , Neovim.Util 123 | , Neovim.API.Parser 124 | , Neovim.API.TH 125 | other-extensions: CPP 126 | build-depends: bytestring 127 | , cereal 128 | , cereal-conduit >= 0.8.0 129 | , conduit >= 1.3.0 130 | , foreign-store 131 | , hslogger 132 | , messagepack >= 0.5.4 133 | , network 134 | , mtl >= 2.2.1 && < 2.4 135 | , optparse-applicative 136 | , time-locale-compat 137 | , megaparsec < 10 138 | , streaming-commons 139 | , template-haskell 140 | , template-haskell-compat-v0208 >= 0.1.9 141 | , text 142 | , time 143 | , typed-process 144 | , utf8-string 145 | hs-source-dirs: src 146 | 147 | if os(windows) 148 | cpp-options: -DWINDOWS 149 | hs-source-dirs: srcos/windows 150 | else 151 | hs-source-dirs: srcos/unix 152 | 153 | 154 | test-suite hspec 155 | import: defaults 156 | type: exitcode-stdio-1.0 157 | hs-source-dirs: tests 158 | main-is: Spec.hs 159 | build-depends: nvim-hs 160 | 161 | , hspec ==2.* 162 | , hspec-discover 163 | , QuickCheck >=2.6 164 | 165 | other-modules: API.THSpec 166 | , API.THSpecFunctions 167 | , EmbeddedRPCSpec 168 | , EventSubscriptionSpec 169 | , Plugin.ClassesSpec 170 | , AsyncFunctionSpec 171 | , RPC.SocketReaderSpec 172 | , RPC.CommonSpec 173 | 174 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 175 | 176 | -------------------------------------------------------------------------------- /src/Neovim/API/ByteString.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE NoOverloadedStrings #-} 6 | 7 | {- | 8 | Module : Neovim.API.ByteString 9 | Description : ByteString based API 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | Portability : GHC 16 | -} 17 | module Neovim.API.ByteString where 18 | 19 | import Neovim.API.TH 20 | 21 | $(generateAPI bytestringVectorTypeMap) 22 | -------------------------------------------------------------------------------- /src/Neovim/API/Parser.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | {- | 4 | Module : Neovim.API.Parser 5 | Description : P.Parser for the msgpack output stram API 6 | Copyright : (c) Sebastian Witte 7 | License : Apache-2.0 8 | 9 | Maintainer : woozletoff@gmail.com 10 | Stability : experimental 11 | -} 12 | module Neovim.API.Parser ( 13 | NeovimAPI (..), 14 | NeovimFunction (..), 15 | NeovimType (..), 16 | parseAPI, 17 | ) where 18 | 19 | import Neovim.Classes 20 | import Neovim.OS (isWindows) 21 | 22 | import Control.Applicative (optional) 23 | import Control.Monad (forM) 24 | import Control.Monad.Except (MonadError (throwError)) 25 | import qualified Data.ByteString as B 26 | import qualified Data.ByteString.Lazy as LB 27 | import Data.Map (Map) 28 | import qualified Data.Map as Map 29 | import Data.MessagePack (Object) 30 | import Data.Serialize (decode) 31 | import Neovim.Compat.Megaparsec as P ( 32 | MonadParsec (eof, try), 33 | Parser, 34 | char, 35 | noneOf, 36 | oneOf, 37 | parse, 38 | some, 39 | space, 40 | string, 41 | (<|>), 42 | ) 43 | import System.Process.Typed (proc, readProcessStdout_) 44 | import UnliftIO.Exception ( 45 | SomeException, 46 | catch, 47 | ) 48 | 49 | import Prelude 50 | 51 | data NeovimType 52 | = SimpleType String 53 | | NestedType NeovimType (Maybe Int) 54 | | Void 55 | deriving (Show, Eq) 56 | 57 | {- | This data type contains simple information about a function as received 58 | throudh the @nvim --api-info@ command. 59 | -} 60 | data NeovimFunction = NeovimFunction 61 | { name :: String 62 | -- ^ function name 63 | , parameters :: [(NeovimType, String)] 64 | -- ^ A list of type name and variable name. 65 | , canFail :: Bool 66 | -- ^ Indicator whether the function can fail/throws exceptions. 67 | , async :: Bool 68 | -- ^ Indicator whether the this function is asynchronous. 69 | , returnType :: NeovimType 70 | -- ^ Functions return type. 71 | } 72 | deriving (Show) 73 | 74 | {- | This data type represents the top-level structure of the @nvim --api-info@ 75 | output. 76 | -} 77 | data NeovimAPI = NeovimAPI 78 | { errorTypes :: [(String, Int64)] 79 | -- ^ The error types are defined by a name and an identifier. 80 | , customTypes :: [(String, Int64)] 81 | -- ^ Extension types defined by neovim. 82 | , functions :: [NeovimFunction] 83 | -- ^ The remotely executable functions provided by the neovim api. 84 | } 85 | deriving (Show) 86 | 87 | -- | Run @nvim --api-info@ and parse its output. 88 | parseAPI :: IO (Either (Doc AnsiStyle) NeovimAPI) 89 | parseAPI = either (Left . pretty) extractAPI <$> go 90 | where 91 | go 92 | | isWindows = readFromAPIFile 93 | | otherwise = decodeAPI `catch` \(_ignored :: SomeException) -> readFromAPIFile 94 | 95 | decodeAPI :: IO (Either String Object) 96 | decodeAPI = 97 | decode . LB.toStrict <$> readProcessStdout_ (proc "nvim" ["--api-info"]) 98 | 99 | extractAPI :: Object -> Either (Doc AnsiStyle) NeovimAPI 100 | extractAPI apiObj = 101 | fromObject apiObj >>= \apiMap -> 102 | NeovimAPI 103 | <$> extractErrorTypes apiMap 104 | <*> extractCustomTypes apiMap 105 | <*> extractFunctions apiMap 106 | 107 | readFromAPIFile :: IO (Either String Object) 108 | readFromAPIFile = (decode <$> B.readFile "api") `catch` returnNoApiForCodegeneratorErrorMessage 109 | where 110 | returnNoApiForCodegeneratorErrorMessage :: SomeException -> IO (Either String Object) 111 | returnNoApiForCodegeneratorErrorMessage _ = 112 | return . Left $ 113 | "The 'nvim' process could not be started and there is no file named 'api' in the working directory as a substitute." 114 | 115 | oLookup :: (NvimObject o) => String -> Map String Object -> Either (Doc AnsiStyle) o 116 | oLookup qry = maybe throwErrorMessage fromObject . Map.lookup qry 117 | where 118 | throwErrorMessage = throwError $ "No entry for:" <+> pretty qry 119 | 120 | oLookupDefault :: (NvimObject o) => o -> String -> Map String Object -> Either (Doc AnsiStyle) o 121 | oLookupDefault d qry m = maybe (return d) fromObject $ Map.lookup qry m 122 | 123 | extractErrorTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)] 124 | extractErrorTypes objAPI = extractTypeNameAndID =<< oLookup "error_types" objAPI 125 | 126 | extractTypeNameAndID :: Object -> Either (Doc AnsiStyle) [(String, Int64)] 127 | extractTypeNameAndID m = do 128 | types <- Map.toList <$> fromObject m 129 | forM types $ \(errName, idMap) -> do 130 | i <- oLookup "id" idMap 131 | return (errName, i) 132 | 133 | extractCustomTypes :: Map String Object -> Either (Doc AnsiStyle) [(String, Int64)] 134 | extractCustomTypes objAPI = extractTypeNameAndID =<< oLookup "types" objAPI 135 | 136 | extractFunctions :: Map String Object -> Either (Doc AnsiStyle) [NeovimFunction] 137 | extractFunctions objAPI = mapM extractFunction =<< oLookup "functions" objAPI 138 | 139 | toParameterlist :: [(String, String)] -> Either (Doc AnsiStyle) [(NeovimType, String)] 140 | toParameterlist ps = forM ps $ \(t, n) -> do 141 | t' <- parseType t 142 | return (t', n) 143 | 144 | extractFunction :: Map String Object -> Either (Doc AnsiStyle) NeovimFunction 145 | extractFunction funDefMap = 146 | NeovimFunction 147 | <$> oLookup "name" funDefMap 148 | <*> (oLookup "parameters" funDefMap >>= toParameterlist) 149 | <*> oLookupDefault True "can_fail" funDefMap 150 | <*> oLookupDefault False "async" funDefMap 151 | <*> (oLookup "return_type" funDefMap >>= parseType) 152 | 153 | parseType :: String -> Either (Doc AnsiStyle) NeovimType 154 | parseType s = either (throwError . pretty . show) return $ parse (pType <* eof) s s 155 | 156 | pType :: P.Parser NeovimType 157 | pType = pArray P.<|> pVoid P.<|> pSimple 158 | 159 | pVoid :: P.Parser NeovimType 160 | pVoid = Void <$ (P.try (string "void") <* eof) 161 | 162 | pSimple :: P.Parser NeovimType 163 | pSimple = SimpleType <$> P.some (noneOf [',', ')']) 164 | 165 | pArray :: P.Parser NeovimType 166 | pArray = 167 | NestedType 168 | <$> (P.try (string "ArrayOf(") *> pType) 169 | <*> optional pNum 170 | <* char ')' 171 | 172 | pNum :: P.Parser Int 173 | pNum = read <$> (P.try (char ',') *> space *> P.some (oneOf ['0' .. '9'])) 174 | -------------------------------------------------------------------------------- /src/Neovim/API/String.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE NoOverloadedStrings #-} 6 | 7 | {- | 8 | Module : Neovim.API.String 9 | Description : String based API 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | 16 | Note that this module is completely generated. If you're reading this on 17 | hackage, the actual functions of this module may be different from what is 18 | available to you. All the functions in this module depend on the neovim version 19 | that was used when this package was compiled. 20 | -} 21 | module Neovim.API.String where 22 | 23 | import Neovim.API.TH 24 | 25 | $(generateAPI stringListTypeMap) 26 | -------------------------------------------------------------------------------- /src/Neovim/API/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE RankNTypes #-} 4 | {-# LANGUAGE TemplateHaskell #-} 5 | {-# LANGUAGE NoOverloadedStrings #-} 6 | 7 | {- | 8 | Module : Neovim.API.Text 9 | Description : Text based API 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | Portability : GHC 16 | -} 17 | module Neovim.API.Text where 18 | 19 | import Neovim.API.TH 20 | 21 | $(generateAPI textVectorTypeMap) 22 | -------------------------------------------------------------------------------- /src/Neovim/Classes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RankNTypes #-} 6 | 7 | {- | 8 | Module : Neovim.Classes 9 | Description : Type classes used for conversion of msgpack and Haskell types 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | -} 16 | module Neovim.Classes ( 17 | NvimObject (..), 18 | Dictionary, 19 | (+:), 20 | Generic, 21 | docToObject, 22 | docFromObject, 23 | docToText, 24 | Doc, 25 | AnsiStyle, 26 | Pretty (..), 27 | (<+>), 28 | module Data.Int, 29 | module Data.Word, 30 | module Control.DeepSeq, 31 | ) where 32 | 33 | import Neovim.Exceptions (NeovimException (..)) 34 | 35 | import Control.Applicative (Applicative (liftA2)) 36 | import Control.Arrow ((***)) 37 | import Control.DeepSeq (NFData) 38 | import Control.Monad () 39 | import Control.Monad.Except ( 40 | MonadError (throwError), 41 | ) 42 | import Control.Monad.IO.Class (MonadIO) 43 | import Data.ByteString (ByteString) 44 | import Data.Int ( 45 | Int16, 46 | Int32, 47 | Int64, 48 | Int8, 49 | ) 50 | import qualified Data.Map.Strict as SMap 51 | import Data.MessagePack 52 | import Data.Monoid 53 | import Data.Text as Text (Text) 54 | import Data.Vector (Vector) 55 | import qualified Data.Vector as V 56 | import Data.Word ( 57 | Word, 58 | Word16, 59 | Word32, 60 | Word64, 61 | Word8, 62 | ) 63 | import GHC.Generics (Generic) 64 | import Prettyprinter ( 65 | Doc, 66 | Pretty (..), 67 | defaultLayoutOptions, 68 | layoutPretty, 69 | viaShow, 70 | (<+>), 71 | ) 72 | import qualified Prettyprinter as P 73 | import Prettyprinter.Render.Terminal ( 74 | AnsiStyle, 75 | renderStrict, 76 | ) 77 | 78 | import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString) 79 | import Data.Text.Encoding (decodeUtf8, encodeUtf8) 80 | import UnliftIO.Exception (throwIO) 81 | 82 | import Prelude 83 | 84 | infixr 5 +: 85 | 86 | {- | Convenient operator to create a list of 'Object' from normal values. 87 | @ 88 | values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: [] 89 | @ 90 | -} 91 | (+:) :: (NvimObject o) => o -> [Object] -> [Object] 92 | o +: os = toObject o : os 93 | 94 | {- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience 95 | method to transport error message from and to neovim. It generally does not 96 | hold that 'docToObject . docFromObject' = 'id'. 97 | -} 98 | docToObject :: Doc AnsiStyle -> Object 99 | docToObject = ObjectString . encodeUtf8 . docToText 100 | 101 | -- | See 'docToObject'. 102 | docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle) 103 | docFromObject o = (P.viaShow :: Text -> Doc AnsiStyle) <$> fromObject o 104 | 105 | docToText :: Doc AnsiStyle -> Text 106 | docToText = renderStrict . layoutPretty defaultLayoutOptions 107 | 108 | {- | A generic vim dictionary is a simply a map from strings to objects. This 109 | type alias is sometimes useful as a type annotation especially if the 110 | OverloadedStrings extension is enabled. 111 | -} 112 | type Dictionary = SMap.Map ByteString Object 113 | 114 | {- | Conversion from 'Object' files to Haskell types and back with respect 115 | to neovim's interpretation. 116 | 117 | The 'NFData' constraint has been added to allow forcing results of function 118 | evaluations in order to catch exceptions from pure code. This adds more 119 | stability to the plugin provider and seems to be a cleaner approach. 120 | -} 121 | class NFData o => NvimObject o where 122 | toObject :: o -> Object 123 | 124 | fromObjectUnsafe :: Object -> o 125 | fromObjectUnsafe o = case fromObject o of 126 | Left e -> 127 | error . show $ 128 | "Not the expected object:" 129 | <+> P.viaShow o 130 | <+> P.lparen <> e <> P.rparen 131 | Right obj -> obj 132 | 133 | fromObject :: Object -> Either (Doc AnsiStyle) o 134 | fromObject = return . fromObjectUnsafe 135 | 136 | fromObject' :: (MonadIO io) => Object -> io o 137 | fromObject' = either (throwIO . ErrorMessage) return . fromObject 138 | 139 | {-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-} 140 | 141 | -- Instances for NvimObject {{{1 142 | instance NvimObject () where 143 | toObject _ = ObjectNil 144 | 145 | fromObject ObjectNil = return () 146 | fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o 147 | 148 | -- We may receive truthy values from neovim, so we should be more forgiving 149 | -- here. 150 | instance NvimObject Bool where 151 | toObject = ObjectBool 152 | 153 | fromObject (ObjectBool o) = return o 154 | fromObject (ObjectInt 0) = return False 155 | fromObject (ObjectUInt 0) = return False 156 | fromObject ObjectNil = return False 157 | fromObject (ObjectBinary "0") = return False 158 | fromObject (ObjectBinary "") = return False 159 | fromObject (ObjectString "0") = return False 160 | fromObject (ObjectString "") = return False 161 | fromObject _ = return True 162 | 163 | instance NvimObject Double where 164 | toObject = ObjectDouble 165 | 166 | fromObject (ObjectDouble o) = return o 167 | fromObject (ObjectFloat o) = return $ realToFrac o 168 | fromObject (ObjectInt o) = return $ fromIntegral o 169 | fromObject (ObjectUInt o) = return $ fromIntegral o 170 | fromObject o = 171 | throwError $ 172 | "Expected ObjectDouble, but got" 173 | <+> viaShow o 174 | 175 | instance NvimObject Integer where 176 | toObject = ObjectInt . fromIntegral 177 | 178 | fromObject (ObjectInt o) = return $ toInteger o 179 | fromObject (ObjectUInt o) = return $ toInteger o 180 | fromObject (ObjectDouble o) = return $ round o 181 | fromObject (ObjectFloat o) = return $ round o 182 | fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o 183 | 184 | instance NvimObject Int64 where 185 | toObject = ObjectInt 186 | 187 | fromObject (ObjectInt i) = return i 188 | fromObject (ObjectUInt o) = return $ fromIntegral o 189 | fromObject (ObjectDouble o) = return $ round o 190 | fromObject (ObjectFloat o) = return $ round o 191 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 192 | 193 | instance NvimObject Int32 where 194 | toObject = ObjectInt . fromIntegral 195 | 196 | fromObject (ObjectInt i) = return $ fromIntegral i 197 | fromObject (ObjectUInt i) = return $ fromIntegral i 198 | fromObject (ObjectDouble o) = return $ round o 199 | fromObject (ObjectFloat o) = return $ round o 200 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 201 | 202 | instance NvimObject Int16 where 203 | toObject = ObjectInt . fromIntegral 204 | 205 | fromObject (ObjectInt i) = return $ fromIntegral i 206 | fromObject (ObjectUInt i) = return $ fromIntegral i 207 | fromObject (ObjectDouble o) = return $ round o 208 | fromObject (ObjectFloat o) = return $ round o 209 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 210 | 211 | instance NvimObject Int8 where 212 | toObject = ObjectInt . fromIntegral 213 | 214 | fromObject (ObjectInt i) = return $ fromIntegral i 215 | fromObject (ObjectUInt i) = return $ fromIntegral i 216 | fromObject (ObjectDouble o) = return $ round o 217 | fromObject (ObjectFloat o) = return $ round o 218 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 219 | 220 | instance NvimObject Word where 221 | toObject = ObjectInt . fromIntegral 222 | 223 | fromObject (ObjectInt i) = return $ fromIntegral i 224 | fromObject (ObjectUInt i) = return $ fromIntegral i 225 | fromObject (ObjectDouble o) = return $ round o 226 | fromObject (ObjectFloat o) = return $ round o 227 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 228 | 229 | instance NvimObject Word64 where 230 | toObject = ObjectInt . fromIntegral 231 | 232 | fromObject (ObjectInt i) = return $ fromIntegral i 233 | fromObject (ObjectUInt i) = return $ fromIntegral i 234 | fromObject (ObjectDouble o) = return $ round o 235 | fromObject (ObjectFloat o) = return $ round o 236 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 237 | 238 | instance NvimObject Word32 where 239 | toObject = ObjectInt . fromIntegral 240 | 241 | fromObject (ObjectInt i) = return $ fromIntegral i 242 | fromObject (ObjectUInt i) = return $ fromIntegral i 243 | fromObject (ObjectDouble o) = return $ round o 244 | fromObject (ObjectFloat o) = return $ round o 245 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 246 | 247 | instance NvimObject Word16 where 248 | toObject = ObjectInt . fromIntegral 249 | 250 | fromObject (ObjectInt i) = return $ fromIntegral i 251 | fromObject (ObjectUInt i) = return $ fromIntegral i 252 | fromObject (ObjectDouble o) = return $ round o 253 | fromObject (ObjectFloat o) = return $ round o 254 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 255 | 256 | instance NvimObject Word8 where 257 | toObject = ObjectInt . fromIntegral 258 | 259 | fromObject (ObjectInt i) = return $ fromIntegral i 260 | fromObject (ObjectUInt i) = return $ fromIntegral i 261 | fromObject (ObjectDouble o) = return $ round o 262 | fromObject (ObjectFloat o) = return $ round o 263 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 264 | 265 | instance NvimObject Int where 266 | toObject = ObjectInt . fromIntegral 267 | 268 | fromObject (ObjectInt i) = return $ fromIntegral i 269 | fromObject (ObjectUInt i) = return $ fromIntegral i 270 | fromObject (ObjectDouble o) = return $ round o 271 | fromObject (ObjectFloat o) = return $ round o 272 | fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o 273 | 274 | instance {-# OVERLAPPING #-} NvimObject [Char] where 275 | toObject = ObjectBinary . UTF8.fromString 276 | 277 | fromObject (ObjectBinary o) = return $ UTF8.toString o 278 | fromObject (ObjectString o) = return $ UTF8.toString o 279 | fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o 280 | 281 | instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where 282 | toObject = ObjectArray . map toObject 283 | 284 | fromObject (ObjectArray os) = mapM fromObject os 285 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 286 | 287 | instance NvimObject o => NvimObject (Maybe o) where 288 | toObject = maybe ObjectNil toObject 289 | 290 | fromObject ObjectNil = return Nothing 291 | fromObject o = either throwError (return . Just) $ fromObject o 292 | 293 | instance NvimObject o => NvimObject (Vector o) where 294 | toObject = ObjectArray . V.toList . V.map toObject 295 | 296 | fromObject (ObjectArray os) = V.fromList <$> mapM fromObject os 297 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 298 | 299 | -- | Right-biased instance for toObject. 300 | instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where 301 | toObject = either toObject toObject 302 | 303 | fromObject o = case fromObject o of 304 | Right r -> 305 | return $ Right r 306 | Left e1 -> case fromObject o of 307 | Right l -> 308 | return $ Left l 309 | Left e2 -> 310 | throwError $ e1 <+> "--" <+> e2 311 | 312 | instance 313 | (Ord key, NvimObject key, NvimObject val) => 314 | NvimObject (SMap.Map key val) 315 | where 316 | toObject = 317 | ObjectMap 318 | . SMap.fromList 319 | . map (toObject *** toObject) 320 | . SMap.toList 321 | 322 | fromObject (ObjectMap om) = 323 | SMap.fromList 324 | <$> ( traverse 325 | ( uncurry (liftA2 (,)) 326 | . (fromObject *** fromObject) 327 | ) 328 | . SMap.toList 329 | ) 330 | om 331 | fromObject o = throwError $ "Expected ObjectMap, but got" <+> viaShow o 332 | 333 | instance NvimObject Text where 334 | toObject = ObjectBinary . encodeUtf8 335 | 336 | fromObject (ObjectBinary o) = return $ decodeUtf8 o 337 | fromObject (ObjectString o) = return $ decodeUtf8 o 338 | fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o 339 | 340 | instance NvimObject ByteString where 341 | toObject = ObjectBinary 342 | 343 | fromObject (ObjectBinary o) = return o 344 | fromObject (ObjectString o) = return o 345 | fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o 346 | 347 | instance NvimObject Object where 348 | toObject = id 349 | 350 | fromObject = return 351 | fromObjectUnsafe = id 352 | 353 | -- By the magic of vim, i will create these. 354 | instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where 355 | toObject (o1, o2) = ObjectArray [toObject o1, toObject o2] 356 | 357 | fromObject (ObjectArray [o1, o2]) = 358 | (,) 359 | <$> fromObject o1 360 | <*> fromObject o2 361 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 362 | 363 | instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where 364 | toObject (o1, o2, o3) = ObjectArray [toObject o1, toObject o2, toObject o3] 365 | 366 | fromObject (ObjectArray [o1, o2, o3]) = 367 | (,,) 368 | <$> fromObject o1 369 | <*> fromObject o2 370 | <*> fromObject o3 371 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 372 | 373 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where 374 | toObject (o1, o2, o3, o4) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4] 375 | 376 | fromObject (ObjectArray [o1, o2, o3, o4]) = 377 | (,,,) 378 | <$> fromObject o1 379 | <*> fromObject o2 380 | <*> fromObject o3 381 | <*> fromObject o4 382 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 383 | 384 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where 385 | toObject (o1, o2, o3, o4, o5) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5] 386 | 387 | fromObject (ObjectArray [o1, o2, o3, o4, o5]) = 388 | (,,,,) 389 | <$> fromObject o1 390 | <*> fromObject o2 391 | <*> fromObject o3 392 | <*> fromObject o4 393 | <*> fromObject o5 394 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 395 | 396 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where 397 | toObject (o1, o2, o3, o4, o5, o6) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6] 398 | 399 | fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) = 400 | (,,,,,) 401 | <$> fromObject o1 402 | <*> fromObject o2 403 | <*> fromObject o3 404 | <*> fromObject o4 405 | <*> fromObject o5 406 | <*> fromObject o6 407 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 408 | 409 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) where 410 | toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7] 411 | 412 | fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) = 413 | (,,,,,,) 414 | <$> fromObject o1 415 | <*> fromObject o2 416 | <*> fromObject o3 417 | <*> fromObject o4 418 | <*> fromObject o5 419 | <*> fromObject o6 420 | <*> fromObject o7 421 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 422 | 423 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8) where 424 | toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8] 425 | 426 | fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) = 427 | (,,,,,,,) 428 | <$> fromObject o1 429 | <*> fromObject o2 430 | <*> fromObject o3 431 | <*> fromObject o4 432 | <*> fromObject o5 433 | <*> fromObject o6 434 | <*> fromObject o7 435 | <*> fromObject o8 436 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 437 | 438 | instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8, NvimObject o9) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) where 439 | toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8, toObject o9] 440 | 441 | fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) = 442 | (,,,,,,,,) 443 | <$> fromObject o1 444 | <*> fromObject o2 445 | <*> fromObject o3 446 | <*> fromObject o4 447 | <*> fromObject o5 448 | <*> fromObject o6 449 | <*> fromObject o7 450 | <*> fromObject o8 451 | <*> fromObject o9 452 | fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o 453 | 454 | -- 1}}} 455 | -------------------------------------------------------------------------------- /src/Neovim/Compat/Megaparsec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | module Neovim.Compat.Megaparsec 3 | ( Parser 4 | , module X 5 | #if MIN_VERSION_megaparsec(7,0,0) 6 | , anyChar 7 | #endif 8 | ) where 9 | 10 | 11 | import Text.Megaparsec as X 12 | 13 | #if MIN_VERSION_megaparsec(6,0,0) 14 | 15 | import Data.Void 16 | import Text.Megaparsec.Char as X 17 | 18 | type Parser = Parsec Void String 19 | 20 | #else 21 | 22 | import Text.Megaparsec.String as X 23 | 24 | #endif 25 | 26 | #if MIN_VERSION_megaparsec(7,0,0) 27 | anyChar :: Parser Char 28 | anyChar = anySingle 29 | #endif 30 | 31 | -------------------------------------------------------------------------------- /src/Neovim/Config.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Neovim.Config 3 | Description : The user editable and compilable configuration 4 | Copyright : (c) Sebastian Witte 5 | License : Apache-2.0 6 | 7 | Maintainer : woozletoff@gmail.com 8 | Stability : experimental 9 | -} 10 | module Neovim.Config ( 11 | NeovimConfig (..), 12 | module System.Log, 13 | ) where 14 | 15 | import Neovim.Context (Neovim) 16 | import Neovim.Plugin.Internal (NeovimPlugin) 17 | 18 | import System.Log (Priority (..)) 19 | 20 | {- | This data type contains information about the configuration of neovim. See 21 | the fields' documentation for what you possibly want to change. Also, the 22 | tutorial in the "Neovim" module should get you started. 23 | -} 24 | data NeovimConfig = Config 25 | { -- | The list of plugins. The IO type inside the list allows the plugin 26 | -- author to run some arbitrary startup code before creating a value of 27 | -- type 'NeovimPlugin'. 28 | plugins :: [Neovim () NeovimPlugin] 29 | , -- | Set the general logging options. 30 | logOptions :: Maybe (FilePath, Priority) 31 | } 32 | -------------------------------------------------------------------------------- /src/Neovim/Context.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {- | 3 | Module : Neovim.Context 4 | Description : The Neovim context 5 | Copyright : (c) Sebastian Witte 6 | License : Apache-2.0 7 | 8 | Maintainer : woozletoff@gmail.com 9 | Stability : experimental 10 | -} 11 | module Neovim.Context ( 12 | newUniqueFunctionName, 13 | Neovim, 14 | NeovimException (..), 15 | exceptionToDoc, 16 | FunctionMap, 17 | FunctionMapEntry, 18 | mkFunctionMap, 19 | runNeovim, 20 | err, 21 | errOnInvalidResult, 22 | restart, 23 | quit, 24 | subscribe, 25 | unsubscribe, 26 | ask, 27 | asks, 28 | get, 29 | gets, 30 | put, 31 | modify, 32 | Doc, 33 | AnsiStyle, 34 | docToText, 35 | throwError, 36 | module Control.Monad.IO.Class, 37 | ) where 38 | 39 | import Neovim.Classes 40 | import Neovim.Context.Internal ( 41 | FunctionMap, 42 | FunctionMapEntry, 43 | Neovim, 44 | mkFunctionMap, 45 | newUniqueFunctionName, 46 | runNeovim, 47 | subscribe, 48 | unsubscribe, 49 | ) 50 | import Neovim.Exceptions (NeovimException (..), exceptionToDoc) 51 | 52 | import qualified Neovim.Context.Internal as Internal 53 | 54 | import Control.Concurrent (putMVar) 55 | import Control.Exception 56 | import Control.Monad.Except 57 | import Control.Monad.IO.Class 58 | import Control.Monad.Reader 59 | import Control.Monad.State 60 | import Data.MessagePack (Object) 61 | 62 | -- | @'throw'@ specialized to a 'Pretty' value. 63 | err :: Doc AnsiStyle -> Neovim env a 64 | err = throw . ErrorMessage 65 | 66 | errOnInvalidResult :: 67 | (NvimObject o) => 68 | Neovim env (Either NeovimException Object) -> 69 | Neovim env o 70 | errOnInvalidResult a = 71 | a >>= \case 72 | Left o -> 73 | (err . exceptionToDoc) o 74 | Right o -> case fromObject o of 75 | Left e -> 76 | err e 77 | Right x -> 78 | return x 79 | 80 | -- | Initiate a restart of the plugin provider. 81 | restart :: Neovim env () 82 | restart = liftIO . flip putMVar Internal.Restart =<< Internal.asks' Internal.transitionTo 83 | 84 | -- | Initiate the termination of the plugin provider. 85 | quit :: Neovim env () 86 | quit = liftIO . flip putMVar Internal.Quit =<< Internal.asks' Internal.transitionTo 87 | -------------------------------------------------------------------------------- /src/Neovim/Context/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 5 | {-# LANGUAGE LambdaCase #-} 6 | {-# LANGUAGE MultiParamTypeClasses #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | 9 | {- | 10 | Module : Neovim.Context.Internal 11 | Description : Abstract description of the plugin provider's internal context 12 | Copyright : (c) Sebastian Witte 13 | License : Apache-2.0 14 | 15 | Maintainer : woozletoff@gmail.com 16 | Stability : experimental 17 | Portability : GHC 18 | 19 | To shorten function and data type names, import this qualfied as @Internal@. 20 | -} 21 | module Neovim.Context.Internal where 22 | 23 | import Neovim.Classes ( 24 | AnsiStyle, 25 | Doc, 26 | NFData, 27 | Pretty (pretty), 28 | ) 29 | import Neovim.Exceptions ( 30 | NeovimException (..), 31 | exceptionToDoc, 32 | ) 33 | import Neovim.Plugin.Classes ( 34 | FunctionName (..), 35 | FunctionalityDescription, 36 | HasFunctionName (nvimMethod), 37 | NeovimEventId (..), 38 | NvimMethod, 39 | Subscription (..), 40 | SubscriptionId (..), 41 | ) 42 | import Neovim.Plugin.IPC (SomeMessage) 43 | 44 | import Control.Monad.IO.Class (MonadIO) 45 | import Data.Functor (void) 46 | import Data.Map (Map) 47 | import qualified Data.Map as Map 48 | import Data.MessagePack (Object) 49 | import Data.Monoid (Ap (Ap)) 50 | import Data.Text (Text, pack) 51 | import System.Log.Logger (errorM) 52 | import UnliftIO ( 53 | Exception (fromException), 54 | Handler (..), 55 | MVar, 56 | MonadIO (..), 57 | MonadUnliftIO, 58 | SomeException, 59 | TMVar, 60 | TQueue, 61 | TVar, 62 | atomically, 63 | catches, 64 | modifyTVar', 65 | newEmptyMVar, 66 | newEmptyTMVarIO, 67 | newTMVarIO, 68 | newTQueueIO, 69 | newTVarIO, 70 | putTMVar, 71 | readTVar, 72 | takeTMVar, 73 | throwIO, 74 | try, 75 | ) 76 | 77 | import Prettyprinter (viaShow) 78 | 79 | import Conduit (MonadThrow) 80 | import Control.Exception ( 81 | ArithException, 82 | ArrayException, 83 | ErrorCall, 84 | PatternMatchFail, 85 | ) 86 | import qualified Control.Monad.Fail as Fail 87 | import Control.Monad.Reader ( 88 | MonadReader (ask, local), 89 | ReaderT (..), 90 | asks, 91 | ) 92 | import Prelude 93 | import Control.DeepSeq (deepseq) 94 | 95 | {- | This is the environment in which all plugins are initially started. 96 | 97 | Functions have to run in this transformer stack to communicate with neovim. 98 | If parts of your own functions dont need to communicate with neovim, it is 99 | good practice to factor them out. This allows you to write tests and spot 100 | errors easier. Essentially, you should treat this similar to 'IO' in general 101 | haskell programs. 102 | -} 103 | newtype Neovim env a = Neovim 104 | {unNeovim :: ReaderT (Config env) IO a} 105 | deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO) 106 | deriving (Semigroup, Monoid) via (Ap (Neovim env) a) 107 | 108 | -- | User facing instance declaration for the reader state. 109 | instance MonadReader env (Neovim env) where 110 | ask = Neovim $ asks customConfig 111 | local f (Neovim a) = do 112 | r <- Neovim ask 113 | liftIO $ runReaderT a (r{customConfig = f (customConfig r)}) 114 | 115 | instance Fail.MonadFail (Neovim env) where 116 | fail = throwIO . ErrorMessage . pretty 117 | 118 | -- | Same as 'ask' for the 'InternalConfig'. 119 | ask' :: Neovim env (Config env) 120 | ask' = Neovim ask 121 | 122 | -- | Same as 'asks' for the 'InternalConfig'. 123 | asks' :: (Config env -> a) -> Neovim env a 124 | asks' = Neovim . asks 125 | 126 | exceptionHandlers :: [Handler IO (Either (Doc ann) a)] 127 | exceptionHandlers = 128 | [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)" 129 | , Handler $ \(_ :: ArrayException) -> ret "ArrayException" 130 | , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error" 131 | , Handler $ \(_ :: PatternMatchFail) -> ret "Pattern match failure" 132 | , Handler $ \(_ :: SomeException) -> ret "Unhandled exception" 133 | ] 134 | where 135 | ret = return . Left 136 | 137 | -- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'. 138 | runNeovim :: 139 | NFData a => 140 | Config env -> 141 | Neovim env a -> 142 | IO (Either (Doc AnsiStyle) a) 143 | runNeovim = runNeovimInternal (\a -> a `deepseq` return a) 144 | 145 | runNeovimInternal :: 146 | (a -> IO a) -> 147 | Config env -> 148 | Neovim env a -> 149 | IO (Either (Doc AnsiStyle) a) 150 | runNeovimInternal f r (Neovim a) = 151 | (try . runReaderT a) r >>= \case 152 | Left e -> case fromException e of 153 | Just e' -> 154 | return . Left . exceptionToDoc $ (e' :: NeovimException) 155 | Nothing -> do 156 | liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e 157 | (return . Left . viaShow) e 158 | Right res -> 159 | (Right <$> f res) `catches` exceptionHandlers 160 | 161 | {- | Create a new unique function name. To prevent possible name clashes, digits 162 | are stripped from the given suffix. 163 | -} 164 | newUniqueFunctionName :: Neovim env FunctionName 165 | newUniqueFunctionName = do 166 | tu <- asks' uniqueCounter 167 | -- reverseing the integer string should distribute the first character more 168 | -- evently and hence cause faster termination for comparisons. 169 | fmap (F . pack . reverse . show) . liftIO . atomically $ do 170 | u <- readTVar tu 171 | modifyTVar' tu succ 172 | return u 173 | 174 | {- | This data type is used to dispatch a remote function call to the appopriate 175 | recipient. 176 | -} 177 | newtype FunctionType 178 | = -- | 'Stateful' functions are handled within a special thread, the 'TQueue' 179 | -- is the communication endpoint for the arguments we have to pass. 180 | Stateful (TQueue SomeMessage) 181 | 182 | instance Pretty FunctionType where 183 | pretty = \case 184 | Stateful _ -> "\\os -> Neovim env o" 185 | 186 | -- | Type of the values stored in the function map. 187 | type FunctionMapEntry = (FunctionalityDescription, FunctionType) 188 | 189 | {- | A function map is a map containing the names of functions as keys and some 190 | context dependent value which contains all the necessary information to 191 | execute that function in the intended way. 192 | 193 | This type is only used internally and handles two distinct cases. One case 194 | is a direct function call, wich is simply a function that accepts a list of 195 | 'Object' values and returns a result in the 'Neovim' context. The second 196 | case is calling a function that has a persistent state. This is mediated to 197 | a thread that reads from a 'TQueue'. (NB: persistent currently means, that 198 | state is stored for as long as the plugin provider is running and not 199 | restarted.) 200 | -} 201 | type FunctionMap = Map NvimMethod FunctionMapEntry 202 | 203 | -- | Create a new function map from the given list of 'FunctionMapEntry' values. 204 | mkFunctionMap :: [FunctionMapEntry] -> FunctionMap 205 | mkFunctionMap = Map.fromList . map (\e -> (nvimMethod (fst e), e)) 206 | 207 | data Subscriptions = Subscriptions 208 | { nextSubscriptionId :: SubscriptionId 209 | , byEventId :: Map NeovimEventId [Subscription] 210 | } 211 | 212 | {- | Subscribe to an event. When the event is received, the given callback function 213 | is run. It is usually necessary to call the appropriate API function in order for 214 | /neovim/ to send the notifications to /nvim-hs/. The returned subscription can be 215 | used to 'unsubscribe'. 216 | -} 217 | subscribe :: Text -> ([Object] -> Neovim env ()) -> Neovim env Subscription 218 | subscribe event action = do 219 | let eventId = NeovimEventId event 220 | cfg <- ask' 221 | let subscriptions' = subscriptions cfg 222 | atomically $ do 223 | s <- takeTMVar subscriptions' 224 | let subscriptionId = nextSubscriptionId s 225 | let newSubscription = 226 | Subscription 227 | { subId = subscriptionId 228 | , subEventId = eventId 229 | , subAction = void . runNeovim cfg . action 230 | } 231 | putTMVar 232 | subscriptions' 233 | s 234 | { nextSubscriptionId = succ subscriptionId 235 | , byEventId = Map.insertWith (<>) eventId [newSubscription] (byEventId s) 236 | } 237 | pure newSubscription 238 | 239 | -- | Remove the subscription that has been returned by 'subscribe'. 240 | unsubscribe :: Subscription -> Neovim env () 241 | unsubscribe subscription = do 242 | subscriptions' <- asks' subscriptions 243 | void . atomically $ do 244 | s <- takeTMVar subscriptions' 245 | let eventId = subEventId subscription 246 | deleteSubscription = Just . filter ((/= subId subscription) . subId) 247 | putTMVar 248 | subscriptions' 249 | s 250 | { byEventId = Map.update deleteSubscription eventId (byEventId s) 251 | } 252 | 253 | {- | A wrapper for a reader value that contains extra fields required to 254 | communicate with the messagepack-rpc components and provide necessary data to 255 | provide other globally available operations. 256 | 257 | Note that you most probably do not want to change the fields prefixed with an 258 | underscore. 259 | -} 260 | data Config env = Config 261 | -- Global settings; initialized once 262 | { eventQueue :: TQueue SomeMessage 263 | -- ^ A queue of messages that the event handler will propagate to 264 | -- appropriate threads and handlers. 265 | , transitionTo :: MVar StateTransition 266 | -- ^ The main thread will wait for this 'MVar' to be filled with a value 267 | -- and then perform an action appropriate for the value of type 268 | -- 'StateTransition'. 269 | , providerName :: TMVar (Either String Int) 270 | -- ^ Since nvim-hs must have its "Neovim.RPC.SocketReader" and 271 | -- "Neovim.RPC.EventHandler" running to determine the actual channel id 272 | -- (i.e. the 'Int' value here) this field can only be set properly later. 273 | -- Hence, the value of this field is put in an 'TMVar'. 274 | -- Name that is used to identify this provider. Assigning such a name is 275 | -- done in the neovim config (e.g. ~\/.nvim\/nvimrc). 276 | , uniqueCounter :: TVar Integer 277 | -- ^ This 'TVar' is used to generate uniqe function names on the side of 278 | -- /nvim-hs/. This is useful if you don't want to overwrite existing 279 | -- functions or if you create autocmd functions. 280 | , globalFunctionMap :: TMVar FunctionMap 281 | -- ^ This map is used to dispatch received messagepack function calls to 282 | -- it's appropriate targets. 283 | , -- Local settings; intialized for each stateful component 284 | 285 | pluginSettings :: Maybe (PluginSettings env) 286 | -- ^ In a registered functionality this field contains a function (and 287 | -- possibly some context dependent values) to register new functionality. 288 | , subscriptions :: TMVar Subscriptions 289 | -- ^ Plugins can dynamically subscribe to events that neovim sends. 290 | , customConfig :: env 291 | -- ^ Plugin author supplyable custom configuration. Queried on the 292 | -- user-facing side with 'ask' or 'asks'. 293 | } 294 | 295 | {- | Convenient helper to create a new config for the given state and read-only 296 | config. 297 | 298 | Sets the 'pluginSettings' field to 'Nothing'. 299 | -} 300 | retypeConfig :: env -> Config anotherEnv -> Config env 301 | retypeConfig r cfg = cfg{pluginSettings = Nothing, customConfig = r} 302 | 303 | {- | This GADT is used to share information between stateless and stateful 304 | plugin threads since they work fundamentally in the same way. They both 305 | contain a function to register some functionality in the plugin provider 306 | as well as some values which are specific to the one or the other context. 307 | -} 308 | data PluginSettings env where 309 | StatefulSettings :: 310 | ( FunctionalityDescription -> 311 | ([Object] -> Neovim env Object) -> 312 | TQueue SomeMessage -> 313 | TVar (Map NvimMethod ([Object] -> Neovim env Object)) -> 314 | Neovim env (Maybe FunctionMapEntry) 315 | ) -> 316 | TQueue SomeMessage -> 317 | TVar (Map NvimMethod ([Object] -> Neovim env Object)) -> 318 | PluginSettings env 319 | 320 | {- | Create a new 'InternalConfig' object by providing the minimal amount of 321 | necessary information. 322 | 323 | This function should only be called once per /nvim-hs/ session since the 324 | arguments are shared across processes. 325 | -} 326 | newConfig :: IO (Maybe String) -> IO env -> IO (Config env) 327 | newConfig ioProviderName r = 328 | Config 329 | <$> newTQueueIO 330 | <*> newEmptyMVar 331 | <*> (maybe newEmptyTMVarIO (newTMVarIO . Left) =<< ioProviderName) 332 | <*> newTVarIO 100 333 | <*> newEmptyTMVarIO 334 | <*> pure Nothing 335 | <*> newTMVarIO (Subscriptions (SubscriptionId 1) mempty) 336 | <*> r 337 | 338 | -- | The state that the plugin provider wants to transition to. 339 | data StateTransition 340 | = -- | Quit the plugin provider. 341 | Quit 342 | | -- | Restart the plugin provider. 343 | Restart 344 | | -- | The plugin provider failed to start or some other error occured. 345 | Failure (Doc AnsiStyle) 346 | | -- | The plugin provider started successfully. 347 | InitSuccess 348 | deriving (Show) 349 | -------------------------------------------------------------------------------- /src/Neovim/Debug.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NamedFieldPuns #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Neovim.Debug 7 | Description : Utilities to debug Neovim and nvim-hs functionality 8 | Copyright : (c) Sebastian Witte 9 | License : Apache-2.0 10 | 11 | Maintainer : woozletoff@gmail.com 12 | Stability : experimental 13 | Portability : GHC 14 | -} 15 | module Neovim.Debug ( 16 | debug, 17 | debug', 18 | NvimHSDebugInstance (..), 19 | develMain, 20 | quitDevelMain, 21 | restartDevelMain, 22 | printGlobalFunctionMap, 23 | runNeovim, 24 | runNeovim', 25 | module Neovim, 26 | ) where 27 | 28 | import Neovim 29 | import Neovim.Classes 30 | import Neovim.Context (runNeovim) 31 | import qualified Neovim.Context.Internal as Internal 32 | import Neovim.Log (disableLogger) 33 | import Neovim.Main ( 34 | CommandLineOptions (..), 35 | runPluginProvider, 36 | ) 37 | import Neovim.RPC.Common (RPCConfig) 38 | 39 | import Control.Monad 40 | import qualified Data.Map as Map 41 | import Foreign.Store 42 | 43 | import UnliftIO.Async ( 44 | Async, 45 | async, 46 | cancel, 47 | ) 48 | import UnliftIO.Concurrent (putMVar, takeMVar) 49 | import UnliftIO.STM 50 | 51 | import Prettyprinter ( 52 | nest, 53 | softline, 54 | vcat, 55 | vsep, 56 | ) 57 | 58 | import Prelude 59 | 60 | {- | Run a 'Neovim' function. 61 | 62 | This function connects to the socket pointed to by the environment variable 63 | @$NVIM@ and executes the command. It does not register itself 64 | as a real plugin provider, you can simply call neovim-functions from the 65 | module "Neovim.API.String" this way. 66 | 67 | Tip: If you run a terminal inside a neovim instance, then this variable is 68 | automatically set. 69 | -} 70 | debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a) 71 | debug env a = disableLogger $ do 72 | runPluginProvider def{envVar = True} Nothing transitionHandler 73 | where 74 | transitionHandler tids cfg = 75 | takeMVar (Internal.transitionTo cfg) >>= \case 76 | Internal.Failure e -> 77 | return $ Left e 78 | Internal.InitSuccess -> do 79 | res <- 80 | Internal.runNeovimInternal 81 | return 82 | (cfg{Internal.customConfig = env, Internal.pluginSettings = Nothing}) 83 | a 84 | 85 | mapM_ cancel tids 86 | return res 87 | _ -> 88 | return . Left $ "Unexpected transition state." 89 | 90 | {- | Run a 'Neovim'' function. 91 | 92 | @ 93 | debug' = debug () 94 | @ 95 | 96 | See documentation for 'debug'. 97 | -} 98 | debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a) 99 | debug' = debug () 100 | 101 | {- | Simple datatype storing neccessary information to start, stop and reload a 102 | set of plugins. This is passed to most of the functions in this module for 103 | storing state even when the ghci-session has been reloaded. 104 | -} 105 | data NvimHSDebugInstance = NvimHSDebugInstance 106 | { threads :: [Async ()] 107 | , neovimConfig :: NeovimConfig 108 | , internalConfig :: Internal.Config RPCConfig 109 | } 110 | 111 | {- | This function is intended to be run _once_ in a ghci session that to 112 | give a REPL based workflow when developing a plugin. 113 | 114 | Note that the dyre-based reload mechanisms, i.e. the 115 | "Neovim.Plugin.ConfigHelper" plugin, is not started this way. 116 | 117 | To use this in ghci, you simply bind the results to some variables. After 118 | each reload of ghci, you have to rebind those variables. 119 | 120 | Example: 121 | 122 | @ 123 | λ di <- 'develMain' 'Nothing' 124 | 125 | λ 'runNeovim'' di \$ vim_call_function \"getqflist\" [] 126 | 'Right' ('Right' ('ObjectArray' [])) 127 | 128 | λ :r 129 | 130 | λ di <- 'develMain' 'Nothing' 131 | @ 132 | 133 | You can also create a GHCI alias to get rid of most the busy-work: 134 | @ 135 | :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\" 136 | @ 137 | -} 138 | develMain :: 139 | NeovimConfig -> 140 | IO (Maybe NvimHSDebugInstance) 141 | develMain neovimConfig = 142 | lookupStore 0 >>= \case 143 | Nothing -> do 144 | x <- 145 | disableLogger $ 146 | runPluginProvider 147 | def{envVar = True} 148 | (Just neovimConfig) 149 | transitionHandler 150 | void $ newStore x 151 | return x 152 | Just x -> 153 | readStore x 154 | where 155 | transitionHandler tids cfg = 156 | takeMVar (Internal.transitionTo cfg) >>= \case 157 | Internal.Failure e -> do 158 | putDoc e 159 | return Nothing 160 | Internal.InitSuccess -> do 161 | transitionHandlerThread <- async $ do 162 | void $ transitionHandler tids cfg 163 | return . Just $ 164 | NvimHSDebugInstance 165 | { threads = transitionHandlerThread : tids 166 | , neovimConfig = neovimConfig 167 | , internalConfig = cfg 168 | } 169 | Internal.Quit -> do 170 | lookupStore 0 >>= \case 171 | Nothing -> 172 | return () 173 | Just x -> 174 | deleteStore x 175 | 176 | mapM_ cancel tids 177 | putStrLn "Quit develMain" 178 | return Nothing 179 | _ -> do 180 | putStrLn "Unexpected transition state for develMain." 181 | return Nothing 182 | 183 | -- | Quit a previously started plugin provider. 184 | quitDevelMain :: NvimHSDebugInstance -> IO () 185 | quitDevelMain NvimHSDebugInstance{internalConfig} = 186 | putMVar (Internal.transitionTo internalConfig) Internal.Quit 187 | 188 | -- | Restart the development plugin provider. 189 | restartDevelMain :: 190 | NvimHSDebugInstance -> 191 | IO (Maybe NvimHSDebugInstance) 192 | restartDevelMain di = do 193 | quitDevelMain di 194 | develMain (neovimConfig di) 195 | 196 | -- | Convenience function to run a stateless 'Neovim' function. 197 | runNeovim' :: 198 | NFData a => 199 | NvimHSDebugInstance -> 200 | Neovim () a -> 201 | IO (Either (Doc AnsiStyle) a) 202 | runNeovim' NvimHSDebugInstance{internalConfig} = 203 | runNeovim (Internal.retypeConfig () internalConfig) 204 | 205 | -- | Print the global function map to the console. 206 | printGlobalFunctionMap :: NvimHSDebugInstance -> IO () 207 | printGlobalFunctionMap NvimHSDebugInstance{internalConfig} = do 208 | es <- 209 | fmap Map.toList . atomically $ 210 | readTMVar (Internal.globalFunctionMap internalConfig) 211 | let header = "Printing global function map:" 212 | funs = 213 | map 214 | ( \(fname, (d, f)) -> 215 | nest 216 | 3 217 | ( pretty fname 218 | <> softline 219 | <> "->" 220 | <> softline 221 | <> pretty d 222 | <+> ":" 223 | <+> pretty f 224 | ) 225 | ) 226 | es 227 | putDoc $ 228 | nest 2 $ 229 | vsep [header, vcat funs, mempty] 230 | -------------------------------------------------------------------------------- /src/Neovim/Exceptions.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Neovim.Exceptions 7 | Description : General Exceptions 8 | Copyright : (c) Sebastian Witte 9 | License : Apache-2.0 10 | 11 | Maintainer : woozletoff@gmail.com 12 | Stability : experimental 13 | Portability : GHC 14 | -} 15 | module Neovim.Exceptions ( 16 | NeovimException (..), 17 | exceptionToDoc, 18 | catchNeovimException, 19 | ) where 20 | 21 | import Control.Exception (Exception) 22 | import Data.MessagePack (Object (..)) 23 | import Data.String (IsString (..)) 24 | import Data.Typeable (Typeable) 25 | import Prettyprinter (Doc, viaShow, (<+>)) 26 | import Prettyprinter.Render.Terminal (AnsiStyle) 27 | import UnliftIO (MonadUnliftIO, catch) 28 | 29 | -- | Exceptions specific to /nvim-hs/. 30 | data NeovimException 31 | = -- | Simple error message that is passed to neovim. It should currently only 32 | -- contain one line of text. 33 | ErrorMessage (Doc AnsiStyle) 34 | | -- | Error that can be returned by a remote API call. The 'Doc' argument is 35 | -- the name of the remote function that threw this exception. 36 | ErrorResult (Doc AnsiStyle) Object 37 | deriving (Typeable, Show) 38 | 39 | instance Exception NeovimException 40 | 41 | instance IsString NeovimException where 42 | fromString = ErrorMessage . fromString 43 | 44 | exceptionToDoc :: NeovimException -> Doc AnsiStyle 45 | exceptionToDoc = \case 46 | ErrorMessage e -> 47 | "Error message:" <+> e 48 | ErrorResult fn o -> 49 | "Function" <+> fn <+> "has thrown an error:" <+> viaShow o 50 | 51 | -- | Specialization of 'catch' for 'NeovimException's. 52 | catchNeovimException :: MonadUnliftIO io => io a -> (NeovimException -> io a) -> io a 53 | catchNeovimException action exceptionHandler = action `catch` exceptionHandler 54 | -------------------------------------------------------------------------------- /src/Neovim/Log.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Neovim.Log 3 | Description : Logging utilities and reexports 4 | Copyright : (c) Sebastian Witte 5 | License : Apache-2.0 6 | 7 | Maintainer : woozletoff@gmail.com 8 | Stability : experimental 9 | Portability : GHC 10 | -} 11 | module Neovim.Log ( 12 | disableLogger, 13 | withLogger, 14 | module System.Log.Logger, 15 | ) where 16 | 17 | import Control.Exception 18 | import System.Log.Formatter (simpleLogFormatter) 19 | import System.Log.Handler (setFormatter) 20 | import System.Log.Handler.Simple 21 | import System.Log.Logger 22 | 23 | -- | Disable logging to stderr. 24 | disableLogger :: IO a -> IO a 25 | disableLogger action = do 26 | updateGlobalLogger rootLoggerName removeHandler 27 | action 28 | 29 | {- | Initialize the root logger to avoid stderr and set it to log the given 30 | file instead. Simply wrap the main entry point with this function to 31 | initialze the logger. 32 | 33 | @ 34 | main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do 35 | 'putStrLn' "Hello, World!" 36 | @ 37 | -} 38 | withLogger :: FilePath -> Priority -> IO a -> IO a 39 | withLogger fp p action = 40 | bracket 41 | setupRootLogger 42 | (\fh -> closeFunc fh (privData fh)) 43 | (const action) 44 | where 45 | setupRootLogger = do 46 | -- We shouldn't log to stderr or stdout as it is not unlikely that our 47 | -- messagepack communication is handled via those channels. 48 | disableLogger (return ()) 49 | -- Log to the given file instead 50 | fh <- fileHandler fp p 51 | -- Adjust logging format 52 | let fh' = setFormatter fh (simpleLogFormatter "[$loggername : $prio] $msg") 53 | -- Adjust the log level as well 54 | updateGlobalLogger rootLoggerName (setLevel p . addHandler fh') 55 | -- For good measure, log some debug information 56 | logM "Neovim.Debug" DEBUG $ 57 | unwords ["Initialized root looger with priority", show p, "and file: ", fp] 58 | return fh' 59 | -------------------------------------------------------------------------------- /src/Neovim/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {- | 5 | Module : Neovim.Main 6 | Description : Wrapper for the actual main function 7 | Copyright : (c) Sebastian Witte 8 | License : Apache-2.0 9 | 10 | Maintainer : woozletoff@gmail.com 11 | Stability : experimental 12 | -} 13 | module Neovim.Main where 14 | 15 | import Neovim.Config ( 16 | NeovimConfig (logOptions, plugins), 17 | Priority (..), 18 | ) 19 | import qualified Neovim.Context.Internal as Internal 20 | import Neovim.Log (debugM, disableLogger, errorM, withLogger) 21 | import qualified Neovim.Plugin as P 22 | import Neovim.RPC.Common as RPC ( 23 | RPCConfig, 24 | SocketType (Environment, TCP, UnixSocket), 25 | createHandle, 26 | newRPCConfig, 27 | ) 28 | import Neovim.RPC.EventHandler (runEventHandler) 29 | import Neovim.RPC.SocketReader (runSocketReader) 30 | import Neovim.Util (oneLineErrorMessage) 31 | 32 | import Control.Monad (void) 33 | import Data.Default (Default (..)) 34 | import Options.Applicative ( 35 | Parser, 36 | ParserInfo, 37 | auto, 38 | execParser, 39 | fullDesc, 40 | header, 41 | help, 42 | helper, 43 | info, 44 | long, 45 | metavar, 46 | option, 47 | optional, 48 | progDesc, 49 | short, 50 | strArgument, 51 | strOption, 52 | switch, 53 | ) 54 | import System.IO (stdin, stdout) 55 | import UnliftIO (Async, async, putMVar, atomically, putTMVar, takeMVar) 56 | import Control.Applicative ((<|>)) 57 | 58 | import Prelude 59 | 60 | logger :: String 61 | logger = "Neovim.Main" 62 | 63 | data CommandLineOptions = Opt 64 | { providerName :: Maybe String 65 | , hostPort :: Maybe (String, Int) 66 | , unix :: Maybe FilePath 67 | , envVar :: Bool 68 | , logOpts :: Maybe (FilePath, Priority) 69 | } 70 | 71 | instance Default CommandLineOptions where 72 | def = 73 | Opt 74 | { providerName = Nothing 75 | , hostPort = Nothing 76 | , unix = Nothing 77 | , envVar = False 78 | , logOpts = Nothing 79 | } 80 | 81 | optParser :: Parser CommandLineOptions 82 | optParser = 83 | Opt 84 | <$> optional 85 | ( strArgument 86 | ( metavar "NAME" 87 | <> help 88 | ( unlines 89 | [ "Name that associates the plugin provider with neovim." 90 | , "This option has only an effect if you start nvim-hs" 91 | , "with rpcstart()/jobstart() and use the factory method approach." 92 | , "Since it is extremely hard to figure that out inside" 93 | , "nvim-hs, this option is assumed to used if the input" 94 | , "and output is tied to standard in and standard out." 95 | ] 96 | ) 97 | ) 98 | ) 99 | <*> optional 100 | ( (,) 101 | <$> strOption 102 | ( long "host" 103 | <> short 'a' 104 | <> metavar "HOSTNAME" 105 | <> help "Connect to the specified host. (requires -p)" 106 | ) 107 | <*> option 108 | auto 109 | ( long "port" 110 | <> short 'p' 111 | <> metavar "PORT" 112 | <> help "Connect to the specified port. (requires -a)" 113 | ) 114 | ) 115 | <*> optional 116 | ( strOption 117 | ( long "unix" 118 | <> short 'u' 119 | <> help "Connect to the given unix domain socket." 120 | ) 121 | ) 122 | <*> switch 123 | ( long "environment" 124 | <> short 'e' 125 | <> help "Read connection information from $NVIM." 126 | ) 127 | <*> optional 128 | ( (,) 129 | <$> strOption 130 | ( long "log-file" 131 | <> short 'l' 132 | <> help "File to log to." 133 | ) 134 | <*> option 135 | auto 136 | ( long "log-level" 137 | <> short 'v' 138 | <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels) 139 | ) 140 | ) 141 | where 142 | -- [minBound..maxBound] would have been nice here. 143 | logLevels :: [Priority] 144 | logLevels = [DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY] 145 | 146 | opts :: ParserInfo CommandLineOptions 147 | opts = 148 | info 149 | (helper <*> optParser) 150 | ( fullDesc 151 | <> header "Start a neovim plugin provider for Haskell plugins." 152 | <> progDesc "This is still work in progress. Feel free to contribute." 153 | ) 154 | 155 | {- | This is essentially the main function for /nvim-hs/, at least if you want 156 | to use "Config.Dyre" for the configuration. 157 | -} 158 | neovim :: NeovimConfig -> IO () 159 | neovim = realMain standalone 160 | 161 | {- | A 'TransitionHandler' function receives the 'ThreadId's of all running 162 | threads which have been started by the plugin provider as well as the 163 | 'Internal.Config' with the custom field set to 'RPCConfig'. These information 164 | can be used to properly clean up a session and then do something else. 165 | The transition handler is first called after the plugin provider has started. 166 | -} 167 | type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a 168 | 169 | {- | This main functions can be used to create a custom executable without 170 | using the "Config.Dyre" library while still using the /nvim-hs/ specific 171 | configuration facilities. 172 | -} 173 | realMain :: 174 | TransitionHandler a -> 175 | NeovimConfig -> 176 | IO () 177 | realMain transitionHandler cfg = do 178 | os <- execParser opts 179 | maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do 180 | debugM logger "Starting up neovim haskell plguin provider" 181 | void $ runPluginProvider os (Just cfg) transitionHandler 182 | 183 | -- | Generic main function. Most arguments are optional or have sane defaults. 184 | runPluginProvider :: 185 | -- | See /nvim-hs/ executables --help function or 'optParser' 186 | CommandLineOptions -> 187 | Maybe NeovimConfig -> 188 | TransitionHandler a -> 189 | IO a 190 | runPluginProvider os mcfg transitionHandler = case (hostPort os, unix os) of 191 | (Just (h, p), _) -> 192 | createHandle (TCP p h) >>= \s -> run s s 193 | (_, Just fp) -> 194 | createHandle (UnixSocket fp) >>= \s -> run s s 195 | _ 196 | | envVar os -> 197 | createHandle Environment >>= \s -> run s s 198 | _ -> 199 | run stdout stdin 200 | where 201 | run evHandlerHandle sockreaderHandle = do 202 | -- The plugins to register depend on the given arguments and may need 203 | -- special initialization methods. 204 | let allPlugins = maybe [] plugins mcfg 205 | 206 | conf <- Internal.newConfig (pure (providerName os)) newRPCConfig 207 | 208 | ehTid <- 209 | async $ 210 | runEventHandler 211 | evHandlerHandle 212 | conf{Internal.pluginSettings = Nothing} 213 | 214 | srTid <- async $ runSocketReader sockreaderHandle conf 215 | 216 | let startupConf = Internal.retypeConfig () conf 217 | P.startPluginThreads startupConf allPlugins >>= \case 218 | Left e -> do 219 | errorM logger $ "Error initializing plugins: " <> show (oneLineErrorMessage e) 220 | putMVar (Internal.transitionTo conf) $ Internal.Failure e 221 | transitionHandler [ehTid, srTid] conf 222 | Right (funMapEntries, pluginTids) -> do 223 | atomically $ 224 | putTMVar 225 | (Internal.globalFunctionMap conf) 226 | (Internal.mkFunctionMap funMapEntries) 227 | putMVar (Internal.transitionTo conf) Internal.InitSuccess 228 | transitionHandler (srTid : ehTid : pluginTids) conf 229 | 230 | standalone :: TransitionHandler () 231 | standalone threads cfg = 232 | takeMVar (Internal.transitionTo cfg) >>= \case 233 | Internal.InitSuccess -> do 234 | debugM logger "Initialization Successful" 235 | standalone threads cfg 236 | Internal.Restart -> do 237 | errorM logger "Cannot restart" 238 | standalone threads cfg 239 | Internal.Failure e -> 240 | errorM logger . show $ oneLineErrorMessage e 241 | Internal.Quit -> 242 | return () 243 | -------------------------------------------------------------------------------- /src/Neovim/Plugin.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GADTs #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Neovim.Plugin 7 | Description : Plugin and functionality registration code 8 | Copyright : (c) Sebastian Witte 9 | License : Apache-2.0 10 | 11 | Maintainer : woozletoff@gmail.com 12 | Stability : experimental 13 | Portability : GHC 14 | -} 15 | module Neovim.Plugin ( 16 | startPluginThreads, 17 | wrapPlugin, 18 | NeovimPlugin, 19 | Plugin (..), 20 | Synchronous (..), 21 | CommandOption (..), 22 | addAutocmd, 23 | registerPlugin, 24 | registerFunctionality, 25 | getProviderName, 26 | ) where 27 | 28 | import Neovim.API.String 29 | ( nvim_err_writeln, nvim_get_api_info, vim_call_function ) 30 | import Neovim.Classes 31 | ( (<+>), 32 | Doc, 33 | AnsiStyle, 34 | Pretty(pretty), 35 | NvimObject(toObject, fromObject), 36 | Dictionary, 37 | (+:) ) 38 | import Neovim.Context 39 | ( MonadIO(liftIO), 40 | NeovimException, 41 | newUniqueFunctionName, 42 | runNeovim, 43 | FunctionMapEntry, 44 | Neovim, 45 | err ) 46 | import Neovim.Context.Internal ( 47 | FunctionType (..), 48 | runNeovimInternal, 49 | ) 50 | import qualified Neovim.Context.Internal as Internal 51 | import Neovim.Plugin.Classes 52 | ( HasFunctionName(nvimMethod), 53 | FunctionName(..), 54 | NeovimEventId(NeovimEventId), 55 | Synchronous(..), 56 | CommandOption(..), 57 | CommandOptions(getCommandOptions), 58 | AutocmdOptions(AutocmdOptions), 59 | FunctionalityDescription(..), 60 | NvimMethod(..) ) 61 | import Neovim.Plugin.IPC.Classes 62 | ( Notification(Notification), 63 | Request(Request), 64 | Message(fromMessage), 65 | SomeMessage, 66 | readSomeMessage ) 67 | import Neovim.Plugin.Internal 68 | ( NeovimPlugin(..), 69 | Plugin(..), 70 | getDescription, 71 | getFunction, 72 | wrapPlugin ) 73 | import Neovim.RPC.FunctionCall ( respond ) 74 | 75 | import Control.Monad (foldM, void) 76 | import Data.Foldable (forM_) 77 | import Data.Map (Map) 78 | import qualified Data.Map as Map 79 | import Data.Either (rights) 80 | import Data.MessagePack ( Object ) 81 | import Data.Text (Text) 82 | import Data.Traversable (forM) 83 | import System.Log.Logger ( debugM, errorM ) 84 | import UnliftIO.Async (Async, async, race) 85 | import UnliftIO.Concurrent (threadDelay) 86 | import UnliftIO.Exception (SomeException, catch, try) 87 | import UnliftIO.STM 88 | ( TVar, 89 | putTMVar, 90 | takeTMVar, 91 | tryReadTMVar, 92 | modifyTVar, 93 | TQueue, 94 | atomically, 95 | newTQueueIO, 96 | newTVarIO, 97 | readTVarIO ) 98 | 99 | import Prelude 100 | 101 | logger :: String 102 | logger = "Neovim.Plugin" 103 | 104 | startPluginThreads :: 105 | Internal.Config () -> 106 | [Neovim () NeovimPlugin] -> 107 | IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()])) 108 | startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], []) 109 | where 110 | go :: 111 | ([FunctionMapEntry], [Async ()]) -> 112 | Neovim () NeovimPlugin -> 113 | Neovim () ([FunctionMapEntry], [Async ()]) 114 | go (es, tids) iop = do 115 | NeovimPlugin p <- iop 116 | (es', tid) <- registerStatefulFunctionality p 117 | 118 | return (es ++ es', tid : tids) 119 | 120 | {- | Call the vimL functions to define a function, command or autocmd on the 121 | neovim side. Returns 'True' if registration was successful. 122 | 123 | Note that this does not have any effect on the side of /nvim-hs/. 124 | -} 125 | registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool 126 | registerWithNeovim = \case 127 | func@(Function (F functionName) s) -> do 128 | pName <- getProviderName 129 | let (defineFunction, host) = 130 | either 131 | (\n -> ("remote#define#FunctionOnHost", toObject n)) 132 | (\c -> ("remote#define#FunctionOnChannel", toObject c)) 133 | pName 134 | reportError (e :: NeovimException) = do 135 | liftIO . errorM logger $ 136 | "Failed to register function: " ++ show functionName ++ show e 137 | return False 138 | logSuccess = do 139 | liftIO . debugM logger $ 140 | "Registered function: " ++ show functionName 141 | return True 142 | 143 | flip catch reportError $ do 144 | void $ 145 | vim_call_function defineFunction $ 146 | host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: [] 147 | logSuccess 148 | cmd@(Command (F functionName) copts) -> do 149 | let sync = case getCommandOptions copts of 150 | -- This works because CommandOptions are sorted and CmdSync is 151 | -- the smallest element in the sorting 152 | (CmdSync s : _) -> s 153 | _ -> Sync 154 | 155 | pName <- getProviderName 156 | let (defineFunction, host) = 157 | either 158 | (\n -> ("remote#define#CommandOnHost", toObject n)) 159 | (\c -> ("remote#define#CommandOnChannel", toObject c)) 160 | pName 161 | reportError (e :: NeovimException) = do 162 | liftIO . errorM logger $ 163 | "Failed to register command: " ++ show functionName ++ show e 164 | return False 165 | logSuccess = do 166 | liftIO . debugM logger $ 167 | "Registered command: " ++ show functionName 168 | return True 169 | flip catch reportError $ do 170 | void $ 171 | vim_call_function defineFunction $ 172 | host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: [] 173 | logSuccess 174 | Autocmd acmdType (F functionName) sync opts -> do 175 | pName <- getProviderName 176 | let (defineFunction, host) = 177 | either 178 | (\n -> ("remote#define#AutocmdOnHost", toObject n)) 179 | (\c -> ("remote#define#AutocmdOnChannel", toObject c)) 180 | pName 181 | reportError (e :: NeovimException) = do 182 | liftIO . errorM logger $ 183 | "Failed to register autocmd: " ++ show functionName ++ show e 184 | return False 185 | logSuccess = do 186 | liftIO . debugM logger $ 187 | "Registered autocmd: " ++ show functionName 188 | return True 189 | flip catch reportError $ do 190 | void $ 191 | vim_call_function defineFunction $ 192 | host +: functionName +: sync +: acmdType +: opts +: [] 193 | logSuccess 194 | 195 | {- | Return or retrive the provider name that the current instance is associated 196 | with on the neovim side. 197 | -} 198 | getProviderName :: Neovim env (Either String Int) 199 | getProviderName = do 200 | mp <- Internal.asks' Internal.providerName 201 | (liftIO . atomically . tryReadTMVar) mp >>= \case 202 | Just p -> 203 | return p 204 | Nothing -> do 205 | api <- nvim_get_api_info 206 | case api of 207 | [] -> err "empty nvim_get_api_info" 208 | (i : _) -> do 209 | case fromObject i :: Either (Doc AnsiStyle) Int of 210 | Left _ -> 211 | err $ 212 | "Expected an integral value as the first" 213 | <+> "argument of nvim_get_api_info" 214 | Right channelId -> do 215 | liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId 216 | return . Right $ fromIntegral channelId 217 | 218 | registerFunctionality :: 219 | FunctionalityDescription -> 220 | ([Object] -> Neovim env Object) -> 221 | Neovim env (Either (Doc AnsiStyle) FunctionMapEntry) 222 | registerFunctionality d f = do 223 | Internal.asks' Internal.pluginSettings >>= \case 224 | Nothing -> do 225 | let msg = "Cannot register functionality in this context." 226 | liftIO $ errorM logger msg 227 | return $ Left $ pretty msg 228 | Just (Internal.StatefulSettings reg q m) -> 229 | reg d f q m >>= \case 230 | Just e -> do 231 | pure $ Right e 232 | Nothing -> 233 | pure $ Left "" 234 | 235 | registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env () 236 | registerInGlobalFunctionMap e = do 237 | liftIO . debugM logger $ "Adding function to global function map." ++ show (fst e) 238 | funMap <- Internal.asks' Internal.globalFunctionMap 239 | liftIO . atomically $ do 240 | m <- takeTMVar funMap 241 | putTMVar funMap $ Map.insert ((nvimMethod . fst) e) e m 242 | liftIO . debugM logger $ "Added function to global function map." ++ show (fst e) 243 | 244 | registerPlugin :: 245 | (FunctionMapEntry -> Neovim env ()) -> 246 | FunctionalityDescription -> 247 | ([Object] -> Neovim env Object) -> 248 | TQueue SomeMessage -> 249 | TVar (Map NvimMethod ([Object] -> Neovim env Object)) -> 250 | Neovim env (Maybe FunctionMapEntry) 251 | registerPlugin reg d f q tm = 252 | registerWithNeovim d >>= \case 253 | True -> do 254 | let n = nvimMethod d 255 | e = (d, Stateful q) 256 | liftIO . atomically . modifyTVar tm $ Map.insert n f 257 | reg e 258 | return (Just e) 259 | False -> 260 | return Nothing 261 | 262 | {- | Register an autocmd in the current context. This means that, if you are 263 | currently in a stateful plugin, the function will be called in the current 264 | thread and has access to the configuration and state of this thread. . 265 | 266 | Note that the function you pass must be fully applied. 267 | -} 268 | addAutocmd :: 269 | -- | The event to register to (e.g. BufWritePost) 270 | Text -> 271 | Synchronous -> 272 | AutocmdOptions -> 273 | -- | Fully applied function to register 274 | Neovim env () -> 275 | -- | A 'ReleaseKey' if the registration worked 276 | Neovim env (Either (Doc AnsiStyle) FunctionMapEntry) 277 | addAutocmd event s opts@AutocmdOptions{} f = do 278 | n <- newUniqueFunctionName 279 | registerFunctionality (Autocmd event n s opts) (\_ -> toObject <$> f) 280 | 281 | {- | Create a listening thread for events and add update the 'FunctionMap' with 282 | the corresponding 'TQueue's (i.e. communication channels). 283 | -} 284 | registerStatefulFunctionality :: 285 | Plugin env -> 286 | Neovim anyEnv ([FunctionMapEntry], Async ()) 287 | registerStatefulFunctionality (Plugin{environment = env, exports = fs}) = do 288 | messageQueue <- liftIO newTQueueIO 289 | route <- liftIO $ newTVarIO Map.empty 290 | subscribers <- liftIO $ newTVarIO [] 291 | 292 | cfg <- Internal.ask' 293 | 294 | let startupConfig = 295 | cfg 296 | { Internal.customConfig = env 297 | , Internal.pluginSettings = 298 | Just $ 299 | Internal.StatefulSettings 300 | (registerPlugin (\_ -> return ())) 301 | messageQueue 302 | route 303 | } 304 | res <- liftIO . runNeovimInternal return startupConfig . forM fs $ \f -> 305 | registerFunctionality (getDescription f) (getFunction f) 306 | es <- case res of 307 | Left e -> err e 308 | Right a -> return $ rights a 309 | 310 | let pluginThreadConfig = 311 | cfg 312 | { Internal.customConfig = env 313 | , Internal.pluginSettings = 314 | Just $ 315 | Internal.StatefulSettings 316 | (registerPlugin registerInGlobalFunctionMap) 317 | messageQueue 318 | route 319 | } 320 | 321 | tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do 322 | listeningThread messageQueue route subscribers 323 | 324 | return (es, tid) -- NB: dropping release functions/keys here 325 | where 326 | executeFunction :: 327 | ([Object] -> Neovim env Object) -> 328 | [Object] -> 329 | Neovim env (Either String Object) 330 | executeFunction f args = 331 | try (f args) >>= \case 332 | Left e -> return . Left $ show (e :: SomeException) 333 | Right res -> return $ Right res 334 | 335 | killAfterSeconds :: Word -> Neovim anyEnv () 336 | killAfterSeconds seconds = threadDelay (fromIntegral seconds * 1000 * 1000) 337 | 338 | timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String 339 | timeoutAndLog seconds functionName = do 340 | killAfterSeconds seconds 341 | return . show $ 342 | pretty functionName <+> "has been aborted after" 343 | <+> pretty seconds 344 | <+> "seconds" 345 | 346 | listeningThread :: 347 | TQueue SomeMessage -> 348 | TVar (Map NvimMethod ([Object] -> Neovim env Object)) -> 349 | TVar [Notification -> Neovim env ()] -> 350 | Neovim env () 351 | listeningThread q route subscribers = do 352 | msg <- readSomeMessage q 353 | 354 | forM_ (fromMessage msg) $ \req@(Request fun@(F methodName) _ args) -> do 355 | let method = NvimMethod methodName 356 | route' <- liftIO $ readTVarIO route 357 | forM_ (Map.lookup method route') $ \f -> do 358 | respond req . either Left id 359 | =<< race 360 | (timeoutAndLog 10 fun) 361 | (executeFunction f args) 362 | 363 | forM_ (fromMessage msg) $ \notification@(Notification (NeovimEventId methodName) args) -> do 364 | let method = NvimMethod methodName 365 | route' <- liftIO $ readTVarIO route 366 | forM_ (Map.lookup method route') $ \f -> 367 | void . async $ do 368 | result <- either Left id <$> race 369 | (timeoutAndLog 600 (F methodName)) 370 | (executeFunction f args) 371 | case result of 372 | Left message -> 373 | nvim_err_writeln message 374 | Right _ -> 375 | return () 376 | 377 | subscribers' <- liftIO $ readTVarIO subscribers 378 | forM_ subscribers' $ \subscriber -> 379 | async $ void $ race (subscriber notification) (killAfterSeconds 10) 380 | 381 | listeningThread q route subscribers 382 | -------------------------------------------------------------------------------- /src/Neovim/Plugin/Classes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | 7 | {- | 8 | Module : Neovim.Plugin.Classes 9 | Description : Classes and data types related to plugins 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | Portability : GHC 16 | -} 17 | module Neovim.Plugin.Classes ( 18 | FunctionalityDescription (..), 19 | FunctionName (..), 20 | NeovimEventId (..), 21 | SubscriptionId (..), 22 | Subscription (..), 23 | NvimMethod (..), 24 | Synchronous (..), 25 | CommandOption (..), 26 | CommandOptions, 27 | RangeSpecification (..), 28 | CommandArguments (..), 29 | getCommandOptions, 30 | mkCommandOptions, 31 | AutocmdOptions (..), 32 | HasFunctionName (..), 33 | ) where 34 | 35 | import Neovim.Classes 36 | 37 | import Control.Monad.Error.Class (MonadError (throwError)) 38 | import Data.Char (isDigit) 39 | import Data.Default (Default (..)) 40 | import Data.List (groupBy, sort) 41 | import qualified Data.Map as Map 42 | import Data.Maybe (catMaybes, mapMaybe) 43 | import Data.MessagePack (Object (..)) 44 | import Data.String (IsString (..)) 45 | import Data.Text (Text) 46 | import Prettyprinter (cat, comma, lparen, rparen, viaShow) 47 | 48 | import Prelude hiding (sequence) 49 | 50 | -- | Essentially just a string. 51 | newtype FunctionName = F Text 52 | deriving (Eq, Ord, Show, Read, Generic) 53 | deriving (NFData, Pretty) via Text 54 | 55 | newtype NeovimEventId = NeovimEventId Text 56 | deriving (Eq, Ord, Show, Read, Generic) 57 | deriving (Pretty) via Text 58 | deriving (NFData) via Text 59 | 60 | instance NvimObject NeovimEventId where 61 | toObject (NeovimEventId e) = toObject e 62 | fromObject o = NeovimEventId <$> fromObject o 63 | 64 | newtype SubscriptionId = SubscriptionId Int64 65 | deriving (Eq, Ord, Show, Read) 66 | deriving (Enum) via Int64 67 | 68 | data Subscription = Subscription 69 | { subId :: SubscriptionId 70 | , subEventId :: NeovimEventId 71 | , subAction :: [Object] -> IO () 72 | } 73 | 74 | {- | Functionality specific functional description entries. 75 | 76 | All fields which are directly specified in these constructors are not 77 | optional, but can partialy be generated via the Template Haskell functions. 78 | The last field is a data type that contains all relevant options with 79 | sensible defaults, hence 'def' can be used as an argument. 80 | -} 81 | data FunctionalityDescription 82 | = -- | Exported function. Callable via @call name(arg1,arg2)@. 83 | -- 84 | -- * Name of the function (must start with an uppercase letter) 85 | -- * Option to indicate how neovim should behave when calling this function 86 | Function FunctionName Synchronous 87 | | -- | Exported Command. Callable via @:Name arg1 arg2@. 88 | -- 89 | -- * Name of the command (must start with an uppercase letter) 90 | -- * Options to configure neovim's behavior for calling the command 91 | Command FunctionName CommandOptions 92 | | -- | Exported autocommand. Will call the given function if the type and 93 | -- filter match. 94 | -- 95 | -- NB: Since we are registering this on the Haskell side of things, the 96 | -- number of accepted arguments should be 0. 97 | -- 98 | -- * Type of the autocmd (e.g. \"BufWritePost\") 99 | -- * Name for the function to call 100 | -- * Whether to use rpcrequest or rpcnotify 101 | -- * Options for the autocmd (use 'def' here if you don't want to change anything) 102 | Autocmd Text FunctionName Synchronous AutocmdOptions 103 | deriving (Show, Read, Eq, Ord, Generic) 104 | 105 | instance NFData FunctionalityDescription 106 | 107 | instance Pretty FunctionalityDescription where 108 | pretty = \case 109 | Function fname s -> 110 | "Function" <+> pretty s <+> pretty fname 111 | Command fname copts -> 112 | "Command" <+> pretty copts <+> pretty fname 113 | Autocmd t fname s aopts -> 114 | "Autocmd" 115 | <+> pretty t 116 | <+> pretty s 117 | <+> pretty aopts 118 | <+> pretty fname 119 | 120 | {- | This option detemines how neovim should behave when calling some 121 | functionality on a remote host. 122 | -} 123 | data Synchronous 124 | = -- | Call the functionality entirely for its side effects and do not wait 125 | -- for it to finish. Calling a functionality with this flag set is 126 | -- completely asynchronous and nothing is really expected to happen. This 127 | -- is why a call like this is called notification on the neovim side of 128 | -- things. 129 | Async 130 | | -- | Call the function and wait for its result. This is only synchronous on 131 | -- the neovim side. This means that the GUI will (probably) not 132 | -- allow any user input until a reult is received. 133 | Sync 134 | deriving (Show, Read, Eq, Ord, Enum, Generic) 135 | 136 | instance NFData Synchronous 137 | 138 | instance Pretty Synchronous where 139 | pretty = \case 140 | Async -> "async" 141 | Sync -> "sync" 142 | 143 | instance IsString Synchronous where 144 | fromString = \case 145 | "sync" -> Sync 146 | "async" -> Async 147 | _ -> error "Only \"sync\" and \"async\" are valid string representations" 148 | 149 | instance NvimObject Synchronous where 150 | toObject = \case 151 | Async -> toObject False 152 | Sync -> toObject True 153 | 154 | fromObject = \case 155 | ObjectBool True -> return Sync 156 | ObjectBool False -> return Async 157 | ObjectInt 0 -> return Async 158 | _ -> return Sync 159 | 160 | {- | Options for commands. 161 | 162 | Some command can also be described by using the OverloadedString extensions. 163 | This means that you can write a literal 'String' inside your source file in 164 | place for a 'CommandOption' value. See the documentation for each value on 165 | how these strings should look like (Both versions are compile time checked.) 166 | -} 167 | data CommandOption 168 | = -- | Stringliteral "sync" or "async" 169 | CmdSync Synchronous 170 | | -- | Register passed to the command. 171 | -- 172 | -- Stringliteral: @\"\\\"\"@ 173 | CmdRegister 174 | | -- | Command takes a specific amount of arguments 175 | -- 176 | -- Automatically set via template haskell functions. You 177 | -- really shouldn't use this option yourself unless you have 178 | -- to. 179 | CmdNargs String 180 | | -- | Determines how neovim passes the range. 181 | -- 182 | -- Stringliterals: \"%\" for 'WholeFile', \",\" for line 183 | -- and \",123\" for 123 lines. 184 | CmdRange RangeSpecification 185 | | -- | Command handles a count. The argument defines the 186 | -- default count. 187 | -- 188 | -- Stringliteral: string of numbers (e.g. "132") 189 | CmdCount Word 190 | | -- | Command handles a bang 191 | -- 192 | -- Stringliteral: \"!\" 193 | CmdBang 194 | | -- | Verbatim string passed to the @-complete=@ command attribute 195 | CmdComplete String 196 | deriving (Eq, Ord, Show, Read, Generic) 197 | 198 | instance NFData CommandOption 199 | 200 | instance Pretty CommandOption where 201 | pretty = \case 202 | CmdSync s -> 203 | pretty s 204 | CmdRegister -> 205 | "\"" 206 | CmdNargs n -> 207 | pretty n 208 | CmdRange rs -> 209 | pretty rs 210 | CmdCount c -> 211 | pretty c 212 | CmdBang -> 213 | "!" 214 | CmdComplete cs -> 215 | pretty cs 216 | 217 | instance IsString CommandOption where 218 | fromString = \case 219 | "%" -> CmdRange WholeFile 220 | "\"" -> CmdRegister 221 | "!" -> CmdBang 222 | "sync" -> CmdSync Sync 223 | "async" -> CmdSync Async 224 | "," -> CmdRange CurrentLine 225 | ',' : ds | not (null ds) && all isDigit ds -> CmdRange (read ds) 226 | ds | not (null ds) && all isDigit ds -> CmdCount (read ds) 227 | _ -> error "Not a valid string for a CommandOptions. Check the docs!" 228 | 229 | {- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed 230 | object of this type is sorted and only contains zero or one object for each 231 | possible option. 232 | -} 233 | newtype CommandOptions = CommandOptions {getCommandOptions :: [CommandOption]} 234 | deriving (Eq, Ord, Show, Read, Generic) 235 | 236 | instance NFData CommandOptions 237 | 238 | instance Pretty CommandOptions where 239 | pretty (CommandOptions os) = 240 | cat $ map pretty os 241 | 242 | {- | Smart constructor for 'CommandOptions'. This sorts the command options and 243 | removes duplicate entries for semantically the same thing. Note that the 244 | smallest option stays for whatever ordering is defined. It is best to simply 245 | not define the same thing multiple times. 246 | -} 247 | mkCommandOptions :: [CommandOption] -> CommandOptions 248 | mkCommandOptions = CommandOptions . map head . groupBy constructor . sort 249 | where 250 | constructor a b = case (a, b) of 251 | _ | a == b -> True 252 | -- Only CmdSync and CmdNargs may fail for the equality check, 253 | -- so we just have to check those. 254 | (CmdSync _, CmdSync _) -> True 255 | (CmdRange _, CmdRange _) -> True 256 | -- Range and conut are mutually recursive. 257 | -- XXX Actually '-range=N' and '-count=N' are, but the code in 258 | -- remote#define#CommandOnChannel treats it exclusive as a whole. 259 | -- (see :h :command-range) 260 | (CmdRange _, CmdCount _) -> True 261 | (CmdNargs _, CmdNargs _) -> True 262 | _ -> False 263 | 264 | instance NvimObject CommandOptions where 265 | toObject (CommandOptions opts) = 266 | (toObject :: Dictionary -> Object) . Map.fromList $ mapMaybe addOption opts 267 | where 268 | addOption = \case 269 | CmdRange r -> Just ("range", toObject r) 270 | CmdCount n -> Just ("count", toObject n) 271 | CmdBang -> Just ("bang", ObjectBinary "") 272 | CmdRegister -> Just ("register", ObjectBinary "") 273 | CmdNargs n -> Just ("nargs", toObject n) 274 | CmdComplete cs -> Just ("complete", toObject cs) 275 | _ -> Nothing 276 | 277 | fromObject o = 278 | throwError $ 279 | "Did not expect to receive a CommandOptions object:" <+> viaShow o 280 | 281 | -- | Specification of a range that acommand can operate on. 282 | data RangeSpecification 283 | = -- | The line the cursor is at when the command is invoked. 284 | CurrentLine 285 | | -- | Let the command operate on every line of the file. 286 | WholeFile 287 | | -- | Let the command operate on each line in the given range. 288 | RangeCount Int 289 | deriving (Eq, Ord, Show, Read, Generic) 290 | 291 | instance NFData RangeSpecification 292 | 293 | instance Pretty RangeSpecification where 294 | pretty = \case 295 | CurrentLine -> 296 | mempty 297 | WholeFile -> 298 | "%" 299 | RangeCount c -> 300 | pretty c 301 | 302 | instance NvimObject RangeSpecification where 303 | toObject = \case 304 | CurrentLine -> ObjectBinary "" 305 | WholeFile -> ObjectBinary "%" 306 | RangeCount n -> toObject n 307 | 308 | fromObject o = 309 | throwError $ 310 | "Did not expect to receive a RangeSpecification object:" <+> viaShow o 311 | 312 | {- | You can use this type as the first argument for a function which is 313 | intended to be exported as a command. It holds information about the special 314 | attributes a command can take. 315 | -} 316 | data CommandArguments = CommandArguments 317 | { bang :: Maybe Bool 318 | -- ^ 'Nothing' means that the function was not defined to handle a bang, 319 | -- otherwise it means that the bang was passed (@'Just' 'True'@) or that it 320 | -- was not passed when called (@'Just' 'False'@). 321 | , range :: Maybe (Int, Int) 322 | -- ^ Range passed from neovim. Only set if 'CmdRange' was used in the export 323 | -- declaration of the command. 324 | -- 325 | -- Example: 326 | -- 327 | -- * @Just (1,12)@ 328 | , count :: Maybe Int 329 | -- ^ Count passed by neovim. Only set if 'CmdCount' was used in the export 330 | -- declaration of the command. 331 | , register :: Maybe String 332 | -- ^ Register that the command can\/should\/must use. 333 | } 334 | deriving (Eq, Ord, Show, Read, Generic) 335 | 336 | instance NFData CommandArguments 337 | 338 | instance Pretty CommandArguments where 339 | pretty CommandArguments{..} = 340 | cat $ 341 | catMaybes 342 | [ (\b -> if b then "!" else mempty) <$> bang 343 | , ( \(s, e) -> 344 | lparen <> pretty s <> comma 345 | <+> pretty e <> rparen 346 | ) 347 | <$> range 348 | , pretty <$> count 349 | , pretty <$> register 350 | ] 351 | 352 | instance Default CommandArguments where 353 | def = 354 | CommandArguments 355 | { bang = Nothing 356 | , range = Nothing 357 | , count = Nothing 358 | , register = Nothing 359 | } 360 | 361 | -- XXX This instance is used as a bit of a hack, so that I don't have to write 362 | -- special code handling in the code generator and "Neovim.RPC.SocketReader". 363 | instance NvimObject CommandArguments where 364 | toObject CommandArguments{..} = 365 | (toObject :: Dictionary -> Object) 366 | . Map.fromList 367 | . catMaybes 368 | $ [ bang >>= \b -> return ("bang", toObject b) 369 | , range >>= \r -> return ("range", toObject r) 370 | , count >>= \c -> return ("count", toObject c) 371 | , register >>= \r -> return ("register", toObject r) 372 | ] 373 | 374 | fromObject (ObjectMap m) = do 375 | let l key = mapM fromObject (Map.lookup (ObjectBinary key) m) 376 | bang <- l "bang" 377 | range <- l "range" 378 | count <- l "count" 379 | register <- l "register" 380 | return CommandArguments{..} 381 | fromObject ObjectNil = return def 382 | fromObject o = 383 | throwError $ 384 | "Expected a map for CommandArguments object, but got: " 385 | <+> viaShow o 386 | 387 | {- | Options that can be used to register an autocmd. See @:h :autocmd@ or any 388 | referenced neovim help-page from the fields of this data type. 389 | -} 390 | data AutocmdOptions = AutocmdOptions 391 | { acmdPattern :: String 392 | -- ^ Pattern to match on. (default: \"*\") 393 | , acmdNested :: Bool 394 | -- ^ Nested autocmd. (default: False) 395 | -- 396 | -- See @:h autocmd-nested@ 397 | , acmdGroup :: Maybe String 398 | -- ^ Group in which the autocmd should be registered. 399 | } 400 | deriving (Show, Read, Eq, Ord, Generic) 401 | 402 | instance NFData AutocmdOptions 403 | 404 | instance Pretty AutocmdOptions where 405 | pretty AutocmdOptions{..} = 406 | pretty acmdPattern 407 | <+> if acmdNested 408 | then "nested" 409 | else 410 | "unnested" 411 | <> maybe mempty (\g -> mempty <+> pretty g) acmdGroup 412 | 413 | instance Default AutocmdOptions where 414 | def = 415 | AutocmdOptions 416 | { acmdPattern = "*" 417 | , acmdNested = False 418 | , acmdGroup = Nothing 419 | } 420 | 421 | instance NvimObject AutocmdOptions where 422 | toObject AutocmdOptions{..} = 423 | (toObject :: Dictionary -> Object) . Map.fromList $ 424 | [ ("pattern", toObject acmdPattern) 425 | , ("nested", toObject acmdNested) 426 | ] 427 | ++ catMaybes 428 | [ acmdGroup >>= \g -> return ("group", toObject g) 429 | ] 430 | fromObject o = 431 | throwError $ 432 | "Did not expect to receive an AutocmdOptions object: " <+> viaShow o 433 | 434 | newtype NvimMethod = NvimMethod {nvimMethodName :: Text} 435 | deriving (Eq, Ord, Show, Read, Generic) 436 | deriving (Pretty, NFData) via Text 437 | 438 | -- | Conveniennce class to extract a name from some value. 439 | class HasFunctionName a where 440 | name :: a -> FunctionName 441 | nvimMethod :: a -> NvimMethod 442 | 443 | instance HasFunctionName FunctionalityDescription where 444 | name = \case 445 | Function n _ -> n 446 | Command n _ -> n 447 | Autocmd _ n _ _ -> n 448 | 449 | nvimMethod = \case 450 | Function (F n) _ -> NvimMethod $ n <> ":function" 451 | Command (F n) _ -> NvimMethod $ n <> ":command" 452 | Autocmd _ (F n) _ _ -> NvimMethod n 453 | 454 | -------------------------------------------------------------------------------- /src/Neovim/Plugin/IPC.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Neovim.Plugin.IPC 3 | Description : Communication between Haskell processes/threads 4 | Copyright : (c) Sebastian Witte 5 | License : Apache-2.0 6 | 7 | Maintainer : woozletoff@gmail.com 8 | Stability : experimental 9 | 10 | This module reexports publicly available means to communicate between different 11 | plugins (or more generally threads running in the same plugin provider). 12 | -} 13 | module Neovim.Plugin.IPC ( 14 | SomeMessage (..), 15 | fromMessage, 16 | ) where 17 | 18 | import Neovim.Plugin.IPC.Classes 19 | -------------------------------------------------------------------------------- /src/Neovim/Plugin/IPC/Classes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | {-# LANGUAGE RecordWildCards #-} 6 | 7 | {- | 8 | Module : Neovim.Plugin.IPC.Classes 9 | Description : Classes used for Inter Plugin Communication 10 | Copyright : (c) Sebastian Witte 11 | License : Apache-2.0 12 | 13 | Maintainer : woozletoff@gmail.com 14 | Stability : experimental 15 | Portability : GHC 16 | -} 17 | module Neovim.Plugin.IPC.Classes ( 18 | SomeMessage (..), 19 | Message (..), 20 | FunctionCall (..), 21 | Request (..), 22 | Notification (..), 23 | writeMessage, 24 | readSomeMessage, 25 | UTCTime, 26 | getCurrentTime, 27 | module Data.Int, 28 | ) where 29 | 30 | import Neovim.Classes ( 31 | Generic, 32 | Int64, 33 | Pretty (pretty), 34 | (<+>), 35 | ) 36 | import Neovim.Plugin.Classes (FunctionName, NeovimEventId) 37 | 38 | import Data.Data (cast) 39 | import Data.Int (Int64) 40 | import Data.MessagePack (Object) 41 | import Data.Time (UTCTime, formatTime, getCurrentTime) 42 | import Data.Time.Locale.Compat (defaultTimeLocale) 43 | import Prettyprinter (hardline, nest, viaShow) 44 | import UnliftIO ( 45 | MonadIO (..), 46 | MonadUnliftIO, 47 | TMVar, 48 | TQueue, 49 | Typeable, 50 | atomically, 51 | evaluate, 52 | readTQueue, 53 | writeTQueue, 54 | ) 55 | 56 | import Control.DeepSeq (NFData, deepseq, rnf) 57 | import Prelude 58 | 59 | {- | Taken from xmonad and based on ideas in /An Extensible Dynamically-Typed 60 | Hierarchy of Exceptions/, Simon Marlow, 2006. 61 | 62 | User-extensible messages must be put into a value of this type, so that it 63 | can be sent to other plugins. 64 | -} 65 | data SomeMessage = forall msg. Message msg => SomeMessage msg 66 | 67 | {- | This class allows type safe casting of 'SomeMessage' to an actual message. 68 | The cast is successful if the type you're expecting matches the type in the 69 | 'SomeMessage' wrapper. This way, you can subscribe to an arbitrary message 70 | type withouth having to pattern match on the constructors. This also allows 71 | plugin authors to create their own message types without having to change the 72 | core code of /nvim-hs/. 73 | -} 74 | class (NFData message, Typeable message) => Message message where 75 | -- | Try to convert a given message to a value of the message type we are 76 | -- interested in. Will evaluate to 'Nothing' for any other type. 77 | fromMessage :: SomeMessage -> Maybe message 78 | fromMessage (SomeMessage message) = cast message 79 | 80 | writeMessage :: (MonadUnliftIO m, Message message) => TQueue SomeMessage -> message -> m () 81 | writeMessage q message = liftIO $ do 82 | evaluate (rnf message) 83 | atomically $ writeTQueue q (SomeMessage message) 84 | 85 | readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage 86 | readSomeMessage q = liftIO $ atomically (readTQueue q) 87 | 88 | -- | Haskell representation of supported Remote Procedure Call messages. 89 | data FunctionCall 90 | = -- | Method name, parameters, callback, timestamp 91 | FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime 92 | deriving (Typeable, Generic) 93 | 94 | instance NFData FunctionCall where 95 | rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` () 96 | 97 | instance Message FunctionCall 98 | 99 | instance Pretty FunctionCall where 100 | pretty (FunctionCall fname args _ t) = 101 | nest 2 $ 102 | "Function call for:" 103 | <+> pretty fname 104 | <> hardline 105 | <> "Arguments:" 106 | <+> viaShow args 107 | <> hardline 108 | <> "Timestamp:" 109 | <+> (viaShow . formatTime defaultTimeLocale "%H:%M:%S (%q)") t 110 | 111 | {- | A request is a data type containing the method to call, its arguments and 112 | an identifier used to map the result to the function that has been called. 113 | -} 114 | data Request = Request 115 | { reqMethod :: FunctionName 116 | -- ^ Name of the function to call. 117 | , reqId :: !Int64 118 | -- ^ Identifier to map the result to a function call invocation. 119 | , reqArgs :: [Object] 120 | -- ^ Arguments for the function. 121 | } 122 | deriving (Eq, Ord, Show, Typeable, Generic) 123 | 124 | instance NFData Request 125 | 126 | instance Message Request 127 | 128 | instance Pretty Request where 129 | pretty Request{..} = 130 | nest 2 $ 131 | "Request" 132 | <+> "#" 133 | <> pretty reqId 134 | <> hardline 135 | <> "Method:" 136 | <+> pretty reqMethod 137 | <> hardline 138 | <> "Arguments:" 139 | <+> viaShow reqArgs 140 | 141 | {- | A notification is similar to a 'Request'. It essentially does the same 142 | thing, but the function is only called for its side effects. This type of 143 | message is sent by neovim if the caller there does not care about the result 144 | of the computation. 145 | -} 146 | data Notification = Notification 147 | { notEvent :: NeovimEventId 148 | -- ^ Event name of the notification. 149 | , notArgs :: [Object] 150 | -- ^ Arguments for the function. 151 | } 152 | deriving (Eq, Ord, Show, Typeable, Generic) 153 | 154 | instance NFData Notification 155 | 156 | instance Message Notification 157 | 158 | instance Pretty Notification where 159 | pretty Notification{..} = 160 | nest 2 $ 161 | "Notification" 162 | <> hardline 163 | <> "Event:" 164 | <+> pretty notEvent 165 | <> hardline 166 | <> "Arguments:" 167 | <+> viaShow notEvent 168 | -------------------------------------------------------------------------------- /src/Neovim/Plugin/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | 3 | {- | 4 | Module : Neovim.Plugin.Internal 5 | Description : Split module that can import Neovim.Context without creating import circles 6 | Copyright : (c) Sebastian Witte 7 | License : Apache-2.0 8 | 9 | Maintainer : woozletoff@gmail.com 10 | Stability : experimental 11 | Portability : GHC 12 | -} 13 | module Neovim.Plugin.Internal ( 14 | ExportedFunctionality (..), 15 | getFunction, 16 | getDescription, 17 | NeovimPlugin (..), 18 | Plugin (..), 19 | wrapPlugin, 20 | ) where 21 | 22 | import Neovim.Context (Neovim) 23 | import Neovim.Plugin.Classes ( 24 | FunctionalityDescription, 25 | HasFunctionName (..), 26 | ) 27 | 28 | import Data.MessagePack (Object) 29 | 30 | {- | This data type is used in the plugin registration to properly register the 31 | functions. 32 | -} 33 | newtype ExportedFunctionality env 34 | = EF (FunctionalityDescription, [Object] -> Neovim env Object) 35 | 36 | -- | Extract the description of an 'ExportedFunctionality'. 37 | getDescription :: ExportedFunctionality env -> FunctionalityDescription 38 | getDescription (EF (d, _)) = d 39 | 40 | -- | Extract the function of an 'ExportedFunctionality'. 41 | getFunction :: ExportedFunctionality env -> [Object] -> Neovim env Object 42 | getFunction (EF (_, f)) = f 43 | 44 | instance HasFunctionName (ExportedFunctionality env) where 45 | name = name . getDescription 46 | nvimMethod = nvimMethod . getDescription 47 | 48 | -- | This data type contains meta information for the plugin manager. 49 | data Plugin env = Plugin 50 | { environment :: env 51 | , exports :: [ExportedFunctionality env] 52 | } 53 | 54 | {- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that 55 | we can put plugins in an ordinary list. 56 | -} 57 | data NeovimPlugin = forall env. NeovimPlugin (Plugin env) 58 | 59 | {- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple 60 | list. 61 | -} 62 | wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin 63 | wrapPlugin = pure . NeovimPlugin 64 | -------------------------------------------------------------------------------- /src/Neovim/Quickfix.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- | 7 | Module : Neovim.Quickfix 8 | Description : API for interacting with the quickfix list 9 | Copyright : (c) Sebastian Witte 10 | License : Apache-2.0 11 | 12 | Maintainer : woozletoff@gmail.com 13 | Stability : experimental 14 | Portability : GHC 15 | -} 16 | module Neovim.Quickfix where 17 | 18 | import Neovim.API.String ( vim_call_function ) 19 | import Neovim.Classes 20 | ( Generic, 21 | NFData, 22 | (<+>), 23 | Doc, 24 | AnsiStyle, 25 | NvimObject(toObject, fromObject), 26 | (+:) ) 27 | import Neovim.Context ( throwError, Neovim ) 28 | 29 | 30 | import Control.Monad (void) 31 | import Data.ByteString as BS (ByteString, all, elem) 32 | import qualified Data.Map as Map 33 | import Data.Maybe ( fromMaybe ) 34 | import Data.MessagePack ( Object(ObjectBinary, ObjectMap) ) 35 | import Prettyprinter (viaShow) 36 | import Prelude 37 | 38 | {- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any 39 | string that you can append to (hence 'Monoid') that is also an instance 40 | of 'NvimObject'. You can e.g. use the plain old 'String'. 41 | -} 42 | setqflist :: 43 | (Monoid strType, NvimObject strType) => 44 | [QuickfixListItem strType] -> 45 | QuickfixAction -> 46 | Neovim env () 47 | setqflist qs a = 48 | void $ vim_call_function "setqflist" $ qs +: a +: [] 49 | 50 | data ColumnNumber 51 | = VisualColumn Int 52 | | ByteIndexColumn Int 53 | | NoColumn 54 | deriving (Eq, Ord, Show, Generic) 55 | 56 | instance NFData ColumnNumber 57 | 58 | data SignLocation strType 59 | = LineNumber Int 60 | | SearchPattern strType 61 | deriving (Eq, Ord, Show, Generic) 62 | 63 | instance (NFData strType) => NFData (SignLocation strType) 64 | 65 | {- | Quickfix list item. The parameter names should mostly conform to those in 66 | @:h setqflist()@. Some fields are merged to explicitly state mutually 67 | exclusive elements or some other behavior of the fields. 68 | 69 | see 'quickfixListItem' for creating a value of this type without typing too 70 | much. 71 | -} 72 | data QuickfixListItem strType = QFItem 73 | { -- | Since the filename is only used if no buffer can be specified, this 74 | -- field is a merge of @bufnr@ and @filename@. 75 | bufOrFile :: Either Int strType 76 | , -- | Line number or search pattern to locate the error. 77 | lnumOrPattern :: Either Int strType 78 | , -- | A tuple of a column number and a boolean indicating which kind of 79 | -- indexing should be used. 'True' means that the visual column should be 80 | -- used. 'False' means to use the byte index. 81 | col :: ColumnNumber 82 | , -- | Error number. 83 | nr :: Maybe Int 84 | , -- | Description of the error. 85 | text :: strType 86 | , -- | Type of error. 87 | errorType :: QuickfixErrorType 88 | } 89 | deriving (Eq, Show, Generic) 90 | 91 | instance (NFData strType) => NFData (QuickfixListItem strType) 92 | 93 | -- | Simple error type enum. 94 | data QuickfixErrorType = Warning | Error 95 | deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) 96 | 97 | instance NFData QuickfixErrorType 98 | 99 | instance NvimObject QuickfixErrorType where 100 | toObject = \case 101 | Warning -> ObjectBinary "W" 102 | Error -> ObjectBinary "E" 103 | 104 | fromObject o = case fromObject o :: Either (Doc AnsiStyle) String of 105 | Right "W" -> return Warning 106 | Right "E" -> return Error 107 | _ -> return Error 108 | 109 | {- | Create a 'QuickfixListItem' by providing the minimal amount of arguments 110 | needed. 111 | -} 112 | quickfixListItem :: 113 | (Monoid strType) => 114 | -- | buffer of file name 115 | Either Int strType -> 116 | -- | line number or pattern 117 | Either Int strType -> 118 | QuickfixListItem strType 119 | quickfixListItem bufferOrFile lineOrPattern = 120 | QFItem 121 | { bufOrFile = bufferOrFile 122 | , lnumOrPattern = lineOrPattern 123 | , col = NoColumn 124 | , nr = Nothing 125 | , text = mempty 126 | , errorType = Error 127 | } 128 | 129 | instance 130 | (Monoid strType, NvimObject strType) => 131 | NvimObject (QuickfixListItem strType) 132 | where 133 | toObject QFItem{..} = 134 | (toObject :: Map.Map ByteString Object -> Object) . Map.fromList $ 135 | [ either 136 | (\b -> ("bufnr", toObject b)) 137 | (\f -> ("filename", toObject f)) 138 | bufOrFile 139 | , either 140 | (\l -> ("lnum", toObject l)) 141 | (\p -> ("pattern", toObject p)) 142 | lnumOrPattern 143 | , ("type", toObject errorType) 144 | , ("text", toObject text) 145 | ] 146 | ++ case col of 147 | NoColumn -> [] 148 | ByteIndexColumn i -> [("col", toObject i), ("vcol", toObject False)] 149 | VisualColumn i -> [("col", toObject i), ("vcol", toObject True)] 150 | 151 | fromObject objectMap@(ObjectMap _) = do 152 | m <- fromObject objectMap 153 | let l :: NvimObject o => ByteString -> Either (Doc AnsiStyle) o 154 | l key = case Map.lookup key m of 155 | Just o -> fromObject o 156 | Nothing -> throwError $ "Key not found." 157 | bufOrFile <- case (l "bufnr", l "filename") of 158 | (Right b, _) -> return $ Left b 159 | (_, Right f) -> return $ Right f 160 | _ -> throwError $ "No buffer number or file name inside quickfix list item." 161 | lnumOrPattern <- case (l "lnum", l "pattern") of 162 | (Right lnum, _) -> return $ Left lnum 163 | (_, Right pat) -> return $ Right pat 164 | _ -> throwError $ "No line number or search pattern inside quickfix list item." 165 | let l' :: NvimObject o => ByteString -> Either (Doc AnsiStyle) (Maybe o) 166 | l' key = case Map.lookup key m of 167 | Just o -> Just <$> fromObject o 168 | Nothing -> return Nothing 169 | nr <- 170 | l' "nr" >>= \case 171 | Just 0 -> return Nothing 172 | nr' -> return nr' 173 | c <- l' "col" 174 | v <- l' "vcol" 175 | let col = fromMaybe NoColumn $ do 176 | c' <- c 177 | v' <- v 178 | case (c', v') of 179 | (0, _) -> return NoColumn 180 | (_, True) -> return $ VisualColumn c' 181 | (_, False) -> return $ ByteIndexColumn c' 182 | text <- fromMaybe mempty <$> l' "text" 183 | errorType <- fromMaybe Error <$> l' "type" 184 | return QFItem{..} 185 | fromObject o = 186 | throwError $ 187 | "Could not deserialize QuickfixListItem," 188 | <+> "expected a map but received:" 189 | <+> viaShow o 190 | 191 | data QuickfixAction 192 | = -- | Add items to the current list (or create a new one if none exists). 193 | Append 194 | | -- | Replace current list (or create a new one if none exists). 195 | Replace 196 | | -- | Create a new list. 197 | New 198 | deriving (Eq, Ord, Enum, Bounded, Show, Generic) 199 | 200 | instance NFData QuickfixAction 201 | 202 | instance NvimObject QuickfixAction where 203 | toObject = \case 204 | Append -> ObjectBinary "a" 205 | Replace -> ObjectBinary "r" 206 | New -> ObjectBinary "" 207 | 208 | fromObject o = case fromObject o of 209 | Right "a" -> return Append 210 | Right "r" -> return Replace 211 | Right s | BS.all (`BS.elem` " \t\n\r") s -> return New 212 | _ -> Left "Could not convert to QuickfixAction" 213 | -------------------------------------------------------------------------------- /src/Neovim/RPC/Classes.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE DeriveGeneric #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE OverloadedStrings #-} 5 | 6 | {- | 7 | Module : Neovim.RPC.Classes 8 | Description : Data types and classes for the RPC components 9 | Copyright : (c) Sebastian Witte 10 | License : Apache-2.0 11 | 12 | Maintainer : woozletoff@gmail.com 13 | Stability : experimental 14 | Portability : GHC 15 | 16 | Import this module qualified as @MsgpackRPC@ 17 | -} 18 | module Neovim.RPC.Classes ( 19 | Message (..), 20 | ) where 21 | 22 | import Neovim.Classes 23 | import Neovim.Plugin.Classes (FunctionName (..), NeovimEventId (..)) 24 | import qualified Neovim.Plugin.IPC.Classes as IPC 25 | 26 | import Control.Applicative 27 | import Control.Monad.Error.Class 28 | import Data.Data (Typeable) 29 | import Data.MessagePack (Object (..)) 30 | import Prettyprinter (hardline, nest, viaShow) 31 | 32 | import Prelude 33 | 34 | {- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for 35 | details about the msgpack rpc specification. 36 | -} 37 | data Message 38 | = -- | Request in the sense of the msgpack rpc specification 39 | -- 40 | -- Parameters 41 | -- * Message identifier that has to be put in the response to this request 42 | -- * Function name 43 | -- * Function arguments 44 | Request IPC.Request 45 | | -- | Response in the sense of the msgpack rpc specifcation 46 | -- 47 | -- Parameters 48 | -- * Mesage identifier which matches a request 49 | -- * 'Either' an error 'Object' or a result 'Object' 50 | Response !Int64 (Either Object Object) 51 | | -- | Notification in the sense of the msgpack rpc specification 52 | Notification IPC.Notification 53 | deriving (Eq, Ord, Show, Typeable, Generic) 54 | 55 | instance NFData Message 56 | 57 | instance IPC.Message Message 58 | 59 | instance NvimObject Message where 60 | toObject = \case 61 | Request (IPC.Request (F m) i ps) -> 62 | ObjectArray $ (0 :: Int64) +: i +: m +: ps +: [] 63 | Response i (Left e) -> 64 | ObjectArray $ (1 :: Int64) +: i +: e +: () +: [] 65 | Response i (Right r) -> 66 | ObjectArray $ (1 :: Int64) +: i +: () +: r +: [] 67 | Notification (IPC.Notification (NeovimEventId eventId) ps) -> 68 | ObjectArray $ (2 :: Int64) +: eventId +: ps +: [] 69 | 70 | fromObject = \case 71 | ObjectArray [ObjectInt 0, i, m, ps] -> do 72 | r <- 73 | IPC.Request 74 | <$> fmap F (fromObject m) 75 | <*> fromObject i 76 | <*> fromObject ps 77 | return $ Request r 78 | ObjectArray [ObjectInt 1, i, e, r] -> 79 | let eer = case e of 80 | ObjectNil -> Right r 81 | _ -> Left e 82 | in Response <$> fromObject i 83 | <*> pure eer 84 | ObjectArray [ObjectInt 2, m, ps] -> do 85 | n <- 86 | IPC.Notification 87 | <$> fmap NeovimEventId (fromObject m) 88 | <*> fromObject ps 89 | return $ Notification n 90 | o -> 91 | throwError $ "Not a known/valid msgpack-rpc message:" <+> viaShow o 92 | 93 | instance Pretty Message where 94 | pretty = \case 95 | Request request -> 96 | pretty request 97 | Response i ret -> 98 | nest 2 $ 99 | "Response" <+> "#" <> pretty i 100 | <> hardline 101 | <> either viaShow viaShow ret 102 | Notification notification -> 103 | pretty notification 104 | -------------------------------------------------------------------------------- /src/Neovim/RPC/Common.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | 4 | {- | 5 | Module : Neovim.RPC.Common 6 | Description : Common functons for the RPC module 7 | Copyright : (c) Sebastian Witte 8 | License : Apache-2.0 9 | 10 | Maintainer : woozletoff@gmail.com 11 | Stability : experimental 12 | -} 13 | module Neovim.RPC.Common where 14 | 15 | import Neovim.OS (getSocketUnix) 16 | 17 | import Control.Applicative (Alternative ((<|>))) 18 | import Control.Monad (unless) 19 | import Data.Int (Int64) 20 | import Data.Map (Map) 21 | import Data.MessagePack (Object) 22 | import Data.Streaming.Network (getSocketTCP) 23 | import Data.String (IsString (fromString)) 24 | import Data.Time (UTCTime) 25 | import Neovim.Compat.Megaparsec as P ( 26 | MonadParsec (eof, try), 27 | Parser, 28 | anySingle, 29 | anySingleBut, 30 | many, 31 | parse, 32 | single, 33 | some, 34 | ) 35 | import Network.Socket as N (socketToHandle) 36 | import System.Log.Logger (errorM, warningM) 37 | 38 | import Data.List (intercalate) 39 | import qualified Data.List as List 40 | import Data.Maybe (catMaybes) 41 | import qualified Text.Megaparsec.Char.Lexer as L 42 | import UnliftIO.Environment (lookupEnv) 43 | import UnliftIO 44 | 45 | import Prelude 46 | 47 | -- | Things shared between the socket reader and the event handler. 48 | data RPCConfig = RPCConfig 49 | { recipients :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object))) 50 | -- ^ A map from message identifiers (as per RPC spec) to a tuple with a 51 | -- timestamp and a 'TMVar' that is used to communicate the result back to 52 | -- the calling thread. 53 | , nextMessageId :: TVar Int64 54 | -- ^ Message identifier for the next message as per RPC spec. 55 | } 56 | 57 | {- | Create a new basic configuration containing a communication channel for 58 | remote procedure call events and an empty lookup table for functions to 59 | mediate. 60 | -} 61 | newRPCConfig :: (Applicative io, MonadUnliftIO io) => io RPCConfig 62 | newRPCConfig = 63 | RPCConfig 64 | <$> liftIO (newTVarIO mempty) 65 | <*> liftIO (newTVarIO 1) 66 | 67 | -- | Simple data type defining the kind of socket the socket reader should use. 68 | data SocketType 69 | = -- | Use the handle for receiving msgpack-rpc messages. This is 70 | -- suitable for an embedded neovim which is used in test cases. 71 | Stdout Handle 72 | | -- | Read the connection information from the environment 73 | -- variable @NVIM@. 74 | Environment 75 | | -- | Use a unix socket. 76 | UnixSocket FilePath 77 | | -- | Use an IP socket. First argument is the port and the 78 | -- second is the host name. 79 | TCP Int String 80 | 81 | {- | Create a 'Handle' from the given socket description. 82 | 83 | The handle is not automatically closed. 84 | -} 85 | createHandle :: 86 | (Functor io, MonadUnliftIO io) => 87 | SocketType -> 88 | io Handle 89 | createHandle = \case 90 | Stdout h -> do 91 | liftIO $ hSetBuffering h (BlockBuffering Nothing) 92 | return h 93 | UnixSocket f -> 94 | liftIO $ createHandle . Stdout =<< flip socketToHandle ReadWriteMode =<< getSocketUnix f 95 | TCP p h -> 96 | createHandle . Stdout =<< createTCPSocketHandle p h 97 | Environment -> 98 | createHandle . Stdout =<< createSocketHandleFromEnvironment 99 | where 100 | createTCPSocketHandle :: (MonadUnliftIO io) => Int -> String -> io Handle 101 | createTCPSocketHandle p h = 102 | liftIO $ 103 | getSocketTCP (fromString h) p 104 | >>= flip socketToHandle ReadWriteMode . fst 105 | 106 | createSocketHandleFromEnvironment = liftIO $ do 107 | -- NVIM_LISTEN_ADDRESS is for backwards compatibility 108 | envValues <- catMaybes <$> mapM lookupEnv ["NVIM", "NVIM_LISTEN_ADDRESS"] 109 | listenAdresses <- mapM parseNvimEnvironmentVariable envValues 110 | case listenAdresses of 111 | (s : _) -> createHandle s 112 | _ -> do 113 | let errMsg = 114 | unlines 115 | [ "Unhandled socket type from environment variable: " 116 | , "\t" <> intercalate ", " envValues 117 | ] 118 | liftIO $ errorM "createHandle" errMsg 119 | error errMsg 120 | 121 | parseNvimEnvironmentVariable :: MonadFail m => String -> m SocketType 122 | parseNvimEnvironmentVariable envValue = 123 | either (fail . show) pure $ parse (P.try pTcpAddress <|> pUnixSocket) envValue envValue 124 | 125 | pUnixSocket :: P.Parser SocketType 126 | pUnixSocket = UnixSocket <$> P.some anySingle <* P.eof 127 | 128 | pTcpAddress :: P.Parser SocketType 129 | pTcpAddress = do 130 | prefixes <- P.some (P.try (P.many (P.anySingleBut ':') <* P.single ':')) 131 | port <- L.lexeme P.eof L.decimal 132 | P.eof 133 | pure $ TCP port (List.intercalate ":" prefixes) 134 | 135 | {- | Close the handle and print a warning if the conduit chain has been 136 | interrupted prematurely. 137 | -} 138 | cleanUpHandle :: (MonadUnliftIO io) => Handle -> Bool -> io () 139 | cleanUpHandle h completed = liftIO $ do 140 | hClose h 141 | unless completed $ 142 | warningM "cleanUpHandle" "Cleanup called on uncompleted handle." 143 | -------------------------------------------------------------------------------- /src/Neovim/RPC/EventHandler.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | 4 | {- | 5 | Module : Neovim.RPC.EventHandler 6 | Description : Event handling loop 7 | Copyright : (c) Sebastian Witte 8 | License : Apache-2.0 9 | 10 | Maintainer : woozletoff@gmail.com 11 | Stability : experimental 12 | -} 13 | module Neovim.RPC.EventHandler ( 14 | runEventHandler, 15 | ) where 16 | 17 | import Neovim.Classes (NvimObject (toObject)) 18 | import Neovim.Context (MonadIO (..), asks) 19 | import qualified Neovim.Context.Internal as Internal 20 | import Neovim.Plugin.IPC.Classes ( 21 | FunctionCall (..), 22 | Message (fromMessage), 23 | Request (Request), 24 | SomeMessage, 25 | readSomeMessage, 26 | ) 27 | import qualified Neovim.RPC.Classes as MsgpackRPC 28 | import Neovim.RPC.Common (RPCConfig (nextMessageId, recipients)) 29 | import Neovim.RPC.FunctionCall (atomically') 30 | 31 | import Conduit as C ( 32 | ConduitM, 33 | ConduitT, 34 | Flush (..), 35 | ResourceT, 36 | await, 37 | runConduit, 38 | runResourceT, 39 | sinkHandleFlush, 40 | yield, 41 | (.|), 42 | ) 43 | import Control.Monad (forever) 44 | import Control.Monad.Reader ( 45 | MonadReader, 46 | ReaderT (runReaderT), 47 | ) 48 | import Data.ByteString (ByteString) 49 | import qualified Data.Map as Map 50 | import Data.Serialize (encode) 51 | import System.IO (Handle) 52 | import System.Log.Logger (debugM) 53 | import UnliftIO (MonadUnliftIO, modifyTVar', readTVar) 54 | import Prelude 55 | 56 | {- | This function will establish a connection to the given socket and write 57 | msgpack-rpc requests to it. 58 | -} 59 | runEventHandler :: 60 | Handle -> 61 | Internal.Config RPCConfig -> 62 | IO () 63 | runEventHandler writeableHandle env = 64 | runEventHandlerContext env . runConduit $ do 65 | eventHandlerSource 66 | .| eventHandler 67 | .| sinkHandleFlush writeableHandle 68 | 69 | -- | Convenient monad transformer stack for the event handler 70 | newtype EventHandler a 71 | = EventHandler (ResourceT (ReaderT (Internal.Config RPCConfig) IO) a) 72 | deriving 73 | ( Functor 74 | , Applicative 75 | , Monad 76 | , MonadIO 77 | , MonadUnliftIO 78 | , MonadReader (Internal.Config RPCConfig) 79 | ) 80 | 81 | runEventHandlerContext :: 82 | Internal.Config RPCConfig -> EventHandler a -> IO a 83 | runEventHandlerContext env (EventHandler a) = 84 | runReaderT (runResourceT a) env 85 | 86 | eventHandlerSource :: ConduitT () SomeMessage EventHandler () 87 | eventHandlerSource = 88 | asks Internal.eventQueue >>= \q -> 89 | forever $ yield =<< readSomeMessage q 90 | 91 | eventHandler :: ConduitM SomeMessage EncodedResponse EventHandler () 92 | eventHandler = 93 | await >>= \case 94 | Nothing -> 95 | return () -- i.e. close the conduit -- TODO signal shutdown globally 96 | Just message -> do 97 | handleMessage (fromMessage message, fromMessage message) 98 | eventHandler 99 | 100 | type EncodedResponse = C.Flush ByteString 101 | 102 | yield' :: (MonadUnliftIO io) => MsgpackRPC.Message -> ConduitM i EncodedResponse io () 103 | yield' o = do 104 | liftIO . debugM "EventHandler" $ "Sending: " ++ show o 105 | yield . Chunk . encode $ toObject o 106 | yield Flush 107 | 108 | handleMessage :: 109 | (Maybe FunctionCall, Maybe MsgpackRPC.Message) -> 110 | ConduitM i EncodedResponse EventHandler () 111 | handleMessage = \case 112 | (Just (FunctionCall fn params reply time), _) -> do 113 | cfg <- asks Internal.customConfig 114 | messageId <- atomically' $ do 115 | i <- readTVar (nextMessageId cfg) 116 | modifyTVar' (nextMessageId cfg) succ 117 | modifyTVar' (recipients cfg) $ Map.insert i (time, reply) 118 | return i 119 | yield' $ MsgpackRPC.Request (Request fn messageId params) 120 | (_, Just r@MsgpackRPC.Response{}) -> 121 | yield' r 122 | (_, Just n@MsgpackRPC.Notification{}) -> 123 | yield' n 124 | _ -> 125 | return () -- i.e. skip to next message 126 | -------------------------------------------------------------------------------- /src/Neovim/RPC/FunctionCall.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | {- | 5 | Module : Neovim.RPC.FunctionCall 6 | Description : Functions for calling functions 7 | Copyright : (c) Sebastian Witte 8 | License : Apache-2.0 9 | 10 | Maintainer : woozletoff@gmail.com 11 | Stability : experimental 12 | -} 13 | module Neovim.RPC.FunctionCall ( 14 | acall, 15 | scall, 16 | scall', 17 | scallThrow, 18 | atomically', 19 | wait, 20 | wait', 21 | respond, 22 | ) where 23 | 24 | import Neovim.Classes 25 | import Neovim.Context 26 | import qualified Neovim.Context.Internal as Internal 27 | import Neovim.Plugin.Classes (FunctionName) 28 | import Neovim.Plugin.IPC.Classes 29 | import qualified Neovim.RPC.Classes as MsgpackRPC 30 | 31 | import Control.Applicative 32 | import Control.Monad (void, (<=<)) 33 | import Control.Monad.Reader 34 | import Data.MessagePack 35 | 36 | import UnliftIO (STM, atomically, newEmptyTMVarIO, readTMVar, throwIO) 37 | import Prelude 38 | 39 | -- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result. 40 | acall :: 41 | (NvimObject result) => 42 | FunctionName -> 43 | [Object] -> 44 | Neovim env (STM (Either NeovimException result)) 45 | acall fn parameters = do 46 | q <- Internal.asks' Internal.eventQueue 47 | mv <- liftIO newEmptyTMVarIO 48 | timestamp <- liftIO getCurrentTime 49 | writeMessage q $ FunctionCall fn parameters mv timestamp 50 | return $ convertObject <$> readTMVar mv 51 | where 52 | convertObject :: 53 | (NvimObject result) => 54 | Either Object Object -> 55 | Either NeovimException result 56 | convertObject = \case 57 | Left e -> Left $ ErrorResult (pretty fn) e 58 | Right o -> case fromObject o of 59 | Left e -> Left $ ErrorMessage e 60 | Right r -> Right r 61 | 62 | {- | Call a neovim function synchronously. This function blocks until the 63 | result is available. 64 | -} 65 | scall :: 66 | (NvimObject result) => 67 | FunctionName -> 68 | -- | Parameters in an 'Object' array 69 | [Object] -> 70 | -- | result value of the call or the thrown exception 71 | Neovim env (Either NeovimException result) 72 | scall fn parameters = acall fn parameters >>= atomically' 73 | 74 | -- | Similar to 'scall', but throw a 'NeovimException' instead of returning it. 75 | scallThrow :: 76 | (NvimObject result) => 77 | FunctionName -> 78 | [Object] -> 79 | Neovim env result 80 | scallThrow fn parameters = scall fn parameters >>= either throwIO return 81 | 82 | {- | Helper function similar to 'scall' that throws a runtime exception if the 83 | result is an error object. 84 | -} 85 | scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result 86 | scall' fn = either throwIO pure <=< scall fn 87 | 88 | -- | Lifted variant of 'atomically'. 89 | atomically' :: (MonadIO io) => STM result -> io result 90 | atomically' = liftIO . atomically 91 | 92 | {- | Wait for the result of the STM action. 93 | 94 | This action possibly blocks as it is an alias for 95 | @ \ioSTM -> ioSTM >>= liftIO . atomically@. 96 | -} 97 | wait :: Neovim env (STM result) -> Neovim env result 98 | wait = (=<<) atomically' 99 | 100 | -- | Variant of 'wait' that discards the result. 101 | wait' :: Neovim env (STM result) -> Neovim env () 102 | wait' = void . wait 103 | 104 | -- | Send the result back to the neovim instance. 105 | respond :: (NvimObject result) => Request -> Either String result -> Neovim env () 106 | respond Request{..} result = do 107 | q <- Internal.asks' Internal.eventQueue 108 | writeMessage q . MsgpackRPC.Response reqId $ 109 | either (Left . toObject) (Right . toObject) result 110 | -------------------------------------------------------------------------------- /src/Neovim/RPC/SocketReader.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {- | 3 | Module : Neovim.RPC.SocketReader 4 | Description : The component which reads RPC messages from the neovim instance 5 | Copyright : (c) Sebastian Witte 6 | License : Apache-2.0 7 | 8 | Maintainer : woozletoff@gmail.com 9 | Stability : experimental 10 | -} 11 | module Neovim.RPC.SocketReader ( 12 | runSocketReader, 13 | parseParams, 14 | ) where 15 | 16 | import Neovim.Classes ( Int64, NvimObject(toObject, fromObject) ) 17 | import Neovim.Context ( MonadIO(liftIO), asks, Neovim, runNeovim ) 18 | import qualified Neovim.Context.Internal as Internal 19 | import Neovim.Plugin.Classes ( 20 | CommandArguments (..), 21 | CommandOption (..), 22 | FunctionName (..), 23 | FunctionalityDescription (..), 24 | NeovimEventId (..), 25 | NvimMethod (..), 26 | Subscription (..), 27 | getCommandOptions, 28 | ) 29 | import Neovim.Plugin.IPC.Classes 30 | ( getCurrentTime, 31 | Notification(Notification), 32 | Request(Request), 33 | writeMessage ) 34 | import qualified Neovim.RPC.Classes as MsgpackRPC 35 | import Neovim.RPC.Common ( RPCConfig(recipients) ) 36 | import Neovim.RPC.FunctionCall ( atomically' ) 37 | 38 | import Conduit as C 39 | ( Void, 40 | MonadTrans(lift), 41 | sourceHandle, 42 | (.|), 43 | awaitForever, 44 | runConduit, 45 | ConduitT ) 46 | import Control.Monad (void) 47 | import Data.Conduit.Cereal (conduitGet2) 48 | import Data.Default (def) 49 | import Data.Foldable (foldl', forM_) 50 | import qualified Data.Map as Map 51 | import Data.Maybe (fromMaybe) 52 | import Data.MessagePack ( Object(ObjectArray) ) 53 | import qualified Data.Serialize (get) 54 | import System.IO (Handle) 55 | import System.Log.Logger ( debugM, errorM, warningM ) 56 | import UnliftIO (atomically, timeout, readTVarIO, modifyTVar', putTMVar, readTMVar, async, newEmptyTMVarIO, modifyTVar) 57 | 58 | import Prelude 59 | 60 | logger :: String 61 | logger = "Socket Reader" 62 | 63 | type SocketHandler = Neovim RPCConfig 64 | 65 | {- | This function will establish a connection to the given socket and read 66 | msgpack-rpc events from it. 67 | -} 68 | runSocketReader :: 69 | Handle -> 70 | Internal.Config RPCConfig -> 71 | IO () 72 | runSocketReader readableHandle cfg = 73 | void . runNeovim (Internal.retypeConfig (Internal.customConfig cfg) cfg) . runConduit $ do 74 | sourceHandle readableHandle 75 | .| conduitGet2 Data.Serialize.get 76 | .| messageHandlerSink 77 | 78 | {- | Sink that delegates the messages depending on their type. 79 | 80 | -} 81 | messageHandlerSink :: ConduitT Object Void SocketHandler () 82 | messageHandlerSink = awaitForever $ \rpc -> do 83 | liftIO . debugM logger $ "Received: " <> show rpc 84 | case fromObject rpc of 85 | Right (MsgpackRPC.Request (Request fn i ps)) -> 86 | handleRequest i fn ps 87 | Right (MsgpackRPC.Response i r) -> 88 | handleResponse i r 89 | Right (MsgpackRPC.Notification (Notification eventId args)) -> 90 | handleNotification eventId args 91 | Left e -> 92 | liftIO . errorM logger $ "Unhandled rpc message: " <> show e 93 | 94 | handleResponse :: Int64 -> Either Object Object -> ConduitT a Void SocketHandler () 95 | handleResponse i result = do 96 | answerMap <- asks recipients 97 | mReply <- Map.lookup i <$> liftIO (readTVarIO answerMap) 98 | case mReply of 99 | Nothing -> 100 | liftIO $ warningM logger "Received response but could not find a matching recipient." 101 | Just (_, reply) -> do 102 | atomically' . modifyTVar' answerMap $ Map.delete i 103 | atomically' $ putTMVar reply result 104 | 105 | lookupFunction :: 106 | Internal.Config RPCConfig -> 107 | FunctionName -> 108 | IO (Maybe (FunctionalityDescription, Internal.FunctionType)) 109 | lookupFunction rpc (F functionName) = do 110 | functionMap <- atomically $ readTMVar (Internal.globalFunctionMap rpc) 111 | pure $ Map.lookup (NvimMethod functionName) functionMap 112 | 113 | handleRequest :: Int64 -> FunctionName -> [Object] -> ConduitT a Void SocketHandler () 114 | handleRequest requestId functionToCall params = do 115 | cfg <- lift Internal.ask' 116 | void . liftIO . async $ timeout (10 * 1000 * 1000) (handle cfg) 117 | return () 118 | where 119 | handle :: Internal.Config RPCConfig -> IO () 120 | handle rpc = 121 | lookupFunction rpc functionToCall >>= \case 122 | Nothing -> do 123 | let errM = "No provider for: " <> show functionToCall 124 | debugM logger errM 125 | writeMessage (Internal.eventQueue rpc) $ 126 | MsgpackRPC.Response requestId (Left (toObject errM)) 127 | Just (copts, Internal.Stateful c) -> do 128 | now <- liftIO getCurrentTime 129 | reply <- liftIO newEmptyTMVarIO 130 | let q = (recipients . Internal.customConfig) rpc 131 | liftIO . debugM logger $ "Executing stateful function with ID: " <> show requestId 132 | atomically' . modifyTVar q $ Map.insert requestId (now, reply) 133 | writeMessage c $ Request functionToCall requestId (parseParams copts params) 134 | 135 | handleNotification :: NeovimEventId -> [Object] -> ConduitT a Void SocketHandler () 136 | handleNotification eventId@(NeovimEventId str) args = do 137 | cfg <- lift Internal.ask' 138 | liftIO (lookupFunction cfg (F str)) >>= \case 139 | Just (copts, Internal.Stateful c) -> liftIO $ do 140 | debugM logger $ "Executing function asynchronously: " <> show str 141 | writeMessage c $ Notification eventId (parseParams copts args) 142 | Nothing -> do 143 | liftIO $ debugM logger $ "Handling event: " <> show str 144 | subscriptions' <- lift $ Internal.asks' Internal.subscriptions 145 | subscribers <- liftIO $ 146 | atomically $ do 147 | s <- readTMVar subscriptions' 148 | pure $ fromMaybe [] $ Map.lookup eventId (Internal.byEventId s) 149 | forM_ subscribers $ \subscription -> liftIO $ subAction subscription args 150 | 151 | parseParams :: FunctionalityDescription -> [Object] -> [Object] 152 | parseParams (Function _ _) args = case args of 153 | -- Defining a function on the remote host creates a function that, that 154 | -- passes all arguments in a list. At the time of this writing, no other 155 | -- arguments are passed for such a function. 156 | -- 157 | -- The function generating the function on neovim side is called: 158 | -- @remote#define#FunctionOnHost@ 159 | [ObjectArray fArgs] -> fArgs 160 | _ -> args 161 | parseParams cmd@(Command _ opts) args = case args of 162 | (ObjectArray _ : _) -> 163 | let cmdArgs = filter isPassedViaRPC (getCommandOptions opts) 164 | (c, args') = foldl' createCommandArguments (def, []) $ zip cmdArgs args 165 | in toObject c : args' 166 | _ -> parseParams cmd [ObjectArray args] 167 | where 168 | isPassedViaRPC :: CommandOption -> Bool 169 | isPassedViaRPC = \case 170 | CmdSync{} -> False 171 | _ -> True 172 | 173 | -- Neovim passes arguments in a special form, depending on the 174 | -- CommandOption values used to export the (command) function (e.g. via 175 | -- 'command' or 'command''). 176 | createCommandArguments :: 177 | (CommandArguments, [Object]) -> 178 | (CommandOption, Object) -> 179 | (CommandArguments, [Object]) 180 | createCommandArguments old@(c, args') = \case 181 | (CmdRange _, o) -> 182 | either (const old) (\r -> (c{range = Just r}, args')) $ fromObject o 183 | (CmdCount _, o) -> 184 | either (const old) (\n -> (c{count = Just n}, args')) $ fromObject o 185 | (CmdBang, o) -> 186 | either (const old) (\b -> (c{bang = Just b}, args')) $ fromObject o 187 | (CmdNargs "*", ObjectArray os) -> 188 | -- CommandArguments -> [String] -> Neovim r st a 189 | (c, os) 190 | (CmdNargs "+", ObjectArray (o : os)) -> 191 | -- CommandArguments -> String -> [String] -> Neovim r st a 192 | (c, o : [ObjectArray os]) 193 | (CmdNargs "?", ObjectArray [o]) -> 194 | -- CommandArguments -> Maybe String -> Neovim r st a 195 | (c, [toObject (Just o)]) 196 | (CmdNargs "?", ObjectArray []) -> 197 | -- CommandArguments -> Maybe String -> Neovim r st a 198 | (c, [toObject (Nothing :: Maybe Object)]) 199 | (CmdNargs "0", ObjectArray []) -> 200 | -- CommandArguments -> Neovim r st a 201 | (c, []) 202 | (CmdNargs "1", ObjectArray [o]) -> 203 | -- CommandArguments -> String -> Neovim r st a 204 | (c, [o]) 205 | (CmdRegister, o) -> 206 | either (const old) (\r -> (c{register = Just r}, args')) $ fromObject o 207 | _ -> old 208 | parseParams Autocmd{} args = case args of 209 | [ObjectArray fArgs] -> fArgs 210 | _ -> args 211 | -------------------------------------------------------------------------------- /src/Neovim/Test.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RecordWildCards #-} 2 | {-# LANGUAGE LambdaCase #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | 5 | {- | 6 | Module : Neovim.Test 7 | Description : Testing functions 8 | Copyright : (c) Sebastian Witte 9 | License : Apache-2.0 10 | 11 | Maintainer : woozletoff@gmail.com 12 | Stability : experimental 13 | Portability : GHC 14 | -} 15 | module Neovim.Test ( 16 | runInEmbeddedNeovim, 17 | runInEmbeddedNeovim', 18 | Seconds (..), 19 | TestConfiguration (..), 20 | -- deprecated 21 | testWithEmbeddedNeovim, 22 | ) where 23 | 24 | import Neovim 25 | import Neovim.API.Text (nvim_command, vim_command) 26 | import qualified Neovim.Context.Internal as Internal 27 | import Neovim.RPC.Common (RPCConfig, newRPCConfig) 28 | import Neovim.RPC.EventHandler (runEventHandler) 29 | import Neovim.RPC.SocketReader (runSocketReader) 30 | 31 | import Control.Monad.Reader (runReaderT) 32 | import Data.Default (Default) 33 | import Data.Text (pack) 34 | import GHC.IO.Exception (ioe_filename) 35 | import Neovim.Plugin (startPluginThreads) 36 | import Neovim.Util (oneLineErrorMessage) 37 | import Prettyprinter (annotate, vsep) 38 | import Prettyprinter.Render.Terminal (Color (..), color) 39 | import System.Process.Typed ( 40 | ExitCode (ExitFailure, ExitSuccess), 41 | Process, 42 | createPipe, 43 | getExitCode, 44 | getStdin, 45 | getStdout, 46 | proc, 47 | setStdin, 48 | setStdout, 49 | startProcess, 50 | stopProcess, 51 | waitExitCode, 52 | ) 53 | import UnliftIO (Handle, IOException, async, atomically, cancel, catch, newEmptyMVar, putMVar, putTMVar, throwIO, timeout) 54 | import UnliftIO.Concurrent (takeMVar, threadDelay) 55 | 56 | -- | Type synonym for 'Word'. 57 | newtype Seconds = Seconds Word 58 | deriving (Show) 59 | 60 | microSeconds :: Integral i => Seconds -> i 61 | microSeconds (Seconds s) = fromIntegral s * 1000 * 1000 62 | 63 | newtype TestConfiguration = TestConfiguration 64 | { cancelAfter :: Seconds 65 | } 66 | deriving (Show) 67 | 68 | instance Default TestConfiguration where 69 | def = 70 | TestConfiguration 71 | { cancelAfter = Seconds 2 72 | } 73 | 74 | {- | Run a neovim process with @-n --clean --embed@ and execute the 75 | given action that will have access to the started instance. 76 | 77 | The 'TestConfiguration' contains sensible defaults. 78 | 79 | 'env' is the state of your function that you want to test. 80 | -} 81 | runInEmbeddedNeovim :: TestConfiguration -> Plugin env -> Neovim env a -> IO () 82 | runInEmbeddedNeovim TestConfiguration{..} plugin action = 83 | warnIfNvimIsNotOnPath runTest 84 | where 85 | runTest = do 86 | resultMVar <- newEmptyMVar 87 | let action' = do 88 | result <- action 89 | q <- Internal.asks' Internal.transitionTo 90 | putMVar q Internal.Quit 91 | -- vim_command isn't asynchronous, so we need to avoid waiting 92 | -- for the result of the operation by using 'async' since 93 | -- neovim cannot send a result if it has quit. 94 | _ <- async . void $ vim_command "qa!" 95 | putMVar resultMVar result 96 | (nvimProcess, cleanUp) <- startEmbeddedNvim cancelAfter plugin action' 97 | 98 | result <- timeout (microSeconds cancelAfter) (takeMVar resultMVar) 99 | 100 | waitExitCode nvimProcess >>= \case 101 | ExitFailure i -> 102 | fail $ "Neovim returned with an exit status of: " ++ show i 103 | ExitSuccess -> case result of 104 | Nothing -> fail "Test timed out" 105 | Just _ -> pure () 106 | cleanUp 107 | 108 | type TransitionHandler a = Internal.Config RPCConfig -> IO a 109 | 110 | testTransitionHandler :: IO a -> TransitionHandler () 111 | testTransitionHandler onInitAction cfg = 112 | takeMVar (Internal.transitionTo cfg) >>= \case 113 | Internal.InitSuccess -> do 114 | void onInitAction 115 | testTransitionHandler onInitAction cfg 116 | Internal.Restart -> do 117 | fail "Restart unexpected" 118 | Internal.Failure e -> do 119 | fail . show $ oneLineErrorMessage e 120 | Internal.Quit -> do 121 | return () 122 | 123 | runInEmbeddedNeovim' :: TestConfiguration -> Neovim () a -> IO () 124 | runInEmbeddedNeovim' testCfg = runInEmbeddedNeovim testCfg Plugin{environment = (), exports = []} 125 | 126 | {-# DEPRECATED testWithEmbeddedNeovim "Use \"runInEmbeddedNeovim def env action\" and open files with nvim_command \"edit file\"" #-} 127 | 128 | {- | The same as 'runInEmbeddedNeovim' with the given file opened via @nvim_command "edit file"@. 129 | - This method is kept for backwards compatibility. 130 | -} 131 | testWithEmbeddedNeovim :: 132 | -- | Optional path to a file that should be opened 133 | Maybe FilePath -> 134 | -- | Maximum time (in seconds) that a test is allowed to run 135 | Seconds -> 136 | -- | Read-only configuration 137 | env -> 138 | -- | Test case 139 | Neovim env a -> 140 | IO () 141 | testWithEmbeddedNeovim file timeoutAfter env action = 142 | runInEmbeddedNeovim 143 | def{cancelAfter = timeoutAfter} 144 | Plugin{environment = env, exports = []} 145 | (openTestFile <* action) 146 | where 147 | openTestFile = case file of 148 | Nothing -> pure () 149 | Just f -> nvim_command $ pack $ "edit " ++ f 150 | 151 | warnIfNvimIsNotOnPath :: IO a -> IO () 152 | warnIfNvimIsNotOnPath test = void test `catch` \(e :: IOException) -> case ioe_filename e of 153 | Just "nvim" -> 154 | putDoc . annotate (color Red) $ 155 | vsep 156 | [ "The neovim executable 'nvim' is not on the PATH." 157 | , "You may not be testing fully!" 158 | ] 159 | _ -> 160 | throwIO e 161 | 162 | startEmbeddedNvim :: 163 | Seconds -> 164 | Plugin env -> 165 | Neovim env () -> 166 | IO (Process Handle Handle (), IO ()) 167 | startEmbeddedNvim timeoutAfter plugin (Internal.Neovim action) = do 168 | nvimProcess <- 169 | startProcess $ 170 | setStdin createPipe $ 171 | setStdout createPipe $ 172 | proc "nvim" ["-n", "--clean", "--embed"] 173 | 174 | cfg <- Internal.newConfig (pure Nothing) newRPCConfig 175 | 176 | socketReader <- 177 | async . void $ 178 | runSocketReader 179 | (getStdout nvimProcess) 180 | (cfg{Internal.pluginSettings = Nothing}) 181 | 182 | eventHandler <- 183 | async . void $ 184 | runEventHandler 185 | (getStdin nvimProcess) 186 | (cfg{Internal.pluginSettings = Nothing}) 187 | 188 | let actionCfg = Internal.retypeConfig (environment plugin) cfg 189 | action' = runReaderT action actionCfg 190 | pluginHandlers <- 191 | startPluginThreads (Internal.retypeConfig () cfg) [wrapPlugin plugin] >>= \case 192 | Left e -> do 193 | putMVar (Internal.transitionTo cfg) $ Internal.Failure e 194 | pure [] 195 | Right (funMapEntries, pluginTids) -> do 196 | atomically $ 197 | putTMVar 198 | (Internal.globalFunctionMap cfg) 199 | (Internal.mkFunctionMap funMapEntries) 200 | putMVar (Internal.transitionTo cfg) Internal.InitSuccess 201 | pure pluginTids 202 | 203 | transitionHandler <- async . void $ do 204 | testTransitionHandler action' cfg 205 | timeoutAsync <- async . void $ do 206 | threadDelay $ microSeconds timeoutAfter 207 | getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> pure ()) 208 | 209 | let cleanUp = 210 | mapM_ cancel $ 211 | [socketReader, eventHandler, timeoutAsync, transitionHandler] 212 | ++ pluginHandlers 213 | 214 | pure (nvimProcess, cleanUp) 215 | -------------------------------------------------------------------------------- /src/Neovim/Util.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Neovim.Util 3 | Description : Utility functions 4 | Copyright : (c) Sebastian Witte 5 | License : Apache-2.0 6 | 7 | Maintainer : woozletoff@gmail.com 8 | Stability : experimental 9 | Portability : GHC 10 | -} 11 | module Neovim.Util ( 12 | whenM, 13 | unlessM, 14 | oneLineErrorMessage, 15 | ) where 16 | 17 | import Control.Monad (unless, when) 18 | import qualified Data.Text as T 19 | import Neovim.Context 20 | 21 | -- | 'when' with a monadic predicate. 22 | whenM :: (Monad m) => m Bool -> m () -> m () 23 | whenM mp a = mp >>= \p -> when p a 24 | 25 | -- | 'unless' with a monadic predicate. 26 | unlessM :: (Monad m) => m Bool -> m () -> m () 27 | unlessM mp a = mp >>= \p -> unless p a 28 | 29 | oneLineErrorMessage :: Doc AnsiStyle -> T.Text 30 | oneLineErrorMessage d = case T.lines $ docToText d of 31 | (x : _) -> x 32 | [] -> mempty 33 | -------------------------------------------------------------------------------- /srcos/unix/Neovim/OS.hs: -------------------------------------------------------------------------------- 1 | module Neovim.OS ( 2 | isWindows, 3 | getSocketUnix 4 | ) where 5 | 6 | import Data.Streaming.Network (getSocketUnix) 7 | 8 | isWindows :: Bool 9 | isWindows = False 10 | 11 | -------------------------------------------------------------------------------- /srcos/windows/Neovim/OS.hs: -------------------------------------------------------------------------------- 1 | module Neovim.OS ( 2 | isWindows, 3 | getSocketUnix 4 | ) where 5 | import Network.Socket (Socket) 6 | 7 | isWindows :: Bool 8 | isWindows = True 9 | 10 | getSocketUnix :: FilePath -> IO Socket 11 | getSocketUnix _ = fail "Windows' named pipes are no supported" 12 | -------------------------------------------------------------------------------- /stack-ghc-9.4.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | 5 | resolver: lts-21.25 6 | extra-deps: [] 7 | 8 | allow-newer: false 9 | 10 | nix: 11 | # Not using pure here because it is very practical to inherit 12 | # $NVIM when developing and debugging plugins. 13 | pure: false 14 | 15 | packages: 16 | - zlib 17 | - neovim # for api generation 18 | -------------------------------------------------------------------------------- /stack-ghc-9.6.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | 5 | resolver: nightly-2023-12-26 6 | extra-deps: [] 7 | 8 | allow-newer: false 9 | 10 | nix: 11 | # Not using pure here because it is very practical to inherit 12 | # $NVIM when developing and debugging plugins. 13 | pure: false 14 | 15 | packages: 16 | - zlib 17 | - neovim # for api generation 18 | -------------------------------------------------------------------------------- /stack-ghc-9.8.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | 5 | resolver: lts-22.43 6 | extra-deps: [] 7 | 8 | allow-newer: false 9 | 10 | nix: 11 | # Not using pure here because it is very practical to inherit 12 | # $NVIM when developing and debugging plugins. 13 | pure: false 14 | 15 | packages: 16 | - zlib 17 | - neovim # for api generation 18 | -------------------------------------------------------------------------------- /stack-template.hsfiles: -------------------------------------------------------------------------------- 1 | {-# START_FILE {{name}}.cabal #-} 2 | name: {{name}} 3 | version: 0.1.0.0 4 | synopsis: Haskell Neovim plugins 5 | description: Personal project to manage plugin dependencies. 6 | author: {{author-name}}{{^author-name}}Author name here{{/author-name}} 7 | maintainer: {{author-email}}{{^author-email}}example@example.com{{/author-email}} 8 | copyright: {{copyright}}{{^copyright}}{{year}}{{^year}}2019{{/year}} {{author-name}}{{^author-name}}Author name here{{/author-name}}{{/copyright}} 9 | -- Take a license that you like. Only relevant if you want to make your config 10 | -- used by other people. 11 | --license: BSD3 12 | --license-file: LICENSE 13 | category: Neovim 14 | build-type: Simple 15 | --extra-source-files: README.md 16 | cabal-version: >=1.10 17 | 18 | executable my-nvim-hs 19 | main-is: nvim.hs 20 | hs-source-dirs: ., nvim-hs 21 | other-modules: Neovim.Example.Plugin 22 | , Neovim.Example.Plugin.Fibonacci 23 | , Neovim.Example.Plugin.Random 24 | build-depends: base >= 4.7 && < 5 25 | , nvim-hs >= 2 && < 3 26 | -- The dependencies below are only needed for the example plugin 27 | , random 28 | , unliftio 29 | default-language: Haskell2010 30 | 31 | {-# START_FILE nvim-hs/Neovim/Example/Plugin.hs #-} 32 | {-# LANGUAGE TemplateHaskell #-} 33 | -- Template Haskell is used to remove a lot of manual boiler-plate from 34 | -- declaring the functions you want to export. 35 | module Neovim.Example.Plugin 36 | ( plugin 37 | ) where 38 | 39 | import Neovim 40 | 41 | import Neovim.Example.Plugin.Random (nextRandom, setNextRandom, randomNumbers) 42 | import Neovim.Example.Plugin.Fibonacci (fibonacci) 43 | 44 | plugin :: Neovim () NeovimPlugin 45 | plugin = do 46 | randomPluginState <- randomNumbers 47 | wrapPlugin Plugin 48 | { environment = randomPluginState 49 | , exports = 50 | [ $(function' 'fibonacci) Sync 51 | -- Notice the quotation mark before the functin name, this is 52 | -- important! 53 | 54 | , $(function' 'nextRandom) Sync 55 | , $(function "SetNextRandom" 'setNextRandom) Async 56 | ] 57 | } 58 | 59 | {-# START_FILE nvim-hs/Neovim/Example/Plugin/Random.hs #-} 60 | {-# LANGUAGE TemplateHaskell #-} 61 | {-# LANGUAGE TemplateHaskell #-} 62 | module Neovim.Example.Plugin.Random 63 | ( nextRandom 64 | , setNextRandom 65 | , randomNumbers 66 | ) where 67 | 68 | import Neovim 69 | import System.Random (newStdGen, randoms) 70 | import UnliftIO.STM (TVar, atomically, readTVar, modifyTVar, newTVarIO) 71 | 72 | -- | This type alias encodes the type of your plugin's environment, namely 73 | -- '(TVar [Int16)' in this case. 74 | -- 75 | -- Since this plugin needs to store some state, we have to put it in a mutable 76 | -- variable. I chose TVar here because I like the Software Transactional Memory 77 | -- library. 78 | type MyNeovim a = Neovim (TVar [Int16]) a 79 | 80 | -- | This is the start up code. It initializes the random number generator and 81 | -- returns a convenient list of random numbers. It returns the environment and 82 | -- is executed in the startup code, so this is the only place where you can't 83 | -- use the type alias defined above. 84 | -- 85 | -- Neovim isn't so good with big numbers, so limit to 16 bits. 86 | randomNumbers :: Neovim startupEnv (TVar [Int16]) 87 | randomNumbers = do 88 | g <- liftIO newStdGen -- Create a new seed for a pseudo random number generator 89 | newTVarIO (randoms g) -- Put an infinite list of random numbers into a TVar 90 | 91 | -- | Get the next random number and update the state of the list. 92 | nextRandom :: MyNeovim Int16 93 | nextRandom = do 94 | tVarWithRandomNumbers <- ask 95 | atomically $ do 96 | -- pick the head of our list of random numbers 97 | r <- head <$> readTVar tVarWithRandomNumbers 98 | 99 | -- Since we do not want to return the same number all over the place 100 | -- remove the head of our list of random numbers 101 | modifyTVar tVarWithRandomNumbers tail 102 | 103 | return r 104 | 105 | 106 | -- | You probably don't want this in a random number generator, but this shows 107 | -- hoy you can edit the state of a stateful plugin. 108 | setNextRandom :: Int16 -> MyNeovim () 109 | setNextRandom n = do 110 | tVarWithRandomNumbers <- ask 111 | 112 | -- cons n to the front of the infinite list 113 | atomically $ modifyTVar tVarWithRandomNumbers (n:) 114 | 115 | {-# START_FILE nvim-hs/Neovim/Example/Plugin/Fibonacci.hs #-} 116 | module Neovim.Example.Plugin.Fibonacci 117 | ( fibonacci 118 | ) where 119 | 120 | import Neovim 121 | 122 | -- | All fibonacci numbers. 123 | fibonacciNumbers :: [Integer] 124 | fibonacciNumbers = 0:fibs -- Since were using !! to index an element in a list, we need a 0 in front 125 | where fibs = 1:scanl1 (+) fibs 126 | 127 | -- | Neovim is not really good with big numbers, so we return a 'String' here. 128 | fibonacci :: Int -> Neovim env String 129 | fibonacci n = return . show $ fibonacciNumbers !! n 130 | 131 | {-# START_FILE nvim.hs #-} 132 | import Neovim 133 | 134 | import qualified Neovim.Example.Plugin as Example 135 | 136 | main :: IO () 137 | main = do 138 | neovim defaultConfig 139 | { plugins = plugins defaultConfig ++ [ Example.plugin ] 140 | } 141 | 142 | {-# START_FILE plugin/nvim-hs.vim #-} 143 | call nvimhs#start(expand(':p:h:h'), '{{{name}}}', []) 144 | 145 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | flags: {} 2 | packages: 3 | - '.' 4 | 5 | resolver: nightly-2025-03-20 6 | extra-deps: [] 7 | 8 | allow-newer: false 9 | 10 | nix: 11 | # Not using pure here because it is very practical to inherit 12 | # $NVIM when developing and debugging plugins. 13 | pure: false 14 | 15 | packages: 16 | - zlib 17 | - neovim # for api generation 18 | -------------------------------------------------------------------------------- /test-files/hello: -------------------------------------------------------------------------------- 1 | Hello, World! 2 | -------------------------------------------------------------------------------- /tests/API/THSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TemplateHaskell #-} 3 | {-# OPTIONS_GHC -Wno-incomplete-uni-patterns -Wno-overlapping-patterns #-} 4 | 5 | module API.THSpec where 6 | 7 | import API.THSpecFunctions 8 | 9 | import Neovim.API.TH hiding (function) 10 | import qualified Neovim.API.TH as TH 11 | import Neovim.Context 12 | import qualified Neovim.Context.Internal as Internal 13 | import Neovim.Plugin.Classes 14 | import Neovim.Plugin.Internal 15 | 16 | import Data.Default 17 | import qualified Data.Map as Map 18 | 19 | import Test.Hspec 20 | import Test.QuickCheck 21 | 22 | call :: 23 | ([Object] -> Neovim () Object) -> 24 | [Object] -> 25 | IO Object 26 | call f args = do 27 | cfg <- Internal.newConfig (pure Nothing) (pure ()) 28 | res <- runNeovim cfg (f args) 29 | case res of 30 | Right x -> return x 31 | Left e -> (throwIO . ErrorMessage) e 32 | 33 | isNeovimException :: NeovimException -> Bool 34 | isNeovimException _ = True 35 | 36 | spec :: Spec 37 | spec = do 38 | describe "calling function without an argument" $ do 39 | let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync 40 | it "should have a capitalized prefix" $ 41 | fname `shouldBe` F "TestFunction0" 42 | 43 | it "should return the consant value" $ 44 | call testFun [] `shouldReturn` ObjectInt 42 45 | 46 | it "should fail if supplied an argument" $ 47 | call testFun [ObjectNil] `shouldThrow` isNeovimException 48 | 49 | describe "calling testFunction with two arguments" $ do 50 | let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync 51 | it "should have a capitalized prefix" $ 52 | fname `shouldBe` F "TestFunction2" 53 | 54 | it "should return 2 for proper arguments" $ 55 | call 56 | testFun 57 | [ ObjectNil 58 | , ObjectString "ignored" 59 | , ObjectArray [ObjectString "42"] 60 | ] 61 | `shouldReturn` ObjectDouble 2 62 | 63 | it "should throw an exception for the wrong number of arguments" $ 64 | call testFun [ObjectNil] `shouldThrow` isNeovimException 65 | 66 | it "should throw an exception for incompatible types" $ 67 | call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"] 68 | `shouldThrow` isNeovimException 69 | 70 | it "should cast arguments to similar types" $ 71 | call testFun [ObjectNil, ObjectString "ignored", ObjectArray []] 72 | `shouldReturn` ObjectDouble 2 73 | 74 | describe "generating a command from the two argument test function" $ do 75 | let EF (Command fname _, _) = $(command' 'testFunction2) [] 76 | it "should capitalize the first character" $ 77 | fname `shouldBe` F "TestFunction2" 78 | 79 | describe "generating the test successor functions" $ do 80 | let EF (Function fname _, testFun) = $(function' 'testSucc) Sync 81 | it "should be named TestSucc" $ 82 | fname `shouldBe` F "TestSucc" 83 | 84 | it "should return the old value + 1" . property $ 85 | \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x + 1) 86 | 87 | describe "calling test function with a map argument" $ do 88 | let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync 89 | it "should capitalize the first letter" $ 90 | fname `shouldBe` F "TestFunctionMap" 91 | 92 | it "should fail for the wrong number of arguments" $ 93 | call testFun [] `shouldThrow` isNeovimException 94 | 95 | it "should fail for the wrong type of arguments" $ 96 | call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException 97 | 98 | it "should return Nothing for an empty map" $ 99 | call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"] 100 | `shouldReturn` ObjectNil 101 | 102 | it "should return just the value for the singletion entry" $ 103 | call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"] 104 | `shouldReturn` ObjectInt 7 105 | 106 | describe "Calling function with an optional argument" $ do 107 | let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) [] 108 | defCmdArgs = toObject (def :: CommandArguments) 109 | it "should capitalize the first letter" $ 110 | cname `shouldBe` F "TestCommandOptArgument" 111 | 112 | it "should return \"default\" when passed no argument" $ do 113 | call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String) 114 | 115 | it "should return what is passed otherwise" . property $ do 116 | \str -> 117 | call testFun [defCmdArgs, toObject str] 118 | `shouldReturn` toObject (str :: String) 119 | -------------------------------------------------------------------------------- /tests/API/THSpecFunctions.hs: -------------------------------------------------------------------------------- 1 | module API.THSpecFunctions where 2 | 3 | import qualified Data.Map as Map 4 | import Neovim 5 | 6 | testFunction0 :: Neovim env Int 7 | testFunction0 = return 42 8 | 9 | testFunction2 :: CommandArguments -> String -> [String] -> Neovim env Double 10 | testFunction2 _ _ _ = return 2 11 | 12 | testFunctionMap :: Map.Map String Int -> String -> Neovim env (Maybe Int) 13 | testFunctionMap m k = return $ Map.lookup k m 14 | 15 | testSucc :: Int -> Neovim env Int 16 | testSucc = return . succ 17 | 18 | testCommandOptArgument :: CommandArguments -> Maybe String -> Neovim env String 19 | testCommandOptArgument _ ms = case ms of 20 | Just x -> return x 21 | Nothing -> return "default" 22 | -------------------------------------------------------------------------------- /tests/AsyncFunctionSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module AsyncFunctionSpec where 3 | 4 | import Neovim 5 | import Neovim.API.Text 6 | import Neovim.Plugin.Classes (FunctionName (..), FunctionalityDescription (..)) 7 | import Neovim.Plugin.Internal (ExportedFunctionality (..)) 8 | import Neovim.Test 9 | 10 | import Test.Hspec 11 | 12 | import UnliftIO 13 | 14 | spec :: Spec 15 | spec = do 16 | describe "an asynchronous function" $ do 17 | it "is callable" $ do 18 | called <- newEmptyMVar 19 | let myAsyncTestFunction = do 20 | Plugin 21 | { environment = () 22 | , exports = 23 | [ EF 24 | ( Function (F "MyAsyncTestFunction") Async 25 | , \_args -> toObject <$> putMVar called () 26 | ) 27 | ] 28 | } 29 | runInEmbeddedNeovim def{cancelAfter = Seconds 3} myAsyncTestFunction $ do 30 | void $ nvim_call_function "MyAsyncTestFunction" mempty 31 | 32 | liftIO $ readMVar called `shouldReturn` () 33 | -------------------------------------------------------------------------------- /tests/EmbeddedRPCSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | module EmbeddedRPCSpec where 5 | 6 | import Test.Hspec 7 | 8 | import Neovim 9 | import Neovim.API.Text 10 | import Neovim.Context (docToText) 11 | import Neovim.Quickfix 12 | import Neovim.Test 13 | 14 | {- | Tests in here should always be wrapped in 'runInEmbeddedNeovim' def' because they 15 | don't fail if neovim isn't installed. This is particularly helpful to run 16 | tests on stackage and be notified if non-neovim-dependent tests fail. 17 | Basically everybody else who runs these tests has neovim installed and would 18 | see the test failing. 19 | -} 20 | spec :: Spec 21 | spec = parallel $ do 22 | describe "Read hello test file" $ 23 | it "should match 'Hello, World!'" . runInEmbeddedNeovim' def $ do 24 | nvim_command "edit test-files/hello" 25 | bs <- vim_get_buffers 26 | l <- vim_get_current_line 27 | liftIO $ l `shouldBe` "Hello, World!" 28 | liftIO $ length bs `shouldBe` 1 29 | 30 | describe "New empty buffer test" $ do 31 | it "should contain the test text" . runInEmbeddedNeovim' def $ do 32 | cl0 <- vim_get_current_line 33 | liftIO $ cl0 `shouldBe` "" 34 | bs <- vim_get_buffers 35 | liftIO $ length bs `shouldBe` 1 36 | 37 | let testContent = "Test on empty buffer" 38 | vim_set_current_line testContent 39 | cl1 <- vim_get_current_line 40 | liftIO $ cl1 `shouldBe` testContent 41 | 42 | it "should create a new buffer" . runInEmbeddedNeovim' def $ do 43 | bs0 <- vim_get_buffers 44 | liftIO $ length bs0 `shouldBe` 1 45 | vim_command "new" 46 | bs1 <- vim_get_buffers 47 | liftIO $ length bs1 `shouldBe` 2 48 | vim_command "new" 49 | bs2 <- vim_get_buffers 50 | liftIO $ length bs2 `shouldBe` 3 51 | 52 | it "should set the quickfix list" . runInEmbeddedNeovim' def $ do 53 | let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String 54 | setqflist [q] Replace 55 | q' <- vim_eval "getqflist()" 56 | liftIO $ fromObjectUnsafe q' `shouldBe` [q] 57 | 58 | it "throws NeovimException with function that failed as Doc" . runInEmbeddedNeovim' def $ do 59 | let getVariableValue = False <$ vim_get_var "notDefined" 60 | hasTrhownNeovimExceptionWithFunctionName <- 61 | getVariableValue `catchNeovimException` \case 62 | ErrorResult f _ -> pure $ docToText f == "vim_get_var" 63 | _ -> pure False 64 | liftIO $ hasTrhownNeovimExceptionWithFunctionName `shouldBe` True 65 | 66 | it "catches" . runInEmbeddedNeovim' def $ do 67 | let getUndefinedVariable = vim_get_var "notDefined" 68 | functionThatFailed <- 69 | getUndefinedVariable `catchNeovimException` \case 70 | ErrorResult f _ -> pure . toObject $ docToText f 71 | _ -> pure ObjectNil 72 | liftIO $ functionThatFailed `shouldBe` toObject ("vim_get_var" :: String) 73 | -------------------------------------------------------------------------------- /tests/EventSubscriptionSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedLists #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE RecordWildCards #-} 4 | 5 | module EventSubscriptionSpec where 6 | 7 | import Neovim 8 | import Neovim.API.String 9 | import Neovim.Test 10 | 11 | import Test.Hspec 12 | 13 | import UnliftIO (newEmptyMVar, putMVar, readMVar) 14 | 15 | data BufLinesEvent = BufLinesEvent 16 | { bleBuffer :: Buffer 17 | , bleFirstLine :: Int 18 | , bleLastLine :: Int 19 | , bleLines :: [String] 20 | , bleMore :: Bool 21 | } 22 | deriving (Eq, Show) 23 | 24 | parseBufLinesEvent :: [Object] -> Either (Doc AnsiStyle) BufLinesEvent 25 | parseBufLinesEvent event = case event of 26 | [buf, _changedTick, firstline, lastline, linedata, more] -> do 27 | bleBuffer <- fromObject buf 28 | bleFirstLine <- fromObject firstline 29 | bleLastLine <- fromObject lastline 30 | bleLines <- fromObject linedata 31 | bleMore <- fromObject more 32 | pure BufLinesEvent{..} 33 | _ -> Left . pretty $ "Unexpected nvim_buf_lines_event: " ++ show event 34 | 35 | spec :: Spec 36 | spec = parallel $ do 37 | describe "Attaching to a buffer" $ do 38 | it "receives nvim_buf_lines_event" . runInEmbeddedNeovim' def $ do 39 | received <- newEmptyMVar 40 | subscription <- subscribe "nvim_buf_lines_event" $ putMVar received . parseBufLinesEvent 41 | buf <- nvim_create_buf True False 42 | isOk <- nvim_buf_attach buf True [] 43 | 44 | liftIO $ do 45 | isOk `shouldBe` True 46 | Right BufLinesEvent{..} <- readMVar received 47 | bleBuffer `shouldBe` buf 48 | bleFirstLine `shouldBe` 0 49 | bleLastLine `shouldBe` -1 50 | bleLines `shouldBe` [""] 51 | bleMore `shouldBe` False 52 | unsubscribe subscription 53 | 54 | it "receives nvim_buf_detach_event" . runInEmbeddedNeovim' def $ do 55 | received <- newEmptyMVar 56 | subscription <- subscribe "nvim_buf_detach_event" $ putMVar received 57 | buf <- nvim_create_buf True False 58 | isOk <- nvim_buf_attach buf False [] 59 | void $ nvim_buf_detach buf 60 | 61 | liftIO $ do 62 | isOk `shouldBe` True 63 | [buf'] <- readMVar received 64 | fromObjectUnsafe buf' `shouldBe` buf 65 | unsubscribe subscription 66 | -------------------------------------------------------------------------------- /tests/Plugin/ClassesSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE LambdaCase #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | 4 | module Plugin.ClassesSpec where 5 | 6 | import Neovim 7 | import Neovim.Plugin.Classes 8 | 9 | import Test.Hspec 10 | import Test.QuickCheck 11 | 12 | newtype RandomCommandArguments = RCA {getRandomCommandArguments :: CommandArguments} 13 | deriving (Eq, Ord, Show, Read) 14 | 15 | instance Arbitrary RandomCommandArguments where 16 | arbitrary = do 17 | bang <- arbitrary 18 | range <- arbitrary 19 | count <- arbitrary 20 | register <- fmap (fmap getNonEmpty) arbitrary 21 | return . RCA $ CommandArguments{..} 22 | 23 | newtype RandomCommandOption = RCO {getRandomCommandOption :: CommandOption} 24 | deriving (Eq, Ord, Show, Read) 25 | 26 | instance Arbitrary RandomCommandOption where 27 | arbitrary = do 28 | a <- choose (0, 5) :: Gen Int 29 | o <- case a of 30 | -- XXX Most constructor arguments are not tested anyway, so they are 31 | -- hardcoded for now. 32 | 0 -> CmdSync <$> elements [Sync, Async] 33 | 1 -> return CmdRegister 34 | 2 -> return $ CmdNargs "" 35 | 3 -> CmdRange <$> elements [CurrentLine, WholeFile, RangeCount 1] 36 | 4 -> CmdCount <$> arbitrary 37 | _ -> return CmdBang 38 | return $ RCO o 39 | 40 | newtype RandomCommandOptions = RCOs {getRandomCommandOptions :: CommandOptions} 41 | deriving (Eq, Ord, Show, Read) 42 | 43 | instance Arbitrary RandomCommandOptions where 44 | arbitrary = do 45 | l <- choose (0, 20) 46 | RCOs . mkCommandOptions . map getRandomCommandOption <$> vectorOf l arbitrary 47 | 48 | spec :: Spec 49 | spec = do 50 | describe "Deserializing and serializing" $ do 51 | it "should be id for CommandArguments" . property $ do 52 | \args -> 53 | (fromObjectUnsafe . toObject . getRandomCommandArguments) args 54 | `shouldBe` getRandomCommandArguments args 55 | 56 | describe "If a sync option is set for commands" $ do 57 | let isSyncOption = \case 58 | CmdSync _ -> True 59 | _ -> False 60 | it "must be at the head of the list" . property $ do 61 | \(RCOs opts) -> 62 | any isSyncOption (getCommandOptions opts) ==> do 63 | length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1 64 | head (getCommandOptions opts) `shouldSatisfy` isSyncOption 65 | -------------------------------------------------------------------------------- /tests/RPC/CommonSpec.hs: -------------------------------------------------------------------------------- 1 | module RPC.CommonSpec where 2 | 3 | import Neovim.RPC.Common 4 | 5 | import Test.Hspec 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "Parsing of $NVIM environment variable" $ do 10 | it "is a UnixSocket if it doesn't contain a colon" $ do 11 | UnixSocket actual <- parseNvimEnvironmentVariable "/some/file" 12 | actual `shouldBe` "/some/file" 13 | it "is a tcp connection if it contains a colon" $ do 14 | TCP actualPort actualHostname <- parseNvimEnvironmentVariable "localhost:12345" 15 | actualPort `shouldBe` 12345 16 | actualHostname `shouldBe` "localhost" 17 | it "the last number after many colons is the port" $ do 18 | TCP actualPort actualHostname <- parseNvimEnvironmentVariable "the:cake:is:a:lie:777" 19 | actualPort `shouldBe` 777 20 | actualHostname `shouldBe` "the:cake:is:a:lie" 21 | -------------------------------------------------------------------------------- /tests/RPC/SocketReaderSpec.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module RPC.SocketReaderSpec where 4 | 5 | import Neovim 6 | import Neovim.Plugin.Classes 7 | import Neovim.RPC.SocketReader (parseParams) 8 | 9 | import Test.Hspec 10 | 11 | spec :: Spec 12 | spec = do 13 | describe "parseParams" $ do 14 | it "should pass the inner argument list as is for functions" $ do 15 | parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]] 16 | `shouldBe` [ObjectNil, ObjectBinary "ABC"] 17 | parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"] 18 | `shouldBe` [ObjectNil, ObjectBinary "ABC"] 19 | parseParams (Function (F "") Sync) [] 20 | `shouldBe` [] 21 | 22 | let defCmdArgs = def :: CommandArguments 23 | it "should filter out implicit arguments" $ do 24 | parseParams 25 | (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"])) 26 | [ObjectArray []] 27 | `shouldBe` [toObject defCmdArgs] 28 | parseParams 29 | (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"])) 30 | [ObjectArray [ObjectBinary "7", ObjectInt 7]] 31 | `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7] 32 | 33 | it "should set the CommandOptions argument as expected" $ do 34 | parseParams 35 | ( Command 36 | (F "") 37 | ( mkCommandOptions 38 | [CmdRange WholeFile, CmdBang, CmdNargs "*"] 39 | ) 40 | ) 41 | [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil] 42 | , ObjectArray [ObjectInt 1, ObjectInt 12] 43 | , ObjectInt 1 44 | ] 45 | `shouldBe` [ toObject (defCmdArgs{bang = Just True, range = Just (1, 12)}) 46 | , ObjectBinary "7" 47 | , ObjectBinary "8" 48 | , ObjectNil 49 | ] 50 | 51 | it "should pass this test" $ do 52 | parseParams 53 | (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang])) 54 | [ ObjectArray 55 | [ ObjectBinary "me" 56 | , ObjectBinary "up" 57 | , ObjectBinary "before" 58 | , ObjectBinary "you" 59 | , ObjectBinary "go" 60 | , ObjectBinary "go" 61 | ] 62 | , ObjectArray 63 | [ ObjectInt 1 64 | , ObjectInt 27 65 | ] 66 | , ObjectInt 0 67 | ] 68 | `shouldBe` [ toObject (defCmdArgs{bang = Just False, range = Just (1, 27)}) 69 | , ObjectBinary "me" 70 | , ObjectArray 71 | [ ObjectBinary "up" 72 | , ObjectBinary "before" 73 | , ObjectBinary "you" 74 | , ObjectBinary "go" 75 | , ObjectBinary "go" 76 | ] 77 | ] 78 | -------------------------------------------------------------------------------- /tests/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------