diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/apiblobs/0.1.7.msgpack b/apiblobs/0.1.7.msgpack new file mode 100644 Binary files /dev/null and b/apiblobs/0.1.7.msgpack differ diff --git a/apiblobs/README.md b/apiblobs/README.md new file mode 100644 --- /dev/null +++ b/apiblobs/README.md @@ -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. diff --git a/library/Neovim.hs b/library/Neovim.hs --- a/library/Neovim.hs +++ b/library/Neovim.hs @@ -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' - ]) - ] + ] + }] } @ diff --git a/library/Neovim/API/Parser.hs b/library/Neovim/API/Parser.hs --- a/library/Neovim/API/Parser.hs +++ b/library/Neovim/API/Parser.hs @@ -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'])) diff --git a/library/Neovim/API/String.hs b/library/Neovim/API/String.hs --- a/library/Neovim/API/String.hs +++ b/library/Neovim/API/String.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} {- | Module : Neovim.API.String Description : String based API diff --git a/library/Neovim/API/TH.hs b/library/Neovim/API/TH.hs --- a/library/Neovim/API/TH.hs +++ b/library/Neovim/API/TH.hs @@ -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)|]) [] diff --git a/library/Neovim/Classes.hs b/library/Neovim/Classes.hs --- a/library/Neovim/Classes.hs +++ b/library/Neovim/Classes.hs @@ -1,9 +1,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. diff --git a/library/Neovim/Context.hs b/library/Neovim/Context.hs --- a/library/Neovim/Context.hs +++ b/library/Neovim/Context.hs @@ -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 -> diff --git a/library/Neovim/Context/Internal.hs b/library/Neovim/Context/Internal.hs --- a/library/Neovim/Context/Internal.hs +++ b/library/Neovim/Context/Internal.hs @@ -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) + diff --git a/library/Neovim/Debug.hs b/library/Neovim/Debug.hs --- a/library/Neovim/Debug.hs +++ b/library/Neovim/Debug.hs @@ -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) () diff --git a/library/Neovim/Exceptions.hs b/library/Neovim/Exceptions.hs new file mode 100644 --- /dev/null +++ b/library/Neovim/Exceptions.hs @@ -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 diff --git a/library/Neovim/Plugin.hs b/library/Neovim/Plugin.hs --- a/library/Neovim/Plugin.hs +++ b/library/Neovim/Plugin.hs @@ -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 diff --git a/library/Neovim/Plugin/Classes.hs b/library/Neovim/Plugin/Classes.hs --- a/library/Neovim/Plugin/Classes.hs +++ b/library/Neovim/Plugin/Classes.hs @@ -1,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 diff --git a/library/Neovim/Plugin/ConfigHelper.hs b/library/Neovim/Plugin/ConfigHelper.hs --- a/library/Neovim/Plugin/ConfigHelper.hs +++ b/library/Neovim/Plugin/ConfigHelper.hs @@ -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] + ] + } ] } diff --git a/library/Neovim/Plugin/ConfigHelper/Internal.hs b/library/Neovim/Plugin/ConfigHelper/Internal.hs --- a/library/Neovim/Plugin/ConfigHelper/Internal.hs +++ b/library/Neovim/Plugin/ConfigHelper/Internal.hs @@ -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}}} diff --git a/library/Neovim/Plugin/IPC/Classes.hs b/library/Neovim/Plugin/IPC/Classes.hs --- a/library/Neovim/Plugin/IPC/Classes.hs +++ b/library/Neovim/Plugin/IPC/Classes.hs @@ -1,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 diff --git a/library/Neovim/Plugin/Internal.hs b/library/Neovim/Plugin/Internal.hs --- a/library/Neovim/Plugin/Internal.hs +++ b/library/Neovim/Plugin/Internal.hs @@ -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 diff --git a/library/Neovim/Quickfix.hs b/library/Neovim/Quickfix.hs --- a/library/Neovim/Quickfix.hs +++ b/library/Neovim/Quickfix.hs @@ -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 diff --git a/library/Neovim/RPC/Classes.hs b/library/Neovim/RPC/Classes.hs --- a/library/Neovim/RPC/Classes.hs +++ b/library/Neovim/RPC/Classes.hs @@ -1,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 diff --git a/library/Neovim/RPC/FunctionCall.hs b/library/Neovim/RPC/FunctionCall.hs --- a/library/Neovim/RPC/FunctionCall.hs +++ b/library/Neovim/RPC/FunctionCall.hs @@ -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 diff --git a/library/Neovim/RPC/SocketReader.hs b/library/Neovim/RPC/SocketReader.hs --- a/library/Neovim/RPC/SocketReader.hs +++ b/library/Neovim/RPC/SocketReader.hs @@ -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 diff --git a/library/Neovim/Test.hs b/library/Neovim/Test.hs --- a/library/Neovim/Test.hs +++ b/library/Neovim/Test.hs @@ -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 [] diff --git a/nvim-hs.cabal b/nvim-hs.cabal --- a/nvim-hs.cabal +++ b/nvim-hs.cabal @@ -1,5 +1,5 @@ name: nvim-hs -version: 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 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 diff --git a/test-suite/Neovim/API/THSpec.hs b/test-suite/Neovim/API/THSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/API/THSpec.hs @@ -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) diff --git a/test-suite/Neovim/API/THSpecFunctions.hs b/test-suite/Neovim/API/THSpecFunctions.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/API/THSpecFunctions.hs @@ -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" diff --git a/test-suite/Neovim/EmbeddedRPCSpec.hs b/test-suite/Neovim/EmbeddedRPCSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/EmbeddedRPCSpec.hs @@ -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] + diff --git a/test-suite/Neovim/Plugin/ClassesSpec.hs b/test-suite/Neovim/Plugin/ClassesSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/Plugin/ClassesSpec.hs @@ -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 + diff --git a/test-suite/Neovim/Plugin/ConfigHelperSpec.hs b/test-suite/Neovim/Plugin/ConfigHelperSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/Plugin/ConfigHelperSpec.hs @@ -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" + diff --git a/test-suite/Neovim/RPC/SocketReaderSpec.hs b/test-suite/Neovim/RPC/SocketReaderSpec.hs new file mode 100644 --- /dev/null +++ b/test-suite/Neovim/RPC/SocketReaderSpec.hs @@ -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" + ] + ] +