nvim-hs 0.1.0 → 0.2.0
raw patch · 31 files changed
+1078/−320 lines, 31 filesdep +deepseqdep +megaparsecdep −parsecdep ~messagepackdep ~mtlbinary-added
Dependencies added: deepseq, megaparsec
Dependencies removed: parsec
Dependency ranges changed: messagepack, mtl
Files
- CHANGELOG.md +20/−0
- README.md +204/−3
- apiblobs/0.1.7.msgpack binary
- apiblobs/README.md +4/−0
- library/Neovim.hs +20/−118
- library/Neovim/API/Parser.hs +19/−11
- library/Neovim/API/String.hs +1/−0
- library/Neovim/API/TH.hs +44/−36
- library/Neovim/Classes.hs +43/−27
- library/Neovim/Context.hs +20/−11
- library/Neovim/Context/Internal.hs +37/−33
- library/Neovim/Debug.hs +5/−2
- library/Neovim/Exceptions.hs +45/−0
- library/Neovim/Plugin.hs +15/−15
- library/Neovim/Plugin/Classes.hs +26/−8
- library/Neovim/Plugin/ConfigHelper.hs +13/−9
- library/Neovim/Plugin/ConfigHelper/Internal.hs +10/−10
- library/Neovim/Plugin/IPC/Classes.hs +16/−5
- library/Neovim/Plugin/Internal.hs +13/−3
- library/Neovim/Quickfix.hs +14/−3
- library/Neovim/RPC/Classes.hs +6/−2
- library/Neovim/RPC/FunctionCall.hs +17/−7
- library/Neovim/RPC/SocketReader.hs +2/−1
- library/Neovim/Test.hs +4/−3
- nvim-hs.cabal +22/−13
- test-suite/Neovim/API/THSpec.hs +118/−0
- test-suite/Neovim/API/THSpecFunctions.hs +22/−0
- test-suite/Neovim/EmbeddedRPCSpec.hs +67/−0
- test-suite/Neovim/Plugin/ClassesSpec.hs +71/−0
- test-suite/Neovim/Plugin/ConfigHelperSpec.hs +111/−0
- test-suite/Neovim/RPC/SocketReaderSpec.hs +69/−0
CHANGELOG.md view
@@ -1,3 +1,23 @@+# 0.2.0++* Replace error code of remote functions to return+ `Either NeovimException a` instead of a generic messagepack `Object`++* Export API functions that throw a `NeovimException` instead of returning+ `Either NeovimExeception a`.++* Replace three element tuple for stateful function declaration (#53)++* Add a stack template for easier setup++* Exceptions from pure code are now caught (#48)++# 0.1.0++* Adjust parser for output of `nvim --api-info`++* Adjust parser of ConfigHelper plugin+ # 0.0.7 * Adjust handling of string sent by neovim in API generation.
README.md view
@@ -18,9 +18,210 @@ # How do I start using this? -All you need to know is inside the-[Neovim](https://github.com/neovimhaskell/nvim-hs/blob/master/library/Neovim.hs)-module ([hackage](http://hackage.haskell.org/package/nvim-hs-0.0.5/docs/Neovim.html)).+First, you have to decide how you want to manage your plugins. Every section+of this chapter describes an alternative way to manage your plugins. It+starts with a list of pros and cons and then explains what you have to do to+get rolling and how you would install a `nvim-hs`-compatible plguin. The+general library documentation is in the haddocks on+([hackage](http://hackage.haskell.org/package/nvim-hs-0.2.0/docs/Neovim.html)).+If you are new to Haskell development or you don't really care how you manage+your plugins, I (saep) recommend the stack template approach.++## Stack via the template++### Pros++- Easy to setup because of the template+- Flexible dependency management; everything that stack supports can be done, this+ includes packages on stackage, packages on hackage, local packages and repositories+- Reprobucible; if it works once, it will work in the future+- If you don't use stack just for neovim plugins and you have other projects with the+ same (or a similiar) lts (long term support) version, you save compilation time on the+ initial setup++### Cons++- A bit verbose; you have to add dependencies twice if they are not in the stackage snapshot++### Installation++First, you must [install stack](https://docs.haskellstack.org/en/stable/README/).++You have to have installed neovim and the executable `nvim` must be on the path.+(The API code generation calls `nvim --api-info`.)++Afterwards, you switch to your neovim configuration folder (typically `~/.config/nvim`) and+you have to create your plugin project.++> cd ~/.config/nvim++> stack new my-nvim-hs https://raw.githubusercontent.com/neovimhaskell/nvim-hs/master/stack-template.hsfiles --bare --omit-packages --ignore-subdirs++Since `nvim-hs` is not yet on stackage, you have to edit the generated+`stack.yaml` file by hand (sorry about that). Replace the packages list with+one containing the current directory and the extra-deps list with a+dependency to nvim-hs. The lines of the file that look like this++```yaml+packages: []++extra-deps: []+```++should become:++```yaml+packages:+- .++extra-deps:+- nvim-hs-0.2.0+```++Now, you have to compile everything.++> stack setup++> stack build++If there are no errors (there shouldn't be any), you only have to tell neovim how to start this.+Add the following to your `init.vim`:++```vimL+if has('nvim') " This way, you can also put this in your plain vim config++ " function which starts a nvim-hs instance with the supplied name+ function! s:RequireHaskellHost(name)+ " It is important that the current working directory (cwd) is where+ " your configuration files are.+ return jobstart(['stack', 'exec', 'nvim-hs', a:name.name], {'rpc': v:true, 'cwd': expand('$HOME') . '/.config/nvim'})+ endfunction++ " Register a plugin host that is started when a haskell file is opened+ call remote#host#Register('haskell', "*.l\?hs", function('s:RequireHaskellHost'))++ " But if you need it for other files as well, you may just start it+ " forcefully by requiring it+ let hc=remote#host#Require('haskell')+endif+```++If you start neovim now, you can use the predefined functions from the template.++> :echo NextRandom()++should print a random number.++### Installing a plugin from Hackage++Let's take [nvim-hs-ghcid](http://hackage.haskell.org/package/nvim-hs-ghcid)+as an example. Since it is not on stackage, have to declare the dependency+in the `my-nvim-hs.cabal` file and in the `stack.yaml` file. In the `.cabal`+file, add `nvim-hs-ghcid` to the `build-depends` section. It should look+like this:++```cabal+ build-depends: base >= 4.7 && < 5+ , nvim-hs >= 0.2.0 && < 1.0.0+ , nvim-hs-ghcid+```++You can omit the version number, since you will have to define it in the+`stack.yaml` file and you are managing you dependencies with stack anyways.+The `extra-deps` section of the `stack.yaml` should look like this:++```yaml+extra-deps:+- nvim-hs-0.2.0+- nvim-hs-contrib-0.2.0+- nvim-hs-ghcid-0.2.0+```++What is the `nvim-hs-contrib` dependency we had to add there? The plugin we+chose to install had a dependency to a haskell project that is not on+stackage. You have to add these to the stack.yaml file as well, although you+do not necessarily have to add them to the cabal file. This is exactly the+disadvantage of using stack for this. The benefit is that you will have a+reproducible build in the future and you don't have to hunt down a working+set of version boundariesfor every dependency you have. A little effort now+will save you more time later!++Note that I (saep) intend to add `nvim-hs` and `nvim-hs-contrib` to stackage+once I feel I should switch to version 1.0.0. Then, you wouldn't have to+edit the `stack.yaml` for this. If you want to update a dependency/plugin,+you have to manually increment the version number in the stack.yaml file and+possibly fix the compilation errors that arise. If you want a rolling+release for a plugin, follow the instructions for installing a plugin from+git.++To use the plugin, add it to the plugins list of the `nvim.hs` file in+`~/.config/nvim`:++```haskell+import Neovim++import qualified Neovim.Example.Plugin as Example+import qualified Neovim.Ghcid as Ghcid++main :: IO ()+main = do+ neovim defaultConfig+ { plugins = plugins defaultConfig +++ [ Example.plugin+ , Ghcid.plugin+ ]+ }+```+++### Installing a plugin from git++This method is best suited for plugins that update a lot and for which you need+the most recent version most of the time. If you don't intend to work on the+code of that plugin repository, you can add it to the plugin list of your+plugin manager (e.g. [vim-plug](https://github.com/junegunn/vim-plug)). +This way, you get updates if you update all your normal vim plugins.+To stay with the example of the previous section, we use the `nvim-hs-ghcid`+plugin again.++Add the plugin to your plugin manager (here with vim-plug as an example):++```vimL+Plug 'saep/nvim-hs-ghcid', { 'for': ['haskell'] }+```++Once vim-plug has cloned or updated the repository, add the plugin to the+packages list of the `stackage.yaml` file. The packages list should look+like this:++```yaml+packages:+- .+- plugged/nvim-hs-ghcid+```++As long as you have the repository in this list, you don't have to specify+it as a dependency anywhere else, you still have to add the plugins'+dependencies to the `stack.yaml` file, though. It should look like this:++```yaml+extra-deps:+- nvim-hs-0.2.0+- nvim-hs-contrib-0.2.0+```++Add the plugin to the plugins list in `nvim.hs` in exactly the same way as+described in the previous chapter.++The downside of this is that your compilation times will be longer the more+plugins you include this way.++### Writing your own functions that you can call from neovim++The stack template generated a few files for you that you can use as a+template to write your own plugins. If you edit them and make a mistake that+the Haskell compiler can detect, an item in the quickfix list should appear.+This is, unless you removed `plugins defaultConfig` from `nvim.hs`. # Contributing
+ apiblobs/0.1.7.msgpack view
binary file changed (absent → 16768 bytes)
+ apiblobs/README.md view
@@ -0,0 +1,4 @@+This directory contains the output of `nvim --api-info` for different+versions of neovim. This allows building this package without neovim being+installed. This is mainly useful for CI systems or to test compatibility+with previous versions of the API.
library/Neovim.hs view
@@ -16,11 +16,7 @@ -} module Neovim ( -- * Installation- -- ** tl;dr- -- $tldrinstallation-- -- ** Explained- -- $explainedinstallation+ -- $installation -- * Tutorial -- ** tl;dr@@ -39,6 +35,7 @@ -- ** Creating a plugin -- $creatingplugins NeovimPlugin(..),+ StatefulFunctionality(..), Plugin(..), NvimObject(..), (+:),@@ -76,6 +73,7 @@ waitErr', err, Doc,+ Pretty(..), errOnInvalidResult, text, NeovimException(..),@@ -89,6 +87,8 @@ withCustomEnvironment, whenM, unlessM,+ docToObject,+ docFromObject, Priority(..), module Control.Monad, module Control.Applicative,@@ -109,7 +109,8 @@ import Neovim.API.String import Neovim.API.TH (autocmd, command, command', function, function')-import Neovim.Classes (Dictionary, NvimObject (..), (+:))+import Neovim.Classes (Dictionary, NvimObject (..),+ docFromObject, docToObject, (+:)) import Neovim.Config (NeovimConfig (..)) import Neovim.Context (Neovim, Neovim', NeovimException (ErrorMessage),@@ -119,128 +120,27 @@ import Neovim.Main (neovim) import Neovim.Plugin (addAutocmd, addAutocmd') import Neovim.Plugin.Classes (AutocmdOptions (..),- CommandArguments (..), CommandOption (CmdSync, CmdRegister, CmdRange, CmdCount, CmdBang),+ CommandArguments (..),+ CommandOption (CmdBang, CmdCount, CmdRange, CmdRegister, CmdSync), RangeSpecification (..), Synchronous (..)) import qualified Neovim.Plugin.ConfigHelper as ConfigHelper import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..),- wrapPlugin)+ StatefulFunctionality(..), wrapPlugin) import Neovim.Plugin.Startup (StartupConfig (..)) import Neovim.RPC.FunctionCall (wait, wait', waitErr, waitErr') import Neovim.Util (unlessM, whenM, withCustomEnvironment) import System.Log.Logger (Priority (..))-import Text.PrettyPrint.ANSI.Leijen (Doc, text)+import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..), text) -- Installation {{{1--- tl;dr installation {{{2-{- $tldrinstallation--Make sure that neovim's executable (@nvim@) is on your @\$PATH@ during the-cabal commands!--/nvim-hs/ is a normal haskell program and a normal haskell library. You can install it-in various flavors. These steps describe a more laborous approach that is suited for-developing plugins or /nvim-hs/ itself.--The following steps will install `nvim-hs` from git-(example assumes you clone to @\$HOME\/git\/nvim-hs@)-using a sandbox:--@-\$ mkdir -p ~\/git ; cd ~\/git-\$ git clone https:\/\/github.com\/neovimhaskell\/nvim-hs-\$ cd nvim-hs-\$ cabal sandbox init-\$ cabal install-@--Or in one line for copy-pasting:--@-mkdir -p ~\/git ; cd ~\/git ; git clone https:\/\/github.com\/neovimhaskell\/nvim-hs && cd nvim-hs && cabal sandbox init && cabal install-@--Copy the script @nvim-hs-devel.sh@ to a location you like, make it executable-and __follow the brief instructions__ in the comments.--@-\$ cp nvim-hs-devel.sh ~\/bin\/-\$ chmod +x ~\/bin\/nvim-hs-devel.sh-@--Assuming you have copied the script to @\$HOME\/bin\/nvim-hs-devel.sh@,-put this in your neovim config file (typically @~\/.nvimrc@ or @~\/.nvim\/nvimrc@):--@-if has(\'nvim\') \" This way you can also put it in your vim config file- call rpcrequest(rpcstart(expand(\'\$HOME\/.bin\/nvim-hs-devel.sh\')), \"PingNvimhs\")-endif-@---}--- 2}}}---- Explained {{{2-{- $explainedinstallation--If you want to use or write plugins written in haskell for /nvim-hs/, you first-have to make sure that neovim is installed and that it is available on your-@\$PATH@ during the compilation of /nvim-hs/. Neovim emits information about its-remotely callable API if you call it with the `--api-info` command line-argument. This output is used to generate the API functions you need-to create useful plugins. Also, some internal functionality requires some of-these functions.--The instructions to install /nvim-hs/ should be self-explanatory. In any case, I-(saep) recommend using a sandbox for now since I the version constraints of the-dependencies are quire lax and there are still changes on the way. Also, there is-no official neovim release yet, so you may have to reinstall /nvim-hs/ a few times-because the generated API could change or something similar. A sandboxed environment-can be saefly deleted and it requires you only to copy and edit a small shell script!--Using a sandbox requires you to install all-the libraries you want or have to use in your plugins to be installed inside the-sandbox! Some Vim plugins (e.g. ghc-mod) may show weird errors inside neovim for-your configuration file because the sandbox is not inside your configuration folder.-For /nvim-hs/ you don't need to worry about that, though, because it has a-builtin plugin which puts all compile-errors in the quickfix-list automatically after you save your configuration file, so you don't need-another plugin to detect compile time errors here. But we will discuss this-later in more detail. The executable script mentioned in the tl;dr installation-instructions sets up the build environment for /nvim-hs/ to use the sandbox.--The Vim-script snippet is a bit conservative and may have a negative impact on-your startup time. You can remove the @rpcrequest()@ wrapping and call the function-@PingNvimhs@ at a later time when you need /nvim-hs/ to be initialized. Use your-own judgement! In any case, the snippet can be put anywhere in your neovim-configuration. You may wonder why we have to explicitly-call @PingNvimhs@ with the function @rpcrequest@ here. The short answer is:-The internals for registering functions from a remote host require this. The-longer answer is as follows: Registering functions from a remote host does not-define a function directly. It instead installs a hook via an autocmd that-defines the function. This way, only functions that are actually used are-registered and this probably was implemented this way for performance reasons.-Buf, if we try to call a function from a remote host too early, the hooks may-not yet be in place and we receive error messages. Since we do not generate any-Vim-script files which contain those hooks, /nvim-hs/ must be started and-initialized and create those hooks. So the best way to make sure that /nvim-hs/-is initialized is to try to call some functionon on the msgpack-rpc channel that-/nvim-hs/ listens on. The function must not even exist, but not throwing an-error message is probably nicer, so /nvim-hs/ provides a function \"PingNvimhs\"-which takes no arguments and returns @\"Pong\"@.+{- $installation -Using /nvim-hs/ essentially means to use a static binary that incorporates all-plugins. It is generated using the 'Dyre' library and the binary itself is found-in @\$XDG_CACHE_DIR\/nvim@ (usually @~\/.cache\/nvim@). The 'Dyre' library makes-it feel more like a scripting language, because the binary is automatically-created and executed without having to restart neovim. You can also use the-functions from the "Neovim.Debug" module if you want to develop your plugins in-a REPL environment. This is probably a bit more difficult to use, so I won't go-into detail here.+Installation instructions are in the README.md file that comes with the source+of this package. It is also on the repositories front page. -}--- 2}}} -- 1}}} -- Tutorial {{{1@@ -494,12 +394,14 @@ let randomNumbers = 'randoms' g -- an infinite list of random numbers 'wrapPlugin' 'Plugin' { 'exports' = []- , 'statefulExports' =- [ ((), randomNumbers,+ , 'statefulExports' = [ 'StatefulFunctionality'+ { readOnly = ()+ , writable = randomNumbers+ , functionalities = [ $('function'' 'nextRandom) 'Sync' , $('function' \"SetNextRandom\" 'setNextRandom) 'Async'- ])- ]+ ]+ }] } @
library/Neovim/API/Parser.hs view
@@ -30,7 +30,8 @@ import Data.Serialize import System.IO (hClose) import System.Process-import Text.Parsec as P+import Text.Megaparsec as P+import Text.Megaparsec.String import Text.PrettyPrint.ANSI.Leijen (Doc) import qualified Text.PrettyPrint.ANSI.Leijen as P @@ -82,7 +83,7 @@ -- | Run @nvim --api-info@ and parse its output. parseAPI :: IO (Either Doc NeovimAPI)-parseAPI = either (Left . P.text) extractAPI <$> decodeAPI+parseAPI = either (Left . P.text) extractAPI <$> (decodeAPI `catch` readFromAPIFile) extractAPI :: Object -> Either Doc NeovimAPI extractAPI apiObj = fromObject apiObj >>= \apiMap -> NeovimAPI@@ -90,9 +91,16 @@ <*> extractCustomTypes apiMap <*> extractFunctions apiMap +readFromAPIFile :: SomeException -> IO (Either String Object)+readFromAPIFile _ = (decode <$> B.readFile "api") `catch` returnPreviousExceptionAsText+ where+ returnPreviousExceptionAsText :: SomeException -> IO (Either String Object)+ returnPreviousExceptionAsText _ = return . Left $+ "The 'nvim' process could not be started and there is no file named\+ \ 'api' in the working directory as a substitute." decodeAPI :: IO (Either String Object)-decodeAPI = bracket queryNeovimAPI clean $ \(out, _) -> do+decodeAPI = bracket queryNeovimAPI clean $ \(out, _) -> decode <$> B.hGetContents out where@@ -155,23 +163,23 @@ parseType s = either (throwError . P.text . show) return $ parse (pType <* eof) s s -pType :: Parsec String u NeovimType+pType :: Parser NeovimType pType = pArray P.<|> pVoid P.<|> pSimple -pVoid :: Parsec String u NeovimType+pVoid :: Parser NeovimType pVoid = const Void <$> (P.try (string "void") <* eof) -pSimple :: Parsec String u NeovimType-pSimple = SimpleType <$> many1 (noneOf ",)")+pSimple :: Parser NeovimType+pSimple = SimpleType <$> some (noneOf [',', ')']) -pArray :: Parsec String u NeovimType+pArray :: Parser NeovimType pArray = NestedType <$> (P.try (string "ArrayOf(") *> pType)- <*> optionMaybe pNum <* char ')'+ <*> optional pNum <* char ')' -pNum :: Parsec String u Int-pNum = read <$> (P.try (char ',') *> spaces *> many1 (oneOf ['0'..'9']))+pNum :: Parser Int+pNum = read <$> (P.try (char ',') *> space *> some (oneOf ['0'..'9']))
library/Neovim/API/String.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE DeriveGeneric #-} {- | Module : Neovim.API.String Description : String based API
library/Neovim/API/TH.hs view
@@ -57,7 +57,7 @@ import Data.Monoid import qualified Data.Set as Set import Data.Text (Text)-import Text.PrettyPrint.ANSI.Leijen (text, (<+>))+import Text.PrettyPrint.ANSI.Leijen (text, (<+>), Doc) import Prelude @@ -80,13 +80,13 @@ generateAPI typeMap = do api <- either (fail . show) return =<< runIO parseAPI let exceptionName = mkName "NeovimExceptionGen"- exceptions = (\(n,i) -> (mkName ("Neovim" <> n), i)) <$> errorTypes api- customTypesN = first mkName <$> customTypes api+ exceptions = (\(n,i) -> (mkName ("Neovim" <> n), i)) `map` errorTypes api+ customTypesN = first mkName `map` customTypes api join <$> sequence- [ fmap return . createDataTypeWithByteStringComponent exceptionName $ fst <$> exceptions+ [ fmap (join . return) $ createDataTypeWithByteStringComponent exceptionName (map fst exceptions) , exceptionInstance exceptionName , customTypeInstance exceptionName exceptions- , mapM (\n -> createDataTypeWithByteStringComponent n [n]) $ fst <$> customTypesN+ , fmap join . mapM (\n -> createDataTypeWithByteStringComponent n [n]) $ (map fst customTypesN) , join <$> mapM (\(n,i) -> customTypeInstance n [(n,i)]) customTypesN , fmap join . mapM (createFunction typeMap) $ functions api ]@@ -145,41 +145,46 @@ let withDeferred | async nf = appT [t|STM|] | otherwise = id - withException | canFail nf = appT [t|Either Object|]+ withException | canFail nf = appT [t|Either NeovimException|] | otherwise = id - callFn | async nf && canFail nf = [|acall|]- | async nf = [|acall'|]- | canFail nf = [|scall|]- | otherwise = [|scall'|]+ callFns | async nf && canFail nf = [ [|acall|] ]+ | async nf = [ [|acall'|] ]+ | canFail nf = [ [|scall|], [|scallThrow|] ]+ | otherwise = [ [|scall'|] ] - functionName = (mkName . name) nf+ functionNames = map mkName [ name nf, name nf ++ "'" ] toObjVar v = [|toObject $(varE v)|] - ret <- let (r,st) = (mkName "r", mkName "st")- in forallT [PlainTV r, PlainTV st] (return [])- . appT ([t|Neovim $(varT r) $(varT st) |])- . withDeferred . withException- . apiTypeToHaskellType typeMap $ returnType nf+ retTypes <- let (r,st) = (mkName "r", mkName "st")+ createSig retTypeFun =+ forallT [PlainTV r, PlainTV st] (return [])+ . appT ([t|Neovim $(varT r) $(varT st) |])+ . withDeferred . retTypeFun+ . apiTypeToHaskellType typeMap $ returnType nf+ in mapM createSig [ withException, id ] vars <- mapM (\(t,n) -> (,) <$> apiTypeToHaskellType typeMap t <*> newName n) $ parameters nf- sequence- [ sigD functionName . return- . foldr (AppT . AppT ArrowT) ret $ map fst vars- , funD functionName- [ clause- (map (varP . snd) vars)- (normalB (callFn- `appE` ([| (F . fromString) |] `appE` (litE . stringL . name) nf)- `appE` listE (map (toObjVar . snd) vars)))- []++ let impl functionName callFn retType =+ [ sigD functionName . return+ . foldr (AppT . AppT ArrowT) retType $ map fst vars+ , funD functionName+ [ clause+ (map (varP . snd) vars)+ (normalB (callFn+ `appE` ([| (F . fromString) |] `appE` (litE . stringL . name) nf)+ `appE` listE (map (toObjVar . snd) vars)))+ []+ ] ]- ] + sequence . concat $ zipWith3 impl functionNames callFns retTypes + -- | @ createDataTypeWithObjectComponent SomeName [Foo,Bar]@ -- will create this: -- @@@ -188,7 +193,7 @@ -- deriving (Typeable, Eq, Show) -- @ ---createDataTypeWithByteStringComponent :: Name -> [Name] -> Q Dec+createDataTypeWithByteStringComponent :: Name -> [Name] -> Q [Dec] createDataTypeWithByteStringComponent nme cs = do tObject <- [t|ByteString|] #if __GLASGOW_HASKELL__ < 800@@ -196,12 +201,15 @@ #else let strictNess = (Bang NoSourceUnpackedness SourceStrict, tObject) #endif- dataD'- (return [])- nme- []- (map (\n-> normalC n [return strictNess]) cs)- (mkName <$> ["Typeable", "Eq", "Show"])+ sequence+ [ dataD'+ (return [])+ nme+ []+ (map (\n-> normalC n [return strictNess]) cs)+ (mkName <$> ["Typeable", "Eq", "Show", "Generic"])+ , instanceD (return []) (appT (conT (mkName "NFData")) (conT nme)) []+ ] -- | If the first parameter is @mkName NeovimException@, this function will@@ -368,7 +376,7 @@ [ "Trying to generate a command without compatible types." , "Due to a limitation burdened on us by vimL, we can only" , "use a limited amount type signatures for commands. See"- , "the documentation for 'command' for am ore thorough"+ , "the documentation for 'command' for a more thorough" , "explanation." ] [|\copts -> EF (Command@@ -501,6 +509,6 @@ failedEvaluation :: Q Match failedEvaluation = newName "e" >>= \e -> match (conP (mkName "Left") [varP e])- (normalB [|err $(varE e)|])+ (normalB [|err ($(varE e) :: Doc)|]) []
library/Neovim/Classes.hs view
@@ -1,9 +1,13 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 710+{-# LANGUAGE OverlappingInstances #-}+#endif {- | Module : Neovim.Classes Description : Type classes used for conversion of msgpack and Haskell types@@ -18,26 +22,35 @@ ( NvimObject(..) , Dictionary , (+:)+ , Generic+ , docToObject+ , docFromObject , module Data.Int , module Data.Word+ , module Control.DeepSeq ) where +import Neovim.Exceptions (NeovimException(..))+ import Control.Applicative import Control.Arrow+import Control.DeepSeq+import Control.Exception.Lifted (throwIO) import Control.Monad.Except+import Control.Monad.Base (MonadBase(..)) import Data.ByteString (ByteString) import Data.Int (Int16, Int32, Int64, Int8)-import Data.Map (Map)-import qualified Data.Map as Map+import qualified Data.Map.Strict as SMap import Data.MessagePack import Data.Monoid import Data.Text as Text (Text) import Data.Traversable hiding (forM, mapM) import Data.Word (Word, Word16, Word32, Word64, Word8)-import Text.PrettyPrint.ANSI.Leijen (Doc, displayS, lparen,- renderPretty, rparen, text)+import GHC.Generics (Generic)+import Text.PrettyPrint.ANSI.Leijen (Doc, lparen,+ rparen, text, displayS, renderCompact) import qualified Text.PrettyPrint.ANSI.Leijen as P import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)@@ -53,15 +66,29 @@ o +: os = toObject o : os +-- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience+-- method to transport error message from and to neovim. It generally does not+-- hold that 'docToObject . docFromObject' = 'id'.+docToObject :: Doc -> Object+docToObject = toObject . flip displayS "" . renderCompact++-- | See 'docToObject'.+docFromObject :: Object -> Either Doc Doc+docFromObject o = P.pretty . UTF8.toString <$> fromObject o+ -- | A generic vim dictionary is a simply a map from strings to objects. This -- type alias is sometimes useful as a type annotation especially if the -- OverloadedStrings extension is enabled.-type Dictionary = Map ByteString Object+type Dictionary = SMap.Map ByteString Object -- | Conversion from 'Object' files to Haskell types and back with respect -- to neovim's interpretation.-class NvimObject o where+--+-- The 'NFData' constraint has been added to allow forcing results of function+-- evaluations in order to catch exceptions from pure code. This adds more+-- stability to the plugin provider and seems to be a cleaner approach.+class NFData o => NvimObject o where toObject :: o -> Object fromObjectUnsafe :: Object -> o@@ -74,7 +101,10 @@ fromObject :: Object -> Either Doc o fromObject = return . fromObjectUnsafe + fromObject' :: (MonadBase IO io) => Object -> io o+ fromObject' = either (throwIO . ErrorMessage) return . fromObject + -- Instances for NvimObject {{{1 instance NvimObject () where toObject _ = ObjectNil@@ -219,15 +249,7 @@ fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o -instance NvimObject Char where- toObject c = ObjectBinary . UTF8.fromString $ [c]-- fromObject str = case fromObject str of- Right [c] -> return c- _ -> throwError . text $ "Expected one element string but got: " <> show str---instance NvimObject [Char] where+instance {-# OVERLAPPING #-} NvimObject [Char] where toObject = ObjectBinary . UTF8.fromString fromObject (ObjectBinary o) = return $ UTF8.toString o@@ -235,7 +257,7 @@ fromObject o = throwError . text $ "Expected ObjectString, but got " <> show o -instance NvimObject o => NvimObject [o] where+instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where toObject = ObjectArray . map toObject fromObject (ObjectArray os) = mapM fromObject os@@ -267,15 +289,15 @@ instance (Ord key, NvimObject key, NvimObject val)- => NvimObject (Map key val) where+ => NvimObject (SMap.Map key val) where toObject = ObjectMap- . Map.fromList . map (toObject *** toObject) . Map.toList+ . SMap.fromList . map (toObject *** toObject) . SMap.toList - fromObject (ObjectMap om) = Map.fromList <$>+ fromObject (ObjectMap om) = SMap.fromList <$> (sequenceA . map (uncurry (liftA2 (,)) . (fromObject *** fromObject))- . Map.toList) om+ . SMap.toList) om fromObject o = throwError . text $ "Expected ObjectMap, but got " <> show o @@ -301,12 +323,6 @@ fromObject = return fromObjectUnsafe = id---instance NvimObject Doc where- toObject d = toObject $ displayS (renderPretty 1.0 240 d) ""-- fromObject = fmap text . fromObject -- By the magic of vim, i will create these.
library/Neovim/Context.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {- | Module : Neovim.Context@@ -34,17 +35,25 @@ throwError, module Control.Monad.IO.Class,+#if __GLASGOW_HASKELL__ <= 710+ module Control.Applicative,+#endif ) where import Neovim.Classes import Neovim.Context.Internal (FunctionMap, FunctionMapEntry,- Neovim, Neovim',- NeovimException (ErrorMessage),- forkNeovim, mkFunctionMap,+ Neovim, Neovim', forkNeovim,+ mkFunctionMap, newUniqueFunctionName, runNeovim)+import Neovim.Exceptions (NeovimException (..))+ import qualified Neovim.Context.Internal as Internal +#if __GLASGOW_HASKELL__ <= 710+import Control.Applicative+#endif+ import Control.Concurrent (putMVar) import Control.Exception import Control.Monad.Except@@ -52,20 +61,20 @@ import Control.Monad.Reader import Control.Monad.State import Data.MessagePack (Object)-import Text.PrettyPrint.ANSI.Leijen (Doc, text)+import Text.PrettyPrint.ANSI.Leijen (Pretty (..)) --- | @'throw'@ specialized to 'Doc'. If you do not care about pretty printing,--- you can simply use 'text' in front of your string or use the--- @OverloadedStrings@ extension to specify the error message.-err :: Doc -> Neovim r st a-err = throw . ErrorMessage+-- | @'throw'@ specialized to a 'Pretty' value.+err :: Pretty err => err -> Neovim r st a+err = throw . ErrorMessage . pretty -errOnInvalidResult :: (NvimObject o) => Neovim r st (Either Object Object) -> Neovim r st o+errOnInvalidResult :: (NvimObject o)+ => Neovim r st (Either NeovimException Object)+ -> Neovim r st o errOnInvalidResult a = a >>= \case Left o ->- (err . text . show) o+ (err . show) o Right o -> case fromObject o of Left e ->
library/Neovim/Context/Internal.hs view
@@ -4,6 +4,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-} {- | Module : Neovim.Context.Internal Description : Abstract description of the plugin provider's internal context@@ -19,6 +20,8 @@ module Neovim.Context.Internal where +import Neovim.Classes+import Neovim.Exceptions (NeovimException (..)) import Neovim.Plugin.Classes import Neovim.Plugin.IPC (SomeMessage) @@ -26,6 +29,8 @@ import Control.Concurrent (ThreadId, forkIO) import Control.Concurrent (MVar, newEmptyMVar) import Control.Concurrent.STM+import Control.Exception (ArithException, ArrayException,+ ErrorCall, PatternMatchFail) import Control.Monad.Base import Control.Monad.Catch import Control.Monad.Except@@ -33,11 +38,9 @@ import Control.Monad.State import Control.Monad.Trans.Resource import qualified Data.ByteString.UTF8 as U (fromString)-import Data.Data (Typeable) import Data.Map (Map) import qualified Data.Map as Map import Data.MessagePack (Object)-import Data.String (IsString (..)) import System.Log.Logger import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) @@ -86,49 +89,49 @@ -- | Convenience alias for @'Neovim' () ()@. type Neovim' = Neovim () () ---- | Exceptions specific to /nvim-hs/.-data NeovimException- = ErrorMessage Doc- -- ^ Simply error message that is passed to neovim. It should currently only- -- contain one line of text.- deriving (Typeable, Show)---instance Exception NeovimException---instance IsString NeovimException where- fromString = ErrorMessage . fromString---instance Pretty NeovimException where- pretty = \case- ErrorMessage s -> s-+exceptionHandlers :: [Handler IO (Either Doc a)]+exceptionHandlers =+ [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)"+ , Handler $ \(_ :: ArrayException) -> ret "ArrayException"+ , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error"+ , Handler $ \(_ :: PatternMatchFail) -> ret "Pattern match failure"+ , Handler $ \(_ :: SomeException) -> ret "Unhandled exception"+ ]+ where+ ret = return . Left . pretty -- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.-runNeovim :: Config r st+runNeovim :: NFData a+ => Config r st -> st -> Neovim r st a -> IO (Either Doc (a, st))-runNeovim r st (Neovim a) = (try . runReaderT (runStateT (runResourceT a) st)) r >>= \case- Left e -> case fromException e of- Just e' ->- return . Left . pretty $ (e' :: NeovimException)+runNeovim = runNeovimInternal (\(a,st) -> a `deepseq` return (a, st)) - Nothing -> do- liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e- (return . Left . text . show) e- Right res -> (return . Right) res+runNeovimInternal :: ((a, st) -> IO (a, st))+ -> Config r st+ -> st+ -> Neovim r st a+ -> IO (Either Doc (a, st))+runNeovimInternal f r st (Neovim a) =+ (try . runReaderT (runStateT (runResourceT a) st)) r >>= \case+ Left e -> case fromException e of+ Just e' ->+ return . Left . pretty $ (e' :: NeovimException) + Nothing -> do+ liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e+ (return . Left . text . show) e+ Right res ->+ (Right <$> f res) `catches` exceptionHandlers + -- | Fork a neovim thread with the given custom config value and a custom -- state. The result of the thread is discarded and only the 'ThreadId' is -- returend immediately. -- FIXME This function is pretty much unused and mayhave undesired effects, -- namely that you cannot register autocmds in the forked thread.-forkNeovim :: ir -> ist -> Neovim ir ist a -> Neovim r st ThreadId+forkNeovim :: NFData a => ir -> ist -> Neovim ir ist a -> Neovim r st ThreadId forkNeovim r st a = do cfg <- ask' let threadConfig = cfg@@ -244,7 +247,7 @@ retypeConfig r _ cfg = cfg { pluginSettings = Nothing, customConfig = r } --- | This GADT is used to share informatino between stateless and stateful+-- | This GADT is used to share information between stateless and stateful -- plugin threads since they work fundamentally in the same way. They both -- contain a function to register some functionality in the plugin provider -- as well as some values which are specific to the one or the other context.@@ -297,3 +300,4 @@ -- ^ The plugin provider started successfully. deriving (Show)+
library/Neovim/Debug.hs view
@@ -25,6 +25,7 @@ ) where import Neovim+import Neovim.Classes import Neovim.Context (runNeovim) import qualified Neovim.Context.Internal as Internal import Neovim.Log (disableLogger)@@ -62,7 +63,8 @@ return $ Left e Internal.InitSuccess -> do- res <- Internal.runNeovim+ res <- Internal.runNeovimInternal+ return (cfg { Internal.customConfig = r, Internal.pluginSettings = Nothing }) st a@@ -161,7 +163,8 @@ -- | Convenience function to run a stateless 'Neovim' function.-runNeovim' :: Internal.Config r st -> Neovim' a -> IO (Either Doc a)+runNeovim' :: NFData a+ => Internal.Config r st -> Neovim' a -> IO (Either Doc a) runNeovim' cfg = fmap (fmap fst) . runNeovim (Internal.retypeConfig () () cfg) ()
+ library/Neovim/Exceptions.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveDataTypeable #-}+{- |+Module : Neovim.Exceptions+Description : General Exceptions+Copyright : (c) Sebastian Witte+License : Apache-2.0++Maintainer : woozletoff@gmail.com+Stability : experimental+Portability : GHC++-}+module Neovim.Exceptions+ ( NeovimException(..)+ ) where++import Control.Exception (Exception)+import Data.MessagePack (Object (..))+import Data.String (IsString (..))+import Data.Typeable (Typeable)+import Text.PrettyPrint.ANSI.Leijen (Doc, Pretty (..))++-- | Exceptions specific to /nvim-hs/.+data NeovimException+ = ErrorMessage Doc+ -- ^ Simply error message that is passed to neovim. It should currently only+ -- contain one line of text.+ | ErrorResult Object+ -- ^ Error that can be returned by a remote API call. A call of 'fromObject'+ -- on this value could be converted to a value of 'NeovimExceptionGen'.+ deriving (Typeable, Show)+++instance Exception NeovimException+++instance IsString NeovimException where+ fromString = ErrorMessage . fromString+++instance Pretty NeovimException where+ pretty = \case+ ErrorMessage s -> s+ ErrorResult e -> pretty $ show e
library/Neovim/Plugin.hs view
@@ -1,6 +1,5 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {- |@@ -35,7 +34,7 @@ import Neovim.Classes import Neovim.Config import Neovim.Context-import Neovim.Context.Internal (FunctionType (..))+import Neovim.Context.Internal (FunctionType (..), runNeovimInternal) import qualified Neovim.Context.Internal as Internal import Neovim.Plugin.Classes hiding (register) import Neovim.Plugin.Internal@@ -74,7 +73,7 @@ -> [Neovim StartupConfig () NeovimPlugin] -> IO (Either Doc ([FunctionMapEntry],[ThreadId])) startPluginThreads cfg = fmap (fmap fst)- . runNeovim cfg ()+ . runNeovimInternal return cfg () . foldM go ([], []) where go :: ([FunctionMapEntry], [ThreadId])@@ -176,12 +175,13 @@ Nothing -> do api <- nvim_get_api_info case api of- Right (ObjectInt i:_) -> do- liftIO . atomically . putTMVar mp . Right $ fromIntegral i- return . Right $ fromIntegral i-- Left _ ->- err "Unexpected error when quering via nvim_get_api_info."+ Right (i:_) -> do+ case fromObject i :: Either Doc Int of+ Left _ ->+ err "Expected an integral value as the first argument of nvim_get_api_info"+ Right channelId -> do+ liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId+ return . Right $ fromIntegral channelId _ -> err "Could not determine provider name."@@ -228,7 +228,7 @@ liftIO $ warningM logger "Free not implemented for functions." - free cfg = const . void . liftIO . runNeovim cfg () . freeFun+ free cfg = const . void . liftIO . runNeovimInternal return cfg () . freeFun -- | Register a functoinality in a stateless context.@@ -320,9 +320,9 @@ -- | Create a listening thread for events and add update the 'FunctionMap' with -- the corresponding 'TQueue's (i.e. communication channels). registerStatefulFunctionality- :: (r, st, [ExportedFunctionality r st])+ :: StatefulFunctionality r st -> Neovim anyconfig anyState ([FunctionMapEntry], ThreadId)-registerStatefulFunctionality (r, st, fs) = do+registerStatefulFunctionality (StatefulFunctionality r st fs) = do q <- liftIO newTQueueIO route <- liftIO $ newTVarIO Map.empty @@ -333,7 +333,7 @@ , Internal.pluginSettings = Just $ Internal.StatefulSettings (registerInStatefulContext (\_ -> return ())) q route }- res <- liftIO . runNeovim startupConfig st . forM fs $ \f ->+ res <- liftIO . runNeovimInternal return startupConfig st . forM fs $ \f -> registerFunctionality (getDescription f) (getFunction f) es <- case res of Left e -> err e@@ -345,7 +345,7 @@ (registerInStatefulContext registerInGlobalFunctionMap) q route } - tid <- liftIO . forkIO . void . runNeovim pluginThreadConfig st $ do+ tid <- liftIO . forkIO . void . runNeovimInternal return pluginThreadConfig st $ do listeningThread q route return (map fst es, tid) -- NB: dropping release functions/keys here@@ -362,7 +362,7 @@ listeningThread :: TQueue SomeMessage -> TVar (Map FunctionName ([Object] -> Neovim r st Object))- -> Neovim r st loop+ -> Neovim r st () listeningThread q route = do msg <- liftIO . atomically $ readTQueue q
library/Neovim/Plugin/Classes.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} {- | Module : Neovim.Plugin.Classes Description : Classes and data types related to plugins@@ -47,9 +48,12 @@ -- | Essentially just a string. newtype FunctionName = F ByteString- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Generic) +instance NFData FunctionName++ instance Pretty FunctionName where pretty (F n) = blue . text $ toString n @@ -84,9 +88,12 @@ -- * Name for the function to call -- * Options for the autocmd (use 'def' here if you don't want to change anything) - deriving (Show, Read, Eq, Ord)+ deriving (Show, Read, Eq, Ord, Generic) +instance NFData FunctionalityDescription++ instance Pretty FunctionalityDescription where pretty = \case Function fname s ->@@ -115,8 +122,9 @@ -- ^ Call the function and wait for its result. This is only synchronous on -- the neovim side. This means that the GUI will (probably) not -- allow any user input until a reult is received.- deriving (Show, Read, Eq, Ord, Enum)+ deriving (Show, Read, Eq, Ord, Enum, Generic) +instance NFData Synchronous instance Pretty Synchronous where pretty = \case@@ -181,9 +189,11 @@ -- -- Stringliteral: \"!\" - deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Generic) +instance NFData CommandOption + instance Pretty CommandOption where pretty = \case CmdSync s ->@@ -221,8 +231,9 @@ -- object of this type is sorted and only contains zero or one object for each -- possible option. newtype CommandOptions = CommandOptions { getCommandOptions :: [CommandOption] }- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Generic) +instance NFData CommandOptions instance Pretty CommandOptions where pretty (CommandOptions os) =@@ -277,8 +288,9 @@ | RangeCount Int -- ^ Let the command operate on each line in the given range. - deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Generic) +instance NFData RangeSpecification instance Pretty RangeSpecification where pretty = \case@@ -323,9 +335,12 @@ , register :: Maybe String -- ^ Register that the command can\/should\/must use. }- deriving (Eq, Ord, Show, Read)+ deriving (Eq, Ord, Show, Read, Generic) +instance NFData CommandArguments++ instance Pretty CommandArguments where pretty CommandArguments{..} = cat $ catMaybes@@ -384,7 +399,10 @@ , acmdGroup :: Maybe String -- ^ Group in which the autocmd should be registered. }- deriving (Show, Read, Eq, Ord)+ deriving (Show, Read, Eq, Ord, Generic)+++instance NFData AutocmdOptions instance Pretty AutocmdOptions where
library/Neovim/Plugin/ConfigHelper.hs view
@@ -40,14 +40,18 @@ [ $(function' 'pingNvimhs) Sync ] , statefulExports =- [ ((params, ghcEnv), [],- [ $(autocmd 'recompileNvimhs) "BufWritePost" def- { acmdPattern = cfgFile- }- , $(autocmd 'recompileNvimhs) "BufWritePost" def- { acmdPattern = libsDir++"/*"- }- , $(command' 'restartNvimhs) [CmdSync Async, CmdBang, CmdRegister]- ])+ [ StatefulFunctionality+ { readOnly = (params, ghcEnv)+ , writable = []+ , functionalities =+ [ $(autocmd 'recompileNvimhs) "BufWritePost" def+ { acmdPattern = cfgFile+ }+ , $(autocmd 'recompileNvimhs) "BufWritePost" def+ { acmdPattern = libsDir++"/*"+ }+ , $(command' 'restartNvimhs) [CmdSync Async, CmdBang, CmdRegister]+ ]+ } ] }
library/Neovim/Plugin/ConfigHelper/Internal.hs view
@@ -27,8 +27,8 @@ import Control.Applicative hiding (many, (<|>)) import Control.Monad (void, forM_) import Data.Char-import Text.Parsec hiding (Error, count)-import Text.Parsec.String+import Text.Megaparsec hiding (count)+import Text.Megaparsec.String import System.SetEnv import System.Directory (removeDirectoryRecursive) @@ -91,7 +91,7 @@ _ <- many blankLine (f,l,c) <- pLocation - void $ many spaceChar+ void $ many tabOrSpace e <- pSeverity desc <- try pShortDesrciption <|> pLongDescription return $ (quickfixListItem (Right f) (Left l))@@ -109,7 +109,7 @@ pShortDesrciption :: Parser String pShortDesrciption = (:) <$> (notFollowedBy blankLine *> anyChar)- <*> anyChar `manyTill` (void (many1 blankLine) <|> eof)+ <*> anyChar `manyTill` (void (some blankLine) <|> eof) pLongDescription :: Parser String@@ -118,12 +118,12 @@ blank = try (try newline *> try blankLine) -spaceChar :: Parser Char-spaceChar = satisfy $ \c -> c == ' ' || c == '\t'+tabOrSpace :: Parser Char+tabOrSpace = satisfy $ \c -> c == ' ' || c == '\t' blankLine :: Parser ()-blankLine = void . try $ many spaceChar >> newline+blankLine = void . try $ many tabOrSpace >> newline -- | Skip anything until the next location information appears.@@ -135,11 +135,11 @@ -- @\/some\/path\/to\/a\/file.hs:42:88:@ pLocation :: Parser (String, Int, Int) pLocation = (,,)- <$> many1 (noneOf ":\n\t\r") <* char ':'+ <$> some (noneOf ":\n\t\r") <* char ':' <*> pInt <* char ':'- <*> pInt <* char ':' <* many spaceChar+ <*> pInt <* char ':' <* many tabOrSpace pInt :: Parser Int-pInt = read <$> many1 (satisfy isDigit)+pInt = read <$> some (satisfy isDigit) -- 1}}}
library/Neovim/Plugin/IPC/Classes.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE RecordWildCards #-} {- |@@ -19,18 +20,22 @@ Request(..), Notification(..), + UTCTime,+ getCurrentTime,+ module Data.Int,- module Data.Time, ) where +import Neovim.Classes import Neovim.Plugin.Classes (FunctionName) import Control.Concurrent.STM import Data.Data (Typeable, cast) import Data.Int (Int64) import Data.MessagePack-import Data.Time-import Data.Time.Locale.Compat+import Data.Time (UTCTime, formatTime,+ getCurrentTime)+import Data.Time.Locale.Compat (defaultTimeLocale) import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Prelude@@ -83,9 +88,12 @@ -- ^ Identifier to map the result to a function call invocation. , reqArgs :: [Object] -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable)+ } deriving (Eq, Ord, Show, Typeable, Generic) +instance NFData Request++ instance Message Request @@ -105,7 +113,10 @@ -- ^ Name of the function to call. , notArgs :: [Object] -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable)+ } deriving (Eq, Ord, Show, Typeable, Generic)+++instance NFData Notification instance Message Notification
library/Neovim/Plugin/Internal.hs view
@@ -12,6 +12,7 @@ -} module Neovim.Plugin.Internal ( ExportedFunctionality(..),+ StatefulFunctionality(..), getFunction, getDescription, NeovimPlugin(..),@@ -45,11 +46,20 @@ name = name . getDescription +-- | This datatype contains the initial state (mutable and immutable) for the+-- functionalities defined here.+data StatefulFunctionality r st = StatefulFunctionality+ { readOnly :: r+ , writable :: st+ , functionalities :: [ExportedFunctionality r st]+ }++ -- | This data type contains meta information for the plugin manager. -- data Plugin r st = Plugin { exports :: [ExportedFunctionality () ()]- , statefulExports :: [(r, st, [ExportedFunctionality r st])]+ , statefulExports :: [StatefulFunctionality r st] } @@ -60,5 +70,5 @@ -- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple -- list.-wrapPlugin :: Monad m => Plugin r st -> m NeovimPlugin-wrapPlugin = return . NeovimPlugin+wrapPlugin :: Applicative m => Plugin r st -> m NeovimPlugin+wrapPlugin = pure . NeovimPlugin
library/Neovim/Quickfix.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} {- | Module : Neovim.Quickfix Description : API for interacting with the quickfix list@@ -67,13 +68,20 @@ , errorType :: QuickfixErrorType -- ^ Type of error.- } deriving (Eq, Show)+ } deriving (Eq, Show, Generic) +instance (NFData strType) => NFData (QuickfixListItem strType)+++-- | Simple error type enum. data QuickfixErrorType = Warning | Error- deriving (Eq, Ord, Show, Read, Enum, Bounded)+ deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) +instance NFData QuickfixErrorType++ instance NvimObject QuickfixErrorType where toObject = \case Warning -> ObjectBinary "W"@@ -159,7 +167,10 @@ = Append -- ^ Add items to the current list (or create a new one if none exists). | Replace -- ^ Replace current list (or create a new one if none exists). | New -- ^ Create a new list.- deriving (Eq, Ord, Enum, Bounded, Show)+ deriving (Eq, Ord, Enum, Bounded, Show, Generic)+++instance NFData QuickfixAction instance NvimObject QuickfixAction where
library/Neovim/RPC/Classes.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-} {- | Module : Neovim.RPC.Classes Description : Data types and classes for the RPC components@@ -17,7 +18,7 @@ ( Message (..), ) where -import Neovim.Classes (NvimObject (..), (+:))+import Neovim.Classes import Neovim.Plugin.Classes (FunctionName (..)) import qualified Neovim.Plugin.IPC.Classes as IPC @@ -50,7 +51,10 @@ | Notification IPC.Notification -- ^ Notification in the sense of the msgpack rpc specification- deriving (Eq, Ord, Show, Typeable)+ deriving (Eq, Ord, Show, Typeable, Generic)+++instance NFData Message instance IPC.Message Message
library/Neovim/RPC/FunctionCall.hs view
@@ -15,6 +15,7 @@ acall', scall, scall',+ scallThrow, atomically', wait, wait',@@ -29,9 +30,11 @@ import Neovim.Plugin.Classes (FunctionName) import Neovim.Plugin.IPC.Classes import qualified Neovim.RPC.Classes as MsgpackRPC+import Neovim.Exceptions (NeovimException(..)) import Control.Applicative import Control.Concurrent.STM+import Control.Exception.Lifted (throwIO) import Control.Monad.Reader import Data.MessagePack import Data.Monoid@@ -63,7 +66,7 @@ acall :: (NvimObject result) => FunctionName -> [Object]- -> Neovim r st (STM (Either Object result))+ -> Neovim r st (STM (Either NeovimException result)) acall fn parameters = do q <- Internal.asks' Internal.eventQueue mv <- liftIO newEmptyTMVarIO@@ -71,13 +74,13 @@ atomically' . writeTQueue q . SomeMessage $ FunctionCall fn parameters mv timestamp return $ convertObject <$> readTMVar mv where+ convertObject :: (NvimObject result)+ => Either Object Object -> Either NeovimException result convertObject = \case- Left e -> Left e+ Left e -> Left $ ErrorResult e Right o -> case fromObject o of- Left e -> Left (toObject e)- Right r -> Right r--+ Left e -> Left $ ErrorMessage e+ Right r -> Right r -- | Helper function similar to 'acall' that throws a runtime exception if the -- result is an error object.@@ -93,9 +96,16 @@ scall :: (NvimObject result) => FunctionName -> [Object] -- ^ Parameters in an 'Object' array- -> Neovim r st (Either Object result)+ -> Neovim r st (Either NeovimException result) -- ^ result value of the call or the thrown exception scall fn parameters = acall fn parameters >>= atomically'++-- | Similar to 'scall', but throw a 'NeovimException' instead of returning it.+scallThrow :: (NvimObject result)+ => FunctionName+ -> [Object]+ -> Neovim r st result+scallThrow fn parameters = scall fn parameters >>= either throwIO return -- | Helper function similar to 'scall' that throws a runtime exception if the
library/Neovim/RPC/SocketReader.hs view
@@ -47,6 +47,7 @@ import qualified Data.Serialize (get) import System.IO (Handle) import System.Log.Logger+import Text.PrettyPrint.ANSI.Leijen (renderCompact, displayS) import Prelude @@ -141,7 +142,7 @@ res <- fmap fst <$> runNeovim rpc' () (f $ parseParams copts params) -- Send the result to the event handler forM_ mi $ \i -> atomically' . writeTQueue (Internal.eventQueue rpc)- . SomeMessage . MsgpackRPC.Response i $ either (Left . toObject) Right res+ . SomeMessage . MsgpackRPC.Response i $ either (Left . toObject . flip displayS "" . renderCompact) Right res Just (copts, Internal.Stateful c) -> do now <- liftIO getCurrentTime reply <- liftIO newEmptyTMVarIO
library/Neovim/Test.hs view
@@ -12,6 +12,7 @@ -} module Neovim.Test ( testWithEmbeddedNeovim,+ Seconds(..), ) where import Neovim@@ -32,7 +33,7 @@ -- | Type synonym for 'Word'.-type Seconds = Word+newtype Seconds = Seconds Word -- | Run the given 'Neovim' action according to the given parameters.@@ -72,9 +73,9 @@ startEmbeddedNvim :: Maybe FilePath- -> Word+ -> Seconds -> IO (Handle, Handle, ProcessHandle, Internal.Config RPCConfig st)-startEmbeddedNvim file timeout = do+startEmbeddedNvim file (Seconds timeout) = do args <- case file of Nothing -> return []
nvim-hs.cabal view
@@ -1,5 +1,5 @@ name: nvim-hs-version: 0.1.0+version: 0.2.0 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write@@ -29,9 +29,8 @@ copyright: Copyright 2015 Sebastian Witte <woozletoff@gmail.com> category: Editor build-type: Simple-cabal-version: >=1.10--- TODO uncomment when somebody has cared about the new travis infrastructure (see #39)--- tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2+cabal-version: >=1.18+tested-with: GHC == 7.10.3, GHC == 8.0.2 extra-source-files: nvim-hs-devel.sh , test-files/compile-error-for-quickfix-test1 , test-files/compile-error-for-quickfix-test2@@ -39,9 +38,11 @@ , test-files/compile-error-for-quickfix-test4 , test-files/compile-error-for-quickfix-test5 , test-files/hello+ , apiblobs/0.1.7.msgpack extra-doc-files: CHANGELOG.md , README.md+ , apiblobs/README.md source-repository head type: git@@ -70,6 +71,7 @@ , Neovim.Config , Neovim.Context , Neovim.Context.Internal+ , Neovim.Exceptions , Neovim.Plugin , Neovim.Plugin.Classes , Neovim.Plugin.Internal@@ -84,11 +86,10 @@ , Neovim.RPC.SocketReader , Neovim.Plugin.Startup , Neovim.Util-- other-modules: Neovim.Plugin.ConfigHelper.Internal+ , Neovim.Plugin.ConfigHelper.Internal , Neovim.API.Parser , Neovim.API.TH- -- other-extensions:+ other-extensions: DeriveGeneric build-depends: base >=4.6 && < 5 , ansi-wl-pprint , bytestring@@ -98,20 +99,21 @@ , conduit-extra , containers , data-default+ , deepseq >= 1.1 && < 1.5 , directory , dyre , exceptions , filepath , foreign-store , hslogger- , messagepack >= 0.5+ , messagepack >= 0.5.4 , monad-control , network , lifted-base , mtl >= 2.2.1 && < 2.3 , optparse-applicative , time-locale-compat- , parsec >= 3.1.9+ , megaparsec , process , resourcet , setenv >= 0.1.1.3@@ -130,7 +132,7 @@ test-suite hspec type: exitcode-stdio-1.0- hs-source-dirs: test-suite,library+ hs-source-dirs: test-suite main-is: Spec.hs default-language: Haskell2010 build-depends: base >= 4.6 && < 5@@ -155,12 +157,12 @@ , foreign-store , hslogger , lifted-base- , mtl >= 2.2.1 && < 2.3- , messagepack >= 0.5+ , mtl+ , messagepack , time-locale-compat , network , optparse-applicative- , parsec >= 3.1.9+ , megaparsec , process , resourcet , setenv >= 0.1.1.3@@ -173,6 +175,13 @@ , transformers-base , utf8-string , HUnit++ other-modules: Neovim.API.THSpec+ , Neovim.API.THSpecFunctions+ , Neovim.EmbeddedRPCSpec+ , Neovim.Plugin.ClassesSpec+ , Neovim.Plugin.ConfigHelperSpec+ , Neovim.RPC.SocketReaderSpec ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ test-suite/Neovim/API/THSpec.hs view
@@ -0,0 +1,118 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+module Neovim.API.THSpec+ where++import Neovim.API.THSpecFunctions++import Neovim.API.TH+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes+import Neovim.Plugin.Internal++import Data.Default+import qualified Data.Map as Map++import Test.Hspec+import Test.QuickCheck++import Control.Applicative++call :: ([Object] -> Neovim () () Object) -> [Object]+ -> IO Object+call f args = do+ cfg <- Internal.newConfig (pure Nothing) (pure ())+ res <- fmap fst <$> runNeovim cfg () (f args)+ case res of+ Right x -> return x+ Left e -> (throw . ErrorMessage) e+++isNeovimException :: NeovimException -> Bool+isNeovimException _ = True+++spec :: Spec+spec = do+ describe "calling function without an argument" $ do+ let EF (Function fname _, testFun) = $(function "TestFunction0" 'testFunction0) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` (F "TestFunction0")++ it "should return the consant value" $+ call testFun [] `shouldReturn` ObjectInt 42++ it "should fail if supplied an argument" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException+++ describe "calling testFunction with two arguments" $ do+ let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` (F "TestFunction2")++ it "should return 2 for proper arguments" $+ call testFun [ ObjectNil+ , ObjectString "ignored"+ , ObjectArray [ObjectString "42"]+ ]+ `shouldReturn` ObjectDouble 2++ it "should throw an exception for the wrong number of arguments" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException++ it "should throw an exception for incompatible types" $+ call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"]+ `shouldThrow` isNeovimException++ it "should cast arguments to similar types" $+ call testFun [ObjectNil, ObjectString "ignored", ObjectArray []]+ `shouldReturn` ObjectDouble 2+++ describe "generating a command from the two argument test function" $ do+ let EF (Command fname _, testFun) = $(command' 'testFunction2) []+ it "should capitalize the first character" $+ fname `shouldBe` (F "TestFunction2")++ describe "generating the test successor functions" $ do+ let EF (Function fname _, testFun) = $(function' 'testSucc) Sync+ it "should be named TestSucc" $+ fname `shouldBe` (F "TestSucc")++ it "should return the old value + 1" . property $+ \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x+1)++ describe "calling test function with a map argument" $ do+ let EF (Function fname _, testFun) = $(function "TestFunctionMap" 'testFunctionMap) Sync+ it "should capitalize the first letter" $+ fname `shouldBe` (F "TestFunctionMap")++ it "should fail for the wrong number of arguments" $+ call testFun [] `shouldThrow` isNeovimException++ it "should fail for the wrong type of arguments" $+ call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException++ it "should return Nothing for an empty map" $+ call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectNil++ it "should return just the value for the singletion entry" $+ call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectInt 7+++ describe "Calling function with an optional argument" $ do+ let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) []+ defCmdArgs = toObject (def :: CommandArguments)+ it "should capitalize the first letter" $+ cname `shouldBe` (F "TestCommandOptArgument")++ it "should return \"defalt\" when passed no argument" $ do+ call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String)++ it "should return what is passed otherwise" . property $ do+ \str -> call testFun [defCmdArgs, toObject str]+ `shouldReturn` toObject (str :: String)
+ test-suite/Neovim/API/THSpecFunctions.hs view
@@ -0,0 +1,22 @@+module Neovim.API.THSpecFunctions+ where++import qualified Data.Map as Map+import Neovim++testFunction0 :: Neovim' Int+testFunction0 = return 42++testFunction2 :: CommandArguments -> String -> [String] -> Neovim' Double+testFunction2 _ _ _ = return 2++testFunctionMap :: Map.Map String Int -> String -> Neovim' (Maybe Int)+testFunctionMap m k = return $ Map.lookup k m++testSucc :: Int -> Neovim r st Int+testSucc = return . succ++testCommandOptArgument :: CommandArguments -> Maybe String -> Neovim' String+testCommandOptArgument _ ms = case ms of+ Just x -> return x+ Nothing -> return "default"
+ test-suite/Neovim/EmbeddedRPCSpec.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE LambdaCase #-}+module Neovim.EmbeddedRPCSpec+ where++import Test.Hspec+import Test.HUnit++import Neovim+import Neovim.Test+import qualified Neovim.Context.Internal as Internal+import Neovim.Quickfix+import Neovim.RPC.Common+import Neovim.RPC.EventHandler+import Neovim.RPC.FunctionCall (atomically')+import Neovim.RPC.SocketReader++import Control.Concurrent+import Control.Concurrent.STM+import Control.Monad.Reader (runReaderT)+import Control.Monad.State (runStateT)+import Control.Monad.Trans.Resource (runResourceT)+import qualified Data.Map as Map+import System.Directory+import System.Exit (ExitCode (..))+import System.IO (hClose)+import System.Process+++spec :: Spec+spec = parallel $ do+ let helloFile = "test-files/hello"+ withNeovimEmbedded f a = testWithEmbeddedNeovim f (Seconds 3) () () a+ describe "Read hello test file" .+ it "should match 'Hello, World!'" . withNeovimEmbedded (Just helloFile) $ do+ bs <- vim_get_buffers+ l <- vim_get_current_line'+ liftIO $ l `shouldBe` "Hello, World!"+ liftIO $ length bs `shouldBe` 1++ describe "New empty buffer test" $ do+ it "should contain the test text" . withNeovimEmbedded Nothing $ do+ cl0 <- vim_get_current_line'+ liftIO $ cl0 `shouldBe` ""+ bs <- vim_get_buffers'+ liftIO $ length bs `shouldBe` 1++ let testContent = "Test on empty buffer"+ vim_set_current_line testContent+ cl1 <- vim_get_current_line'+ liftIO $ cl1 `shouldBe` testContent++ it "should create a new buffer" . withNeovimEmbedded Nothing $ do+ bs0 <- vim_get_buffers'+ liftIO $ length bs0 `shouldBe` 1+ vim_command "new"+ bs1 <- vim_get_buffers'+ liftIO $ length bs1 `shouldBe` 2+ vim_command "new"+ bs2 <- vim_get_buffers'+ liftIO $ length bs2 `shouldBe` 3++ it "should set the quickfix list" . withNeovimEmbedded Nothing $ do+ let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String+ setqflist [q] Replace+ Right q' <- vim_eval "getqflist()"+ liftIO $ fromObjectUnsafe q' `shouldBe` [q]+
+ test-suite/Neovim/Plugin/ClassesSpec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE RecordWildCards #-}+module Neovim.Plugin.ClassesSpec+ where++import Neovim+import Neovim.Plugin.Classes++import Test.Hspec+import Test.QuickCheck+++newtype RandomCommandArguments = RCA { getRandomCommandArguments :: CommandArguments }+ deriving (Eq, Ord, Show, Read)+++instance Arbitrary RandomCommandArguments where+ arbitrary = do+ bang <- arbitrary+ range <- arbitrary+ count <- arbitrary+ register <- fmap (fmap getNonEmpty) arbitrary+ return . RCA $ CommandArguments{..}+++newtype RandomCommandOption = RCO { getRandomCommandOption :: CommandOption }+ deriving (Eq, Ord, Show, Read)+++instance Arbitrary RandomCommandOption where+ arbitrary = do+ a <- choose (0,5) :: Gen Int+ o <- case a of+ -- XXX Most constructor arguments are not tested anyway, so they are+ -- hardcoded for now.+ 0 -> CmdSync <$> elements [Sync, Async]+ 1 -> return CmdRegister+ 2 -> return $ CmdNargs ""+ 3 -> CmdRange <$> elements [CurrentLine, WholeFile, RangeCount 1]+ 4 -> CmdCount <$> arbitrary+ 5 -> return CmdBang+ return $ RCO o+++newtype RandomCommandOptions = RCOs { getRandomCommandOptions :: CommandOptions }+ deriving (Eq, Ord, Show, Read)+++instance Arbitrary RandomCommandOptions where+ arbitrary = do+ l <- choose (0,20)+ (RCOs . mkCommandOptions . map getRandomCommandOption) <$> vectorOf l arbitrary+++spec :: Spec+spec = do+ describe "Deserializing and serializing" $ do+ it "should be id for CommandArguments" . property $ do+ \args -> (fromObjectUnsafe . toObject . getRandomCommandArguments) args+ `shouldBe` getRandomCommandArguments args++ describe "If a sync option is set for commands" $ do+ let isSyncOption = \case+ CmdSync _ -> True+ _ -> False+ it "must be at the head of the list" . property $ do+ \(RCOs opts) -> any isSyncOption (getCommandOptions opts) ==> do+ length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1+ head (getCommandOptions opts) `shouldSatisfy` isSyncOption+
+ test-suite/Neovim/Plugin/ConfigHelperSpec.hs view
@@ -0,0 +1,111 @@+module Neovim.Plugin.ConfigHelperSpec+ where++import Test.Hspec+import Test.HUnit (assertFailure)++import Neovim.Plugin.ConfigHelper.Internal+import Neovim.Quickfix++import Text.Megaparsec++isLeft :: Either a b -> Bool+isLeft (Left _) = True+isLeft _ = False++isRight :: Either a b -> Bool+isRight = not . isLeft++spec :: Spec+spec = do+ describe "parseQuickFfixItems" $ do+ it "should match this test file 1" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test1"+ let [qs] = parseQuickfixItems e+ bufOrFile qs `shouldBe` Right "/.config/nvim/nvim.hs"+ lnumOrPattern qs `shouldBe` Left 25+ col qs `shouldBe` Just (30, True)+ nr qs `shouldBe` Nothing+ errorType qs `shouldBe` Error++ it "should match this test file 2" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test2"+ let [qs] = parseQuickfixItems e+ bufOrFile qs `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs"+ lnumOrPattern qs `shouldBe` Left 11+ col qs `shouldBe` Just (18, True)+ nr qs `shouldBe` Nothing+ errorType qs `shouldBe` Error++ it "should match this test file 3" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test3"+ let [qs] = parseQuickfixItems e+ bufOrFile qs `shouldBe` Right "/.config/nvim/nvim.hs"+ lnumOrPattern qs `shouldBe` Left 25+ col qs `shouldBe` Just (30, True)+ nr qs `shouldBe` Nothing+ errorType qs `shouldBe` Error++ it "should match this test file 4" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test4"+ let [qs] = parseQuickfixItems e+ bufOrFile qs `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs"+ lnumOrPattern qs `shouldBe` Left 23+ col qs `shouldBe` Just (9, True)+ nr qs `shouldBe` Nothing+ errorType qs `shouldBe` Error++ it "should match this test file 5" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test5"+ let [q1,q2] = parseQuickfixItems e+ bufOrFile q1 `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs"+ bufOrFile q2 `shouldBe` Right "/.config/nvim/lib/TestPlugins.hs"+ lnumOrPattern q1 `shouldBe` Left 23+ lnumOrPattern q2 `shouldBe` Left 23+ col q1 `shouldBe` Just (9, True)+ col q2 `shouldBe` Just (32, True)+ nr q1 `shouldBe` Nothing+ nr q2 `shouldBe` Nothing+ errorType q1 `shouldBe` Warning+ errorType q2 `shouldBe` Warning++ it "should match this test file 6" $ do+ e <- readFile "./test-files/compile-error-for-quickfix-test6"+ let [q1] = parseQuickfixItems e+ bufOrFile q1 `shouldBe` Right "/home/test/.config/nvim/nvim.hs"+ lnumOrPattern q1 `shouldBe` Left 8+ col q1 `shouldBe` Just (7, True)+ nr q1 `shouldBe` Nothing+ errorType q1 `shouldBe` Error++ it "should parse all files concatenated" $ do+ e1 <- readFile "./test-files/compile-error-for-quickfix-test1"+ e2 <- readFile "./test-files/compile-error-for-quickfix-test2"+ e3 <- readFile "./test-files/compile-error-for-quickfix-test3"+ let qs = parseQuickfixItems $ unlines [e1,e2,e3]+ length qs `shouldBe` 3+ case qs of+ [q1, q2, q3] -> do+ lnumOrPattern q1 `shouldBe` Left 25+ lnumOrPattern q2 `shouldBe` Left 11+ lnumOrPattern q3 `shouldBe` Left 25+ _ -> assertFailure "Expected three quickfix list items."++ describe "pShortDesrciption" $ do+ it "should fail for an empty input" $+ parse pShortDesrciption "" "" `shouldSatisfy` isLeft+ it "should fail for an input solely consisting of spaces followed by a newline" $+ parse pShortDesrciption "" " \t \t\t \n" `shouldSatisfy` isLeft+ it "should parse this simple expression" $+ parse pShortDesrciption "" "this simple expression\n"+ `shouldBe` Right "this simple expression"++ describe "pLongDescription" $ do+ it "should parse anything until there is a blank line" $ do+ parse pLongDescription "" "\n\n"+ `shouldBe` Right ""+ parse pLongDescription "" "test\n \n"+ `shouldBe` Right "test"+ parse pLongDescription "" "test\n ibus\n \n"+ `shouldBe` Right "test\n ibus"+
+ test-suite/Neovim/RPC/SocketReaderSpec.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+module Neovim.RPC.SocketReaderSpec+ where++import Neovim+import Neovim.Plugin.Classes+import Neovim.RPC.Common+import Neovim.RPC.SocketReader (parseParams)++import Test.Hspec+import Test.QuickCheck++spec :: Spec+spec = do+ describe "parseParams" $ do++ it "should pass the inner argument list as is for functions" $ do+ parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) []+ `shouldBe` []++ let defCmdArgs = def :: CommandArguments+ it "should filter out implicit arguments" $ do+ parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray []]+ `shouldBe` [toObject defCmdArgs]+ parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray [ObjectBinary "7", ObjectInt 7]]+ `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7]++ it "should set the CommandOptions argument as expected" $ do+ parseParams (Command (F "") (mkCommandOptions+ [ CmdRange WholeFile, CmdBang, CmdNargs "*"]))+ [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil]+ , ObjectArray [ObjectInt 1, ObjectInt 12]+ , ObjectInt 1+ ]+ `shouldBe` [ toObject (defCmdArgs { bang = Just True, range = Just (1,12) })+ , ObjectBinary "7"+ , ObjectBinary "8"+ , ObjectNil]++ it "should pass this test" $ do+ parseParams (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang]))+ [ ObjectArray [ ObjectBinary "me"+ , ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ , ObjectArray [ ObjectInt 1+ , ObjectInt 27+ ]+ , ObjectInt 0+ ]+ `shouldBe` [ toObject (defCmdArgs { bang = Just False, range = Just (1,27) })+ , ObjectBinary "me"+ , ObjectArray [ ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ ]+