diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,17 @@ -# 0.0.4 +# 0.0.6 + +* Noteworthy new API functions for the user's convenience: + + - `errOnInvalidResult` + - `(:+)` + +* ansi-wl-pprint is used for pretty printing of various things now. Most + notably, the error type has been changed from `String` to `Doc`. + This is a breaking change, but it was kind of announced in the issues + list. In any case, uses of `err` can be fixed by enabling the + `OverloadedStrings` extension. Other breakages have to be fixed by hand. + +# 0.0.5 * Documentation received some love. diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,3 +1,18 @@ + Copyright 2015 Sebastian Witte + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. + + Apache License Version 2.0, January 2004 http://www.apache.org/licenses/ @@ -185,18 +200,4 @@ file or class name and description of purpose be included on the same "printed page" as the copyright notice for easier identification within third-party archives. - - Copyright {yyyy} {name of copyright owner} - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# nvim-hs + +Neovim API for Haskell plugins as well as a plugin provider. +This library and executable should provide a basis for developing +plugins. This package should only contain broadly useful interfaces +to write plugins for neovim in haskell. The design goal is to create +an easy to use API that avoids most of the boilerplate while still retaining +some sense of reliability and type safety. Since Template Haskell is used +to generate the neovim bindings and to avoid some of the boilerplate +handy work, some exotic operating systems and architectures may not work. + +[![Build Status](https://travis-ci.org/neovimhaskell/nvim-hs.svg?branch=master)](https://travis-ci.org/neovimhaskell/nvim-hs) +[![Hackage version](https://img.shields.io/hackage/v/nvim-hs.svg?style=flat)](https://hackage.haskell.org/package/nvim-hs) + +# What do I have to expect if I were to use it now? + +Check the issue list here on github. + +# 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)). + +# Contributing + +Documentation, typo fixes and alike will almost always be merged. + +If you want to bring forward new features or convenience libraries +for interacting with neovim, you should create an issue first. The features +of this (cabal) project should be kept small as this helps +reducing the development time. (For some tests it is +necessary to issue `cabal install`, so any change to to a module can +significantly increase the compilation time.) +If your idea solves a general problem, feel free to open an issue in the +library project of nvim-hs: +[nvim-hs-contrib](https://github.com/neovimhaskell/nvim-hs-contrib) + diff --git a/library/Neovim.hs b/library/Neovim.hs --- a/library/Neovim.hs +++ b/library/Neovim.hs @@ -41,6 +41,7 @@ NeovimPlugin(..), Plugin(..), NvimObject(..), + (+:), Dictionary, Object(..), wrapPlugin, @@ -74,6 +75,10 @@ waitErr, waitErr', err, + Doc, + errOnInvalidResult, + text, + NeovimException(..), -- ** Generated functions for neovim interaction module Neovim.API.String, @@ -94,34 +99,38 @@ ) where import Control.Applicative -import Control.Monad (void) -import Control.Monad.IO.Class (liftIO) -import Data.Default (def) -import Data.Int (Int16, Int32, Int64, Int8) -import Data.MessagePack (Object (..)) +import Control.Monad (void) +import Control.Monad.IO.Class (liftIO) +import Data.Default (def) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.MessagePack (Object (..)) import Data.Monoid -import Data.Word (Word, Word32,Word16, Word8) +import Data.Word (Word, Word16, Word32, Word8) import Neovim.API.String -import Neovim.API.TH (autocmd, command, command', - function, function') -import Neovim.Classes (Dictionary, NvimObject (..)) -import Neovim.Config (NeovimConfig (..)) -import Neovim.Context (Neovim, Neovim', ask, asks, err, - get, gets, modify, put) -import Neovim.Main (neovim) -import Neovim.Plugin (addAutocmd, addAutocmd') -import Neovim.Plugin.Classes (AutocmdOptions (..), - CommandArguments (..), CommandOption (CmdSync, CmdRegister, CmdRange, CmdCount, CmdBang), - RangeSpecification (..), - Synchronous (..)) -import qualified Neovim.Plugin.ConfigHelper as ConfigHelper -import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..), - 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 Neovim.API.TH (autocmd, command, command', + function, function') +import Neovim.Classes (Dictionary, NvimObject (..), (+:)) +import Neovim.Config (NeovimConfig (..)) +import Neovim.Context (Neovim, Neovim', + NeovimException (ErrorMessage), + ask, asks, err, + errOnInvalidResult, get, gets, + modify, put) +import Neovim.Main (neovim) +import Neovim.Plugin (addAutocmd, addAutocmd') +import Neovim.Plugin.Classes (AutocmdOptions (..), + CommandArguments (..), CommandOption (CmdSync, CmdRegister, CmdRange, CmdCount, CmdBang), + RangeSpecification (..), + Synchronous (..)) +import qualified Neovim.Plugin.ConfigHelper as ConfigHelper +import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..), + 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) -- Installation {{{1 -- tl;dr installation {{{2 @@ -245,8 +254,14 @@ The code sections that describe new functionality are followed by the source code documentation of the used functions (and possibly a few more). +The config directory location adheres to the +. +Unless you have changed some \$XDG_\* environment variables, the configuration +directory on unixoid systems (e.g. MacOS X, most GNU/Linux distribution, most +BSD distributions) is @\$HOME\/.config\/nvim@. + Create a file called @nvim.hs@ in @\$XDG_CONFIG_HOME\/nvim@ (usually -@~\/.config\/nvim@ with the following content: +@~\/.config\/nvim@) with the following content: @ import Neovim @@ -254,7 +269,7 @@ main = 'neovim' 'defaultConfig' @ -Adjust the fields in 'defaultConfig' according to the the parameters in 'NeovimConfig'. +Adjust the fields in 'defaultConfig' according to the parameters in 'NeovimConfig'. Depending on how you define the parameters, you may have to add some language extensions which GHC should point you to. @@ -326,17 +341,17 @@ it will present you with helpful error messages if your plugin's functions do not work together with neovim. -So, let's write a plugin that calculates the @n@th Fibonacci number. Don't we all +So, let\'s write a plugin that calculates the @n@th Fibonacci number. Don\'t we all love those! -File @~\/.config\/nvim\/lib\/Fibonacci/Plugin.hs@ +File @\~\/.config\/nvim\/lib\/Fibonacci\/Plugin.hs@: @ module Fibonacci.Plugin (fibonacci) where import "Neovim" --- | Neovim is not really good with big numbers, so we return a 'String' here. +\-\- \| Neovim is not really good with big numbers, so we return a 'String' here. fibonacci :: 'Int' -> 'Neovim'' 'String' fibonacci n = 'return' . 'show' \$ fibs !! n where @@ -344,7 +359,7 @@ fibs = 0:1:'scanl1' (+) fibs @ -File @~\/.config\/nvim\/lib/Fibonacci.hs@: +File @\~\/.config\/nvim\/lib\/Fibonacci.hs@: @ \{\-\# LANGUAGE TemplateHaskell \#\-\} @@ -385,11 +400,11 @@ You can use any argument or result type as long as it is an instance of 'NvimObject'. The second part of of the puzzle, which is the definition of @plugin@ -in @~\/.config\/nvim\/lib\/Fibonaccin.hs@, shows what a plugin is. It is essentially two +in @~\/.config\/nvim\/lib\/Fibonacci.hs@, shows what a plugin is. It is essentially two lists of stateless and stateful functionality. A functionality can currently be one of three things: a function, a command and an autocmd in the context of vim terminology. In the end, all of those functionalities map to a function at the side -of /nvim-hs/. If you really want to know what the distinction between those, you +of /nvim-hs/. If you really want to know what the distinction between those is, you have to consult the @:help@ pages of neovim (e.g. @:help :function@, @:help :command@ and @:help :autocmd@). What's relevant from the side of /nvim-hs/ is the distinction between __stateful__ and __stateless__. A stateless function can be called at any @@ -440,7 +455,7 @@ -} -- 2}}} -- Creating a stateful plugin {{{2 -{- $remote +{- $statefulplugin Now that we are a little bit comfortable with the interface provided by /nvim-hs/, we can start to write a more complicated plugin. Let's create a random number generator! @@ -452,14 +467,14 @@ import "Neovim" --- | Neovim isn't so good with big numbers here either. +\-\- | Neovim isn't so good with big numbers here either. nextRandom :: 'Neovim' r ['Int16'] 'Int16' nextRandom = do r <- 'gets' 'head' -- get the head of the infinite random number list 'modify' 'tail' -- set the list to its tail 'return' r -setNextRandom :: 'Int' -> 'Neovim' r ['Int16'] () +setNextRandom :: 'Int16' -> 'Neovim' r ['Int16'] () setNextRandom n = 'modify' (n:) -- cons to the front of the infinite list @ 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 @@ -22,15 +22,17 @@ import Control.Applicative import Control.Exception.Lifted import Control.Monad.Except -import qualified Data.ByteString as B -import Data.Map (Map) -import qualified Data.Map as Map +import qualified Data.ByteString as B +import Data.Map (Map) +import qualified Data.Map as Map import Data.MessagePack import Data.Monoid import Data.Serialize -import System.IO (hClose) +import System.IO (hClose) import System.Process -import Text.Parsec as P +import Text.Parsec as P +import Text.PrettyPrint.ANSI.Leijen (Doc) +import qualified Text.PrettyPrint.ANSI.Leijen as P import Prelude @@ -79,11 +81,15 @@ deriving (Show) -- | Run @nvim --api-info@ and parse its output. -parseAPI :: IO (Either String NeovimAPI) -parseAPI = join . fmap extractAPI <$> decodeAPI +parseAPI :: IO (Either Doc NeovimAPI) +parseAPI = decodeAPI >>= \case + Left e -> + (return . Left . P.text) e + Right o -> + (return . extractAPI) o -extractAPI :: Object -> Either String NeovimAPI +extractAPI :: Object -> Either Doc NeovimAPI extractAPI apiObj = NeovimAPI <$> extractErrorTypes apiObj <*> extractCustomTypes apiObj @@ -105,22 +111,22 @@ terminateProcess ph -oMap :: Object -> Either String (Map Object Object) +oMap :: Object -> Either Doc (Map Object Object) oMap = \case ObjectMap m -> return m o -> - throwError $ "Object is not a map: " ++ show o + throwError . P.text $ "Object is not a map: " ++ show o -oLookup :: Object -> Object -> Either String Object +oLookup :: Object -> Object -> Either Doc Object oLookup qry o = oMap o - >>= maybe (throwError ("No entry for" <> show qry)) return + >>= maybe (throwError (P.text ("No entry for" <> show qry))) return . Map.lookup qry -oLookupDefault :: Object -> Object -> Object -> Either String Object +oLookupDefault :: Object -> Object -> Object -> Either Doc Object oLookupDefault d qry o = oMap o >>= maybe (return d) return . Map.lookup qry @@ -128,7 +134,7 @@ -- | Extract a 'String' from on 'Object'. -- -- Works on @ObjectBinary@ and @ObjectString@ constructor. -oToString :: Object -> Either String String +oToString :: Object -> Either Doc String oToString = fromObject -- ObjectBinary bs -> return $ U.toString bs -- ObjectString t -> return $ U.toString t @@ -137,24 +143,24 @@ -- | Extract an 'Int64' from an @Object@. -- -oInt :: Object -> Either String Int64 +oInt :: Object -> Either Doc Int64 oInt = fromObject -oArr :: Object -> Either String [Object] +oArr :: Object -> Either Doc [Object] oArr = fromObject -oToBool :: Object -> Either String Bool +oToBool :: Object -> Either Doc Bool oToBool = fromObject -extractErrorTypes :: Object -> Either String [(String, Int64)] +extractErrorTypes :: Object -> Either Doc [(String, Int64)] extractErrorTypes objAPI = extractTypeNameAndID =<< oLookup (ObjectBinary "error_types") objAPI -extractTypeNameAndID :: Object -> Either String [(String, Int64)] +extractTypeNameAndID :: Object -> Either Doc [(String, Int64)] extractTypeNameAndID m = do types <- Map.toList <$> oMap m forM types $ \(errName, idMap) -> do @@ -163,24 +169,24 @@ return (n,i) -extractCustomTypes :: Object -> Either String [(String, Int64)] +extractCustomTypes :: Object -> Either Doc [(String, Int64)] extractCustomTypes objAPI = extractTypeNameAndID =<< oLookup (ObjectBinary "types") objAPI -extractFunctions :: Object -> Either String [NeovimFunction] +extractFunctions :: Object -> Either Doc [NeovimFunction] extractFunctions objAPI = do funList <- oArr =<< oLookup (ObjectBinary "functions") objAPI forM funList extractFunction -toParameterlist :: [Object] -> Either String [(NeovimType, String)] +toParameterlist :: [Object] -> Either Doc [(NeovimType, String)] toParameterlist ps = forM ps $ \p -> do [t, n] <- mapM oToString =<< oArr p t' <- parseType t return (t', n) -extractFunction :: Object -> Either String NeovimFunction +extractFunction :: Object -> Either Doc NeovimFunction extractFunction funDefMap = NeovimFunction <$> (oLookup (ObjectBinary "name") funDefMap >>= oToString) <*> (oLookup (ObjectBinary "parameters") funDefMap @@ -191,8 +197,8 @@ <*> (oLookup (ObjectBinary "return_type") funDefMap >>= oToString >>= parseType) -parseType :: String -> Either String NeovimType -parseType s = either (throwError . show) return $ parse (pType <* eof) s s +parseType :: String -> Either Doc NeovimType +parseType s = either (throwError . P.text . show) return $ parse (pType <* eof) s s pType :: Parsec String u NeovimType 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 @@ -40,7 +40,7 @@ import Language.Haskell.TH import Control.Applicative -import Control.Arrow +import Control.Arrow (first) import Control.Concurrent.STM (STM) import Control.Exception import Control.Exception.Lifted @@ -56,6 +56,7 @@ import Data.Monoid import qualified Data.Set as Set import Data.Text (Text) +import Text.PrettyPrint.ANSI.Leijen (text, (<+>)) import Prelude @@ -69,7 +70,7 @@ -- 'ByteString' or 'String'. generateAPI :: Map String (Q Type) -> Q [Dec] generateAPI typeMap = do - api <- either fail return =<< runIO parseAPI + 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 @@ -226,7 +227,10 @@ let n = nameBase typeName clause [ varP o ] - (normalB [|Left $ "Object is not convertible to: " <> n <> " Received: " <> show $(varE o)|]) + (normalB [|throwError $ + text "Object is not convertible to:" + <+> text n + <+> text "Received:" <+> (text . show) $(varE o)|]) [] toObjectClause :: Name -> Int64 -> Q Clause @@ -246,7 +250,7 @@ ] --- | Define an exported function by providing a cutom name and referencing the +-- | Define an exported function by providing a custom name and referencing the -- function you want to export. -- -- Note that the name must start with an upper case letter. @@ -329,8 +333,8 @@ -- Example: @ $(command \"RememberThePrime\" 'someFunction) ['CmdBang'] @ -- -- Note that the list of command options (i.e. the last argument) removes --- duplicate options by means of some internally convienient sorting. You should --- simply not defined the same option twice. +-- duplicate options by means of some internally convenient sorting. You should +-- simply not define the same option twice. command :: String -> Name -> Q Exp command [] _ = error "Empty names are not allowed for exported commands." command customFunctionName@(c:_) functionName @@ -449,7 +453,7 @@ -- _ -> err "Wrong number of arguments" errorCase :: Q Match errorCase = match wildP - (normalB [|err $ "Wrong number of arguments for function: " + (normalB [|throw . ErrorMessage . text $ "Wrong number of arguments for function: " ++ $(litE (StringL (nameBase functionName))) |]) [] -- [x,y] -> case pure add <*> fromObject x <*> fromObject y of ... diff --git a/library/Neovim/Classes.hs b/library/Neovim/Classes.hs --- a/library/Neovim/Classes.hs +++ b/library/Neovim/Classes.hs @@ -17,32 +17,44 @@ module Neovim.Classes ( NvimObject(..) , Dictionary + , (+:) , module Data.Int , module Data.Word ) where - import Control.Applicative import Control.Arrow import Control.Monad.Except -import Data.ByteString (ByteString) -import Data.Int (Int16, Int32, Int64, Int8) -import Data.Map (Map) -import qualified Data.Map as Map +import Data.ByteString (ByteString) +import Data.Int (Int16, Int32, Int64, Int8) +import Data.Map (Map) +import qualified Data.Map as Map import Data.MessagePack import Data.Monoid -import Data.Text as Text (Text) -import Data.Traversable hiding (forM, mapM) -import Data.Word (Word, Word16, Word32, Word64, Word8) +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 qualified Text.PrettyPrint.ANSI.Leijen as P import Prelude -- FIXME saep 2014-11-28 Is assuming UTF-8 reasonable? -import qualified Data.ByteString.UTF8 as U (fromString, toString) -import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import qualified Data.ByteString.UTF8 as U (fromString, toString) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +infixr 5 +: + + +-- | Convenient operator to create a list of 'Object' from normal values. +(+:) :: (NvimObject o) => o -> [Object] -> [Object] +o +: os = toObject o : os + + -- | 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. @@ -56,13 +68,12 @@ fromObjectUnsafe :: Object -> o fromObjectUnsafe o = case fromObject o of - Left e -> error $ unwords - [ "Not the expected object:" - , show o , "(", e, ")" - ] + Left e -> error . show $ + text "Not the expected object:" P.<+> (text . show) o + P.<+> lparen P.<> e P.<> rparen Right obj -> obj - fromObject :: (NvimObject o) => Object -> Either String o + fromObject :: (NvimObject o) => Object -> Either Doc o fromObject = return . fromObjectUnsafe @@ -71,7 +82,7 @@ toObject _ = ObjectNil fromObject ObjectNil = return () - fromObject o = throwError $ "Expected ObjectNil, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectNil, but got " <> show o -- We may receive truthy values from neovim, so we should be more forgiving @@ -95,7 +106,7 @@ fromObject (ObjectDouble o) = return o fromObject (ObjectFloat o) = return $ realToFrac o fromObject (ObjectInt o) = return $ fromIntegral o - fromObject o = throwError $ "Expected ObjectDouble, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectDouble, but got " <> show o instance NvimObject Integer where @@ -104,7 +115,7 @@ fromObject (ObjectInt o) = return $ toInteger o fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected ObjectInt, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectInt, but got " <> show o instance NvimObject Int64 where @@ -113,7 +124,7 @@ fromObject (ObjectInt i) = return i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Int32 where @@ -122,7 +133,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Int16 where @@ -131,7 +142,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Int8 where @@ -140,7 +151,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Word where @@ -149,7 +160,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Word64 where @@ -158,7 +169,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Word32 where @@ -167,7 +178,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Word16 where @@ -176,7 +187,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Word8 where @@ -185,7 +196,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Int where @@ -194,7 +205,7 @@ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o - fromObject o = throwError $ "Expected any Integer value, but got " <> show o + fromObject o = throwError . text $ "Expected any Integer value, but got " <> show o instance NvimObject Char where @@ -202,7 +213,7 @@ fromObject str = case fromObject str of Right [c] -> return c - _ -> throwError $ "Expected one element string but got: " <> show str + _ -> throwError . text $ "Expected one element string but got: " <> show str instance NvimObject [Char] where @@ -210,14 +221,14 @@ fromObject (ObjectBinary o) = return $ U.toString o fromObject (ObjectString o) = return $ U.toString o - fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectBinary, but got " <> show o instance NvimObject o => NvimObject [o] where toObject = ObjectArray . map toObject fromObject (ObjectArray os) = mapM fromObject os - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance NvimObject o => NvimObject (Maybe o) where @@ -241,7 +252,7 @@ return $ Left l Left e2 -> - throwError $ e1 ++ " -- " ++ e2 + throwError $ e1 P.<+> text "--" P.<+> e2 instance (Ord key, NvimObject key, NvimObject val) @@ -255,7 +266,7 @@ . (fromObject *** fromObject)) . Map.toList) om - fromObject o = throwError $ "Expected ObjectMap, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectMap, but got " <> show o instance NvimObject Text where @@ -263,14 +274,14 @@ fromObject (ObjectBinary o) = return $ decodeUtf8 o fromObject (ObjectString o) = return $ decodeUtf8 o - fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectBinary, but got " <> show o instance NvimObject ByteString where toObject = ObjectBinary fromObject (ObjectBinary o) = return o - fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectBinary, but got " <> show o instance NvimObject Object where @@ -280,6 +291,12 @@ 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. instance (NvimObject o1, NvimObject o2) => NvimObject (o1, o2) where toObject (o1, o2) = ObjectArray $ [toObject o1, toObject o2] @@ -287,7 +304,7 @@ fromObject (ObjectArray [o1, o2]) = (,) <$> fromObject o1 <*> fromObject o2 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where toObject (o1, o2, o3) = ObjectArray $ [toObject o1, toObject o2, toObject o3] @@ -296,7 +313,7 @@ <$> fromObject o1 <*> fromObject o2 <*> fromObject o3 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where @@ -307,7 +324,7 @@ <*> fromObject o2 <*> fromObject o3 <*> fromObject o4 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where @@ -319,7 +336,7 @@ <*> fromObject o3 <*> fromObject o4 <*> fromObject o5 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where @@ -332,7 +349,7 @@ <*> fromObject o4 <*> fromObject o5 <*> fromObject o6 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) where @@ -346,7 +363,7 @@ <*> fromObject o5 <*> fromObject o6 <*> fromObject o7 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8) where @@ -361,7 +378,7 @@ <*> fromObject o6 <*> fromObject o7 <*> fromObject o8 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7, NvimObject o8, NvimObject o9) => NvimObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) where @@ -377,7 +394,7 @@ <*> fromObject o7 <*> fromObject o8 <*> fromObject o9 - fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + fromObject o = throwError . text $ "Expected ObjectArray, but got " <> show o -- 1}}} diff --git a/library/Neovim/Config.hs b/library/Neovim/Config.hs --- a/library/Neovim/Config.hs +++ b/library/Neovim/Config.hs @@ -19,7 +19,7 @@ import System.Log (Priority (..)) --- | This data type contins information about the configuration of neovim. See +-- | This data type contains information about the configuration of neovim. See -- the fields' documentation for what you possibly want to change. Also, the -- tutorial in the "Neovim" module should get you started. data NeovimConfig = Config diff --git a/library/Neovim/Context.hs b/library/Neovim/Context.hs --- a/library/Neovim/Context.hs +++ b/library/Neovim/Context.hs @@ -1,5 +1,4 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE LambdaCase #-} {- | Module : Neovim.Context Description : The Neovim context @@ -22,6 +21,7 @@ runNeovim, forkNeovim, err, + errOnInvalidResult, restart, quit, @@ -37,33 +37,42 @@ ) where -import Neovim.Context.Internal (FunctionMap, FunctionMapEntry, Neovim, - Neovim', forkNeovim, mkFunctionMap, - newUniqueFunctionName, runNeovim) -import qualified Neovim.Context.Internal as Internal +import Neovim.Classes +import Neovim.Context.Internal (FunctionMap, FunctionMapEntry, + Neovim, Neovim', + NeovimException (ErrorMessage), + forkNeovim, mkFunctionMap, + newUniqueFunctionName, runNeovim) +import qualified Neovim.Context.Internal as Internal -import Control.Concurrent (putMVar) +import Control.Concurrent (putMVar) import Control.Exception import Control.Monad.Except import Control.Monad.IO.Class import Control.Monad.Reader import Control.Monad.State -import Data.Data (Typeable) +import Data.MessagePack (Object) +import Text.PrettyPrint.ANSI.Leijen (Doc, text) --- | Exceptions specific to /nvim-hs/. -data NeovimException - = ErrorMessage String - -- ^ Simply error message that is passed to neovim. It should currently only - -- contain one line of text. - deriving (Typeable, Show) +-- | @'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 -instance Exception NeovimException +errOnInvalidResult :: (NvimObject o) => Neovim r st (Either Object Object) -> Neovim r st o +errOnInvalidResult a = a >>= \case + Left o -> + (err . text . show) o --- | @throw . ErrorMessage@ -err :: String -> Neovim r st a -err = throw . ErrorMessage + Right o -> case fromObject o of + Left e -> + err e + + Right x -> + return x -- | Initiate a restart of the plugin provider. 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -31,11 +32,14 @@ import Control.Monad.Reader import Control.Monad.State import Control.Monad.Trans.Resource -import Data.ByteString.UTF8 (fromString) +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 ((<$>)) import Prelude @@ -83,18 +87,42 @@ 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 + + -- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'. runNeovim :: Config r st -> st -> Neovim r st a - -> IO (Either String (a, st)) + -> IO (Either Doc (a, st)) runNeovim r st (Neovim a) = (try . runReaderT (runStateT (runResourceT a) st)) r >>= \case - Left e -> do - liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e - return . Left $ show (e :: SomeException) - Right res -> return $ Right res + 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 -> (return . Right) res + -- | Fork a neovim thread with the given custom config value and a custom -- state. The result of the thread is discarded and only the 'ThreadId' is -- returend immediately. @@ -117,7 +145,7 @@ tu <- asks' uniqueCounter -- reverseing the integer string should distribute the first character more -- evently and hence cause faster termination for comparisons. - fmap (F . fromString . reverse . show) . liftIO . atomically $ do + fmap (F . U.fromString . reverse . show) . liftIO . atomically $ do u <- readTVar tu modifyTVar' tu succ return u @@ -134,6 +162,12 @@ -- is the communication endpoint for the arguments we have to pass. +instance Pretty FunctionType where + pretty = \case + Stateless _ -> blue $ text "\\os -> Neovim' o" + Stateful _ -> green $ text "\\os -> Neovim r st o" + + -- | Type of the values stored in the function map. type FunctionMapEntry = (FunctionalityDescription, FunctionType) @@ -193,6 +227,8 @@ -- Local settings; intialized for each stateful component , pluginSettings :: Maybe (PluginSettings r st) + -- ^ In a registered functionality this field contains a function (and + -- possibly some context dependent values) to register new functionality. , customConfig :: r -- ^ Plugin author supplyable custom configuration. Queried on the @@ -254,10 +290,10 @@ | Restart -- ^ Restart the plugin provider. - | Failure String + | Failure Doc -- ^ The plugin provider failed to start or some other error occured. | InitSuccess -- ^ The plugin provider started successfully. - deriving (Show, Read, Eq, Ord) + deriving (Show) diff --git a/library/Neovim/Debug.hs b/library/Neovim/Debug.hs --- a/library/Neovim/Debug.hs +++ b/library/Neovim/Debug.hs @@ -17,22 +17,29 @@ quitDevelMain, restartDevelMain, + printGlobalFunctionMap, + runNeovim, runNeovim', module Neovim, ) where import Neovim -import Neovim.Context (runNeovim) -import qualified Neovim.Context.Internal as Internal -import Neovim.Log (disableLogger) -import Neovim.Main (CommandLineOptions (..), - runPluginProvider) -import Neovim.RPC.Common (RPCConfig) +import Neovim.Context (runNeovim) +import qualified Neovim.Context.Internal as Internal +import Neovim.Log (disableLogger) +import Neovim.Main (CommandLineOptions (..), + runPluginProvider) +import Neovim.RPC.Common (RPCConfig) import Control.Concurrent +import Control.Concurrent.STM import Control.Monad +import qualified Data.Map as Map import Foreign.Store +import System.IO (stdout) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +import qualified Text.PrettyPrint.ANSI.Leijen as Pretty import Prelude @@ -46,7 +53,7 @@ -- -- Tip: If you run a terminal inside a neovim instance, then this variable is -- automatically set. -debug :: r -> st -> Internal.Neovim r st a -> IO (Either String (a, st)) +debug :: r -> st -> Internal.Neovim r st a -> IO (Either Doc (a, st)) debug r st a = disableLogger $ do runPluginProvider def { env = True } Nothing transitionHandler Nothing where @@ -64,7 +71,7 @@ return res _ -> - return $ Left "Unexpected transition state." + return . Left $ text "Unexpected transition state." -- | Run a 'Neovim'' function. @@ -74,7 +81,7 @@ -- @ -- -- See documentation for 'debug'. -debug' :: Internal.Neovim' a -> IO (Either String a) +debug' :: Internal.Neovim' a -> IO (Either Doc a) debug' a = fmap fst <$> debug () () a @@ -102,7 +109,7 @@ -- develMain :: Maybe NeovimConfig - -> IO (Either String ([ThreadId], Internal.Config RPCConfig ())) + -> IO (Either Doc ([ThreadId], Internal.Config RPCConfig ())) develMain mcfg = lookupStore 0 >>= \case Nothing -> do x <- disableLogger $ @@ -132,10 +139,10 @@ deleteStore x mapM_ killThread tids - return $ Left "Quit develMain" + return . Left $ text "Quit develMain" _ -> - return $ Left "Unexpected transition state for develMain." + return . Left $ text "Unexpected transition state for develMain." -- | Quit a previously started plugin provider. @@ -147,15 +154,30 @@ restartDevelMain :: Internal.Config RPCConfig () -> Maybe NeovimConfig - -> IO (Either String ([ThreadId], Internal.Config RPCConfig ())) + -> IO (Either Doc ([ThreadId], Internal.Config RPCConfig ())) restartDevelMain cfg mcfg = do quitDevelMain cfg develMain mcfg -- | Convenience function to run a stateless 'Neovim' function. -runNeovim' :: Internal.Config r st -> Neovim' a -> IO (Either String a) +runNeovim' :: Internal.Config r st -> Neovim' a -> IO (Either Doc a) runNeovim' cfg = fmap (fmap fst) . runNeovim (Internal.retypeConfig () () cfg) () + + +-- | Print the global function map to the console. +printGlobalFunctionMap :: Internal.Config r st -> IO () +printGlobalFunctionMap cfg = do + es <- fmap Map.toList . atomically $ readTMVar (Internal.globalFunctionMap cfg) + let header = text "Printing global function map:" + funs = map (\(fname, (d, f)) -> + nest 3 (pretty fname + text "->" + pretty d <+> text ":" + <+> pretty f)) es + displayIO stdout . renderPretty 0.4 80 $ + nest 2 (header <$$> vcat funs) + <$$> Pretty.empty diff --git a/library/Neovim/Main.hs b/library/Neovim/Main.hs --- a/library/Neovim/Main.hs +++ b/library/Neovim/Main.hs @@ -13,28 +13,29 @@ where import Neovim.Config -import qualified Neovim.Context.Internal as Internal +import qualified Neovim.Context.Internal as Internal import Neovim.Log -import Neovim.Plugin as P -import Neovim.Plugin.Startup (StartupConfig(..)) -import Neovim.RPC.Common as RPC +import Neovim.Plugin as P +import Neovim.Plugin.Startup (StartupConfig (..)) +import Neovim.RPC.Common as RPC import Neovim.RPC.EventHandler import Neovim.RPC.SocketReader +import Neovim.Util (oneLineErrorMessage) -import qualified Config.Dyre as Dyre -import qualified Config.Dyre.Relaunch as Dyre +import qualified Config.Dyre as Dyre +import qualified Config.Dyre.Relaunch as Dyre import Control.Concurrent -import Control.Concurrent.STM (putTMVar, atomically) +import Control.Concurrent.STM (atomically, putTMVar) import Control.Monad import Data.Default import Data.Maybe import Data.Monoid import Options.Applicative -import System.IO (stdin, stdout) +import System.IO (stdin, stdout) import System.SetEnv -import System.Environment import Prelude +import System.Environment logger :: String @@ -194,7 +195,7 @@ conf startPluginThreads startupConf allPlugins >>= \case Left e -> do - errorM logger $ "Error initializing plugins: " <> e + errorM logger $ "Error initializing plugins: " <> oneLineErrorMessage e putMVar (Internal.transitionTo conf) $ Internal.Failure e transitionHandler [ehTid, srTid] conf @@ -220,7 +221,7 @@ Dyre.relaunchMaster Nothing Internal.Failure e -> - errorM logger e + errorM logger $ oneLineErrorMessage e Internal.Quit -> return () diff --git a/library/Neovim/Plugin.hs b/library/Neovim/Plugin.hs --- a/library/Neovim/Plugin.hs +++ b/library/Neovim/Plugin.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {- | @@ -57,6 +58,7 @@ import Data.MessagePack import Data.Traversable (forM) import System.Log.Logger +import Text.PrettyPrint.ANSI.Leijen (Doc) import Prelude @@ -70,7 +72,7 @@ startPluginThreads :: Internal.Config StartupConfig () -> [Neovim StartupConfig () NeovimPlugin] - -> IO (Either String ([FunctionMapEntry],[ThreadId])) + -> IO (Either Doc ([FunctionMapEntry],[ThreadId])) startPluginThreads cfg = fmap (fmap fst) . runNeovim cfg () . foldM go ([], []) @@ -105,10 +107,9 @@ (\n -> ("remote#define#FunctionOnHost", toObject n)) (\c -> ("remote#define#FunctionOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction - [ host, toObject functionName, toObject s - , toObject functionName, toObject (Map.empty :: Dictionary) - ] + ret <- vim_call_function defineFunction $ + host +: functionName +: s +: functionName +: (Map.empty :: Dictionary) +: [] + case ret of Left e -> do liftIO . errorM logger $ @@ -131,10 +132,9 @@ (\n -> ("remote#define#CommandOnHost", toObject n)) (\c -> ("remote#define#CommandOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction - [ host, toObject functionName, toObject sync - , toObject functionName, toObject copts - ] + ret <- vim_call_function defineFunction $ + host +: functionName +: sync +: functionName +: copts +: [] + case ret of Left e -> do liftIO . errorM logger $ @@ -151,10 +151,8 @@ (\n -> ("remote#define#AutocmdOnHost", toObject n)) (\c -> ("remote#define#AutocmdOnChannel", toObject c)) pName - ret <- vim_call_function defineFunction - [ host, toObject functionName, toObject Async - , toObject acmdType , toObject opts - ] + ret <- vim_call_function defineFunction $ + host +: functionName +: Async +: acmdType +: opts +: [] case ret of Left e -> do liftIO . errorM logger $ 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 @@ -28,19 +28,21 @@ import Neovim.Classes -import Control.Applicative +import Control.Applicative hiding (empty) import Control.Monad.Error.Class -import Data.ByteString (ByteString) -import Data.Char (isDigit) +import Data.ByteString (ByteString) +import Data.ByteString.UTF8 (toString) +import Data.Char (isDigit) import Data.Default -import Data.List (groupBy, sort) -import qualified Data.Map as Map +import Data.List (groupBy, sort) +import qualified Data.Map as Map import Data.Maybe import Data.MessagePack import Data.String -import Data.Traversable (sequence) +import Data.Traversable (sequence) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) -import Prelude hiding (sequence) +import Prelude hiding (sequence) -- | Essentially just a string. @@ -48,6 +50,10 @@ deriving (Eq, Ord, Show, Read) +instance Pretty FunctionName where + pretty (F n) = blue . text $ toString n + + -- | Functionality specific functional description entries. -- -- All fields which are directly specified in these constructors are not @@ -81,6 +87,20 @@ deriving (Show, Read, Eq, Ord) +instance Pretty FunctionalityDescription where + pretty = \case + Function fname s -> + text "Function" <+> pretty s <+> pretty fname + + Command fname copts -> + text "Command" <+> pretty copts <+> pretty fname + + Autocmd t fname aopts -> + text "Autocmd" <+> (text . toString) t + <+> pretty aopts + <+> pretty fname + + -- | This option detemines how neovim should behave when calling some -- functionality on a remote host. data Synchronous @@ -98,6 +118,12 @@ deriving (Show, Read, Eq, Ord, Enum) +instance Pretty Synchronous where + pretty = \case + Async -> red $ text "async" + Sync -> blue $ text "sync" + + instance IsString Synchronous where fromString = \case "sync" -> Sync @@ -158,6 +184,27 @@ deriving (Eq, Ord, Show, Read) +instance Pretty CommandOption where + pretty = \case + CmdSync s -> + pretty s + + CmdRegister -> + text "\"" + + CmdNargs n -> + text n + + CmdRange rs -> + pretty rs + + CmdCount c -> + text (show c) + + CmdBang -> + text "!" + + instance IsString CommandOption where fromString = \case "%" -> CmdRange WholeFile @@ -177,6 +224,10 @@ deriving (Eq, Ord, Show, Read) +instance Pretty CommandOptions where + pretty (CommandOptions os) = + cat $ map pretty os + -- | Smart constructor for 'CommandOptions'. This sorts the command options and -- removes duplicate entries for semantically the same thing. Note that the -- smallest option stays for whatever ordering is defined. It is best to simply @@ -211,7 +262,7 @@ CmdNargs n -> Just ("nargs" , toObject n) _ -> Nothing - fromObject o = throwError $ + fromObject o = throwError . text $ "Did not expect to receive a CommandOptions object: " ++ show o @@ -229,6 +280,18 @@ deriving (Eq, Ord, Show, Read) +instance Pretty RangeSpecification where + pretty = \case + CurrentLine -> + empty + + WholeFile -> + text "%" + + RangeCount c -> + text $ show c + + instance NvimObject RangeSpecification where toObject = \case CurrentLine -> ObjectBinary "" @@ -263,6 +326,17 @@ deriving (Eq, Ord, Show, Read) +instance Pretty CommandArguments where + pretty CommandArguments{..} = + cat $ catMaybes + [ (\b -> if b then (text "!") else empty) <$> bang + , (\(s,e) -> lparen <> (text . show) s <> comma + <+> (text . show) e <> rparen) + <$> range + , (text . show) <$> count + , (text . show) <$> register + ] + instance Default CommandArguments where def = CommandArguments { bang = Nothing @@ -293,7 +367,7 @@ fromObject ObjectNil = return def fromObject o = - throwError $ "Expected a map for CommandArguments object, but got: " ++ show o + throwError . text $ "Expected a map for CommandArguments object, but got: " ++ show o -- | Options that can be used to register an autocmd. See @:h :autocmd@ or any @@ -313,6 +387,13 @@ deriving (Show, Read, Eq, Ord) +instance Pretty AutocmdOptions where + pretty AutocmdOptions{..} = + text acmdPattern + <+> text (if acmdNested then "nested" else "unnested") + <> maybe empty (\g -> empty <+> text g) acmdGroup + + instance Default AutocmdOptions where def = AutocmdOptions { acmdPattern = "*" @@ -329,7 +410,7 @@ ] ++ catMaybes [ acmdGroup >>= \g -> return ("group", toObject g) ] - fromObject o = throwError $ + fromObject o = throwError . text $ "Did not expect to receive an AutocmdOptions object: " ++ show o -- | Conveniennce class to extract a name from some value. 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 @@ -23,12 +23,14 @@ import Config.Dyre (Params) import Config.Dyre.Compile +import Config.Dyre.Paths (getPaths) import Control.Applicative hiding (many, (<|>)) import Control.Monad (void, forM_) import Data.Char import Text.Parsec hiding (Error, count) import Text.Parsec.String import System.SetEnv +import System.Directory (removeDirectoryRecursive) import Prelude @@ -51,14 +53,24 @@ -- | Note that restarting the plugin provider implies compilation because Dyre -- does this automatically. However, if the recompilation fails, the previously --- compiled bynary is executed. This essentially means that restarting may take +-- compiled binary is executed. This essentially means that restarting may take -- more time then you might expect. +-- +-- If you provide a bang to the command, the cache directory of /nvim-hs/ is +-- forcibly removed. restartNvimhs :: CommandArguments -> Neovim (Params NeovimConfig, [(String, Maybe String)]) [QuickfixListItem String] () restartNvimhs CommandArguments{..} = do case bang of - Just True -> recompileNvimhs - _ -> return () + Just True -> do + (_,_,_, cacheDir,_) <- liftIO . getPaths =<< asks fst + liftIO $ removeDirectoryRecursive cacheDir + + _ -> + return () + + recompileNvimhs + (_, env) <- ask forM_ env $ \(var, val) -> liftIO $ do maybe (unsetEnv var) (setEnv var) val 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,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.Plugin.IPC.Classes Description : Classes used for Inter Plugin Communication @@ -22,13 +23,15 @@ module Data.Time, ) where -import Neovim.Plugin.Classes (FunctionName) +import Neovim.Plugin.Classes (FunctionName) import Control.Concurrent.STM -import Data.Data (Typeable, cast) -import Data.Int (Int64) +import Data.Data (Typeable, cast) +import Data.Int (Int64) import Data.MessagePack import Data.Time +import Data.Time.Locale.Compat +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Prelude @@ -63,6 +66,14 @@ instance Message FunctionCall +instance Pretty FunctionCall where + pretty (FunctionCall fname args _ t) = + nest 2 $ text "Function call for:" <+> pretty fname + <$$> text "Arguments:" <+> text (show args) + <$$> text "Timestamp:" + <+> (yellow . text . formatTime defaultTimeLocale "%H:%M:%S (%q)") t + + -- | A request is a data type containing the method to call, its arguments and -- an identifier used to map the result to the function that has been called. data Request = Request @@ -78,6 +89,13 @@ instance Message Request +instance Pretty Request where + pretty Request{..} = + nest 2 $ text "Request" <+> (yellow . text . ('#':) . show) reqId + <$$> (text "Method:" <+> pretty reqMethod) + <$$> (text "Arguments:" <+> text (show reqArgs)) + + -- | A notification is similar to a 'Request'. It essentially does the same -- thing, but the function is only called for its side effects. This type of -- message is sent by neovim if the caller there does not care about the result @@ -91,4 +109,11 @@ instance Message Notification + + +instance Pretty Notification where + pretty Notification{..} = + nest 2 $ text "Notification" + <$$> (text "Method:" <+> pretty notMethod) + <$$> (text "Arguments:" <+> text (show notArgs)) diff --git a/library/Neovim/Quickfix.hs b/library/Neovim/Quickfix.hs --- a/library/Neovim/Quickfix.hs +++ b/library/Neovim/Quickfix.hs @@ -16,15 +16,17 @@ where import Control.Applicative -import Control.Monad (void) -import Data.ByteString as BS (ByteString, all, elem) -import qualified Data.Map as Map +import Control.Monad (void) +import Data.ByteString as BS (ByteString, all, elem) +import qualified Data.Map as Map import Data.Maybe import Data.MessagePack import Data.Monoid import Neovim.API.String import Neovim.Classes import Neovim.Context +import Text.PrettyPrint.ANSI.Leijen (Doc) +import qualified Text.PrettyPrint.ANSI.Leijen as P import Prelude @@ -36,7 +38,7 @@ -> QuickfixAction -> Neovim r st () setqflist qs a = - void $ vim_call_function "setqflist" [toObject qs, toObject a] + void $ vim_call_function "setqflist" $ qs +: a +: [] -- | Quickfix list item. The parameter names should mostly conform to those in -- @:h setqflist()@. Some fields are merged to explicitly state mutually @@ -77,7 +79,7 @@ Warning -> ObjectBinary "W" Error -> ObjectBinary "E" - fromObject o = case fromObject o :: Either String String of + fromObject o = case fromObject o :: Either Doc String of Right "W" -> return Warning Right "E" -> return Error _ -> return Error @@ -119,19 +121,19 @@ fromObject objectMap@(ObjectMap _) = do m <- fromObject objectMap - let l :: NvimObject o => ByteString -> Either String o + let l :: NvimObject o => ByteString -> Either Doc o l key = case Map.lookup key m of Just o -> fromObject o - Nothing -> Left "Key not found." + Nothing -> throwError . P.text $ "Key not found." bufOrFile <- case (l "bufnr", l "filename") of (Right b, _) -> return $ Left b (_, Right f) -> return $ Right f - _ -> throwError "No buffer number or file name inside quickfix list item." + _ -> throwError . P.text $ "No buffer number or file name inside quickfix list item." lnumOrPattern <- case (l "lnum", l "pattern") of (Right lnum, _) -> return $ Left lnum (_, Right pat) -> return $ Right pat - _ -> throwError "No line number or search pattern inside quickfix list item." - let l' :: NvimObject o => ByteString -> Either String (Maybe o) + _ -> throwError . P.text $ "No line number or search pattern inside quickfix list item." + let l' :: NvimObject o => ByteString -> Either Doc (Maybe o) l' key = case Map.lookup key m of Just o -> Just <$> fromObject o Nothing -> return Nothing @@ -150,7 +152,7 @@ errorType <- fromMaybe Error <$> l' "type" return QFItem{..} - fromObject o = throwError $ "Could not deserialize QuickfixListItem, expected a map but received: " ++ show o + fromObject o = throwError . P.text $ "Could not deserialize QuickfixListItem, expected a map but received: " ++ show o data QuickfixAction 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,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.Classes Description : Data types and classes for the RPC components @@ -16,15 +17,16 @@ ( Message (..), ) where -import Neovim.Classes (NvimObject (..)) -import Neovim.Plugin.Classes (FunctionName (..)) -import qualified Neovim.Plugin.IPC.Classes as IPC +import Neovim.Classes (NvimObject (..), (+:)) +import Neovim.Plugin.Classes (FunctionName (..)) +import qualified Neovim.Plugin.IPC.Classes as IPC import Control.Applicative import Control.Monad.Error.Class -import Data.Data (Typeable) -import Data.Int (Int64) -import Data.MessagePack (Object (..)) +import Data.Data (Typeable) +import Data.Int (Int64) +import Data.MessagePack (Object (..)) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) import Prelude @@ -53,19 +55,20 @@ instance IPC.Message Message + instance NvimObject Message where toObject = \case Request (IPC.Request (F m) i ps) -> - ObjectArray [ ObjectInt 0, ObjectInt i, ObjectBinary m, ObjectArray ps ] + ObjectArray $ (0 :: Int64) +: i +: m +: ps +: [] Response i (Left e) -> - ObjectArray [ ObjectInt 1, ObjectInt i, e, ObjectNil] + ObjectArray $ (1 :: Int64) +: i +: e +: () +: [] Response i (Right r) -> - ObjectArray [ ObjectInt 1, ObjectInt i, ObjectNil, r] + ObjectArray $ (1 :: Int64) +: i +: () +: r +: [] Notification (IPC.Notification (F m) ps) -> - ObjectArray [ ObjectInt 2, ObjectBinary m, ObjectArray ps ] + ObjectArray $ (2 :: Int64) +: m +: ps +: [] fromObject = \case @@ -90,7 +93,19 @@ return $ Notification n o -> - throwError $ "Not a known/valid msgpack-rpc message" ++ show o + throwError . text $ "Not a known/valid msgpack-rpc message" ++ show o + +instance Pretty Message where + pretty = \case + Request request -> + pretty request + + Response i ret -> + nest 2 $ text "Response" <+> (yellow . text . ('#':) . show) i + <$$> either (red . text . show) (green . text. show) ret + + Notification notification -> + pretty notification 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 @@ -25,16 +25,17 @@ import Neovim.Classes import Neovim.Context -import qualified Neovim.Context.Internal as Internal -import Neovim.Plugin.Classes (FunctionName) +import qualified Neovim.Context.Internal as Internal +import Neovim.Plugin.Classes (FunctionName) import Neovim.Plugin.IPC.Classes -import qualified Neovim.RPC.Classes as MsgpackRPC +import qualified Neovim.RPC.Classes as MsgpackRPC import Control.Applicative import Control.Concurrent.STM import Control.Monad.Reader import Data.MessagePack import Data.Monoid +import qualified Text.PrettyPrint.ANSI.Leijen as P import Prelude @@ -123,15 +124,15 @@ -- | Wait for the result of the 'STM' action and call @'err' . (loc++) . show@ -- if the action returned an error. -waitErr :: (Show e) +waitErr :: (P.Pretty e) => String -- ^ Prefix error message with this. -> Neovim r st (STM (Either e result)) -- ^ Function call to neovim -> Neovim r st result -waitErr loc act = wait act >>= either (err . (loc++) . show) return +waitErr loc act = wait act >>= either (err . (P.<>) (P.text loc) . P.pretty) return -- | 'waitErr' that discards the result. -waitErr' :: (Show e) +waitErr' :: (P.Pretty e) => String -> Neovim r st (STM (Either e result)) -> Neovim r st () diff --git a/library/Neovim/Util.hs b/library/Neovim/Util.hs --- a/library/Neovim/Util.hs +++ b/library/Neovim/Util.hs @@ -14,6 +14,7 @@ withCustomEnvironment, whenM, unlessM, + oneLineErrorMessage, ) where import Control.Monad (forM, forM_, when, unless) @@ -21,6 +22,7 @@ import Neovim.Context import System.SetEnv import System.Environment +import qualified Text.PrettyPrint.ANSI.Leijen as P -- | Execute the given action with a changed set of environment variables and @@ -50,3 +52,9 @@ -- | 'unless' with a monadic predicate. unlessM :: (Monad m) => m Bool -> m () -> m () unlessM mp a = mp >>= \p -> unless p a + + +oneLineErrorMessage :: P.Doc -> String +oneLineErrorMessage d = case lines $ P.displayS (P.renderCompact d) "" of + (x:_) -> x + [] -> "" 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.0.5 +version: 0.0.6 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write @@ -26,10 +26,12 @@ license-file: LICENSE author: Sebastian Witte maintainer: woozletoff@gmail.com -copyright: Copyright (C) Sebastian Witte +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 extra-source-files: TestPlugins.vim , TestPlugins.hs , TestPlugins.sh @@ -40,7 +42,10 @@ , test-files/compile-error-for-quickfix-test4 , test-files/compile-error-for-quickfix-test5 , test-files/hello - , CHANGELOG.md + +extra-doc-files: CHANGELOG.md + , README.md + source-repository head type: git location: https://github.com/neovimhaskell/nvim-hs @@ -88,6 +93,7 @@ , Neovim.API.TH -- other-extensions: build-depends: base >=4.6 && < 5 + , ansi-wl-pprint , bytestring , cereal , cereal-conduit @@ -107,6 +113,7 @@ , lifted-base , mtl >= 2.2.1 && < 2.3 , optparse-applicative + , time-locale-compat , parsec >= 3.1.9 , process , resourcet @@ -136,6 +143,7 @@ , hspec-discover , QuickCheck >=2.6 + , ansi-wl-pprint , bytestring , cereal , cereal-conduit @@ -152,6 +160,7 @@ , lifted-base , mtl >= 2.2.1 && < 2.3 , messagepack >= 0.4 + , time-locale-compat , network , optparse-applicative , parsec >= 3.1.9