diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,13 @@ +# 2.2.0.0 + +* NeovimException are now thrown from (synchronous) remote functions and are no + longer suppressed with an `error` call that also had a terrible error message. + A function `catchNeovimException` (specialized `catch`) has been added that + catches these errors. +* The return type of asynchronous functions is now alwas + `STM (Either NeovimException result)` and errors have to be handled by the + caller explicitly. + # 2.1.0.2 * Exported functions and commands now can have the same name. diff --git a/api b/api Binary files a/api and b/api differ diff --git a/library/Neovim.hs b/library/Neovim.hs --- a/library/Neovim.hs +++ b/library/Neovim.hs @@ -63,6 +63,7 @@ wait', err, errOnInvalidResult, + catchNeovimException, NeovimException(..), -- * Unsorted exports @@ -107,6 +108,7 @@ ask, asks, err, errOnInvalidResult) import Neovim.Main (neovim) +import Neovim.Exceptions (catchNeovimException) import Neovim.Plugin (addAutocmd) import Neovim.Plugin.Classes (AutocmdOptions (..), CommandArguments (..), 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 @@ -20,6 +20,7 @@ stringListTypeMap, textVectorTypeMap, bytestringVectorTypeMap, + createFunction, module UnliftIO.Exception, module Neovim.Classes, module Data.Data, @@ -172,11 +173,11 @@ createFunction :: TypeMap -> NeovimFunction -> Q [Dec] createFunction typeMap nf = do let withDeferred - | async nf = appT [t|STM|] + | async nf = appT [t|STM|] . appT [t|Either NeovimException|] | otherwise = id callFn - | async nf = [|acall'|] + | async nf = [|acall|] | otherwise = [|scall'|] functionName = mkName $ name nf diff --git a/library/Neovim/Exceptions.hs b/library/Neovim/Exceptions.hs --- a/library/Neovim/Exceptions.hs +++ b/library/Neovim/Exceptions.hs @@ -13,6 +13,7 @@ module Neovim.Exceptions ( NeovimException(..) , exceptionToDoc + , catchNeovimException ) where import Control.Exception (Exception) @@ -21,15 +22,16 @@ import Data.Text.Prettyprint.Doc (Doc, (<+>), viaShow) import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle) import Data.Typeable (Typeable) +import UnliftIO (MonadUnliftIO, catch) -- | Exceptions specific to /nvim-hs/. data NeovimException = ErrorMessage (Doc AnsiStyle) - -- ^ Simply error message that is passed to neovim. It should currently only + -- ^ Simple 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'. + | ErrorResult (Doc AnsiStyle) Object + -- ^ Error that can be returned by a remote API call. The 'Doc' argument is + -- the name of the remote function that threw this exception. deriving (Typeable, Show) @@ -45,6 +47,9 @@ ErrorMessage e -> "Error message:" <+> e - ErrorResult o -> - "Result representing an error:" <+> viaShow o + ErrorResult fn o -> + "Function" <+> fn <+> "has thrown an error:" <+> viaShow o +-- | Specialization of 'catch' for 'NeovimException's. +catchNeovimException :: MonadUnliftIO io => io a -> (NeovimException -> io a) -> io a +catchNeovimException action exceptionHandler = action `catch` exceptionHandler 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 @@ -11,7 +11,6 @@ -} module Neovim.RPC.FunctionCall ( acall, - acall', scall, scall', scallThrow, @@ -36,26 +35,6 @@ import Prelude --- | Simply fail and call 'error' in case an unexpected exception is thrown. --- This fails with a runtime exception. It is used by the Template Haskell API --- generator for functions that are defined as not being able to fail. If this --- exception occurs, it is a bug in neovim. -unexpectedException :: String -> err -> a -unexpectedException fn _ = error $ - "Function threw an exception even though it was declared not to throw one: " - ++ fn - - --- | Strip the error result from the function call. This should only be used by --- the Template Haskell API generated code for functions that declare --- themselves as unfailable. -withIgnoredException :: (Functor f) - => FunctionName -- ^ For better error messages - -> f (Either err result) - -> f result -withIgnoredException fn = fmap (either ((unexpectedException . show) fn) id) - - -- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result. acall :: (NvimObject result) => FunctionName @@ -71,20 +50,11 @@ convertObject :: (NvimObject result) => Either Object Object -> Either NeovimException result convertObject = \case - Left e -> Left $ ErrorResult e + Left e -> Left $ ErrorResult (pretty fn) e Right o -> case fromObject o of 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. -acall' :: (NvimObject result) - => FunctionName - -> [Object] - -> Neovim env (STM result) -acall' fn parameters = withIgnoredException fn <$> acall fn parameters - - -- | Call a neovim function synchronously. This function blocks until the -- result is available. scall :: (NvimObject result) @@ -105,7 +75,7 @@ -- | Helper function similar to 'scall' that throws a runtime exception if the -- result is an error object. scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result -scall' fn = withIgnoredException fn . scall fn +scall' fn = either throwIO pure <=< scall fn -- | Lifted variant of 'atomically'. 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: 2.1.0.7 +version: 2.2.0.0 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write diff --git a/test-suite/Neovim/API/THSpec.hs b/test-suite/Neovim/API/THSpec.hs --- a/test-suite/Neovim/API/THSpec.hs +++ b/test-suite/Neovim/API/THSpec.hs @@ -37,7 +37,7 @@ describe "calling function without an argument" $ do let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync it "should have a capitalized prefix" $ - fname `shouldBe` (F "TestFunction0") + fname `shouldBe` F "TestFunction0" it "should return the consant value" $ call testFun [] `shouldReturn` ObjectInt 42 @@ -49,7 +49,7 @@ 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") + fname `shouldBe` F "TestFunction2" it "should return 2 for proper arguments" $ call testFun [ ObjectNil @@ -73,12 +73,12 @@ describe "generating a command from the two argument test function" $ do let EF (Command fname _, _) = $(command' 'testFunction2) [] it "should capitalize the first character" $ - fname `shouldBe` (F "TestFunction2") + 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") + fname `shouldBe` F "TestSucc" it "should return the old value + 1" . property $ \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x+1) @@ -86,7 +86,7 @@ describe "calling test function with a map argument" $ do let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync it "should capitalize the first letter" $ - fname `shouldBe` (F "TestFunctionMap") + fname `shouldBe` F "TestFunctionMap" it "should fail for the wrong number of arguments" $ call testFun [] `shouldThrow` isNeovimException @@ -107,7 +107,7 @@ let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) [] defCmdArgs = toObject (def :: CommandArguments) it "should capitalize the first letter" $ - cname `shouldBe` (F "TestCommandOptArgument") + cname `shouldBe` F "TestCommandOptArgument" it "should return \"default\" when passed no argument" $ do call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String) diff --git a/test-suite/Neovim/EmbeddedRPCSpec.hs b/test-suite/Neovim/EmbeddedRPCSpec.hs --- a/test-suite/Neovim/EmbeddedRPCSpec.hs +++ b/test-suite/Neovim/EmbeddedRPCSpec.hs @@ -7,6 +7,7 @@ import Neovim import Neovim.API.Text +import Neovim.Context (docToText) import qualified Neovim.Context.Internal as Internal import Neovim.Quickfix import Neovim.RPC.Common @@ -65,3 +66,15 @@ q' <- vim_eval "getqflist()" liftIO $ fromObjectUnsafe q' `shouldBe` [q] + it "throws NeovimException with function that failed as Doc" $ do + let getUndefinedVariable = withNeovimEmbedded Nothing $ vim_get_var "notDefined" + getUndefinedVariable `shouldThrow` \case + ErrorResult f _ -> docToText f == "vim_get_var" + _ -> False + + it "catches" . withNeovimEmbedded Nothing $ do + let getUndefinedVariable = vim_get_var "notDefined" + functionThatFailed <- getUndefinedVariable `catchNeovimException` \case + ErrorResult f _ -> pure . toObject $ docToText f + _ -> pure ObjectNil + liftIO $ functionThatFailed `shouldBe` toObject ("vim_get_var" :: String)