nvim-hs-1.0.0.1: Haskell plugin backend for neovim

Copyright(c) Sebastian Witte
LicenseApache-2.0
Maintainerwoozletoff@gmail.com
Stabilityexperimental
PortabilityGHC (due to Template Haskell)
Safe HaskellNone
LanguageHaskell2010

Neovim

Contents

Description

This module should contain all the things you need to write neovim plugins in your favorite language! :-)

The documentation in this module should provide every information you need to start writing plugins.

Synopsis

Installation

Installation instructions are in the README.md file that comes with the source of this package. It is also on the repositories front page.

Tutorial

tl;dr

If you are proficient with Haskell, it may be sufficient to point you at some of the important data structures and functions. So, I will do it here. If you need more assistance, please skip to the next section and follow the links for functions or data types you do not understand how to use. If you think that the documentation is lacking, please create an issue on github (or even better, a pull request with a fix ;-)). 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 XDG-basedir specification. 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:

import Neovim

main = neovim defaultConfig

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.

data Neovim env a Source #

This is the environment in which all plugins are initially started.

Functions have to run in this transformer stack to communicate with neovim. If parts of your own functions dont need to communicate with neovim, it is good practice to factor them out. This allows you to write tests and spot errors easier. Essentially, you should treat this similar to IO in general haskell programs.

Instances

MonadReader env (Neovim env) Source #

User facing instance declaration for the reader state.

Methods

ask :: Neovim env env #

local :: (env -> env) -> Neovim env a -> Neovim env a #

reader :: (env -> a) -> Neovim env a #

Monad (Neovim env) Source # 

Methods

(>>=) :: Neovim env a -> (a -> Neovim env b) -> Neovim env b #

(>>) :: Neovim env a -> Neovim env b -> Neovim env b #

return :: a -> Neovim env a #

fail :: String -> Neovim env a #

Functor (Neovim env) Source # 

Methods

fmap :: (a -> b) -> Neovim env a -> Neovim env b #

(<$) :: a -> Neovim env b -> Neovim env a #

Applicative (Neovim env) Source # 

Methods

pure :: a -> Neovim env a #

(<*>) :: Neovim env (a -> b) -> Neovim env a -> Neovim env b #

liftA2 :: (a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c #

(*>) :: Neovim env a -> Neovim env b -> Neovim env b #

(<*) :: Neovim env a -> Neovim env b -> Neovim env a #

MonadIO (Neovim env) Source # 

Methods

liftIO :: IO a -> Neovim env a #

MonadUnliftIO (Neovim env) Source # 

Methods

askUnliftIO :: Neovim env (UnliftIO (Neovim env)) #

withRunInIO :: ((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b #

MonadResource (Neovim env) Source # 

Methods

liftResourceT :: ResourceT IO a -> Neovim env a #

MonadThrow (Neovim env) Source # 

Methods

throwM :: Exception e => e -> Neovim env a #

neovim :: NeovimConfig -> IO () Source #

This is essentially the main function for nvim-hs, at least if you want to use Config.Dyre for the configuration.

data NeovimConfig Source #

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.

Constructors

Config 

Fields

defaultConfig :: NeovimConfig Source #

Default configuration options for nvim-hs. If you want to keep the default plugins enabled, you can define your config like this:

main = neovim defaultConfig
         { plugins = myPlugins ++ plugins defaultConfig
         }

data StartupConfig cfg Source #

This data type contains internal fields of nvim-hs that may be useful for plugin authors. It is available via ask inside the plugin startup code.

Constructors

StartupConfig 

Fields

def :: Default a => a #

The default value for this type.

Using existing plugins

nvim-hs is all about importing and creating plugins. This is done following a concise API. Let's start by making a given plugin available inside our plugin provider. Assuming that we have installed a cabal package that exports an examplePlugin from the module TestPlugin.ExamplePlugin. A minimal configuration would then look like this:

import TestPlugin.ExamplePlugin (examplePlugin)

main = neovim def
        { plugins = [ examplePlugin ] ++ plugins defaultConfig
        }

That's all you have to do! Multiple plugins are simply imported and put in a list.

If the plugin is not packaged, you can also put the source files of the plugin inside $XDG_CONFIG_HOME/nvim/lib (usually ~/.config/nvim/lib). Assuming the same module name and plugin name, you can use the same configuration file. The source for the plugin must be located at $XDG_CONFIG_HOME/nvim/lib/TestPlugin/ExamplePlugin.hs and all source files it depends on must follow the same structure. This is the standard way how Haskell modules are defined in cabal projects. Having all plugins as source files can increase the compilation times, so plugins should be put in a cabal project once they are mature enough. This also makes them easy to share!

Creating a plugin

Creating plugins isn't difficult either. You just have to follow and survive the compile time errors of seemingly valid code. This may sound scary, but it is not so bad. We will cover most pitfalls in the following paragraphs and if there isn't a solution for your error, you can always ask any friendly Haskeller in #haskell on irc.freenode.net!

Enough scary stuff said for now, let's write a plugin! Due to a stage restriction in GHC when using Template Haskell, we must define our functions in a different module than $XDG_CONFIG_HOME/nvim/nvim.hs. This is a bit unfortunate, but it will save you a lot of boring boilerplate and 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 nth Fibonacci number. Don't we all love those!

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.
fibonacci :: Int -> Neovim env String
fibonacci n = return . show $ fibs !! n
  where
    fibs :: [Integer]
    fibs = 0:1:scanl1 (+) fibs

File ~/.config/nvim/lib/Fibonacci.hs:

{-# LANGUAGE TemplateHaskell #-}
module Fibonacci (plugin) where

import Neovim
import Fibonacci.Plugin (fibonacci)

plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin
plugin = wrapPlugin Plugin
    { environment = ()
    , exports     = [ $(function' 'fibonacci) Sync ]
    }

File ~/.config/nvim/nvim.hs:

import Neovim

import qualified Fibonacci as Fibonacci

main :: IO ()
main = neovim defaultConfig
    { plugins = plugins defaultConfig ++ [ Fibonacci.plugin ]
    }

Let's analyze how it works. The module Fibonacci.Plugin simply defines a function that takes the nth element of the infinite list of Fibonacci numbers. Even though the definition is very concise and asthetically pleasing, the important part is the type signature for fibonacci. Similarly how main :: IO () works in normal Haskell programs, Neovim is the environment we need for plugins. Internally, it stores a few things that are needed to communicate with neovim, but that shouldn't bother you too much. Simply remember that every plugin function must have a function signature whose last element is of type Neovim env something. The result of fibonacci is String because neovim cannot handle big numbers so well. :-) 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/Fibonacci.hs, shows what a plugin is. It is essentially an environment that and a list of functions, commands or autocommands in the context of vim terminology. In the end, all of those things map to a function at the side 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 environment. The environment is a data type that is avaiable to all exported functions of your plugin. This example does not make use of anything of that environment, so we used '()', also known as unit, as our environment. The definition of fibonacci uses a type variable env as it does not access the environment and can handly any environment. If you want to access the environment, you can call ask or asks if you are inside a Neovim environment. An example that shows you how to use it can be found in a later chapter.

Now to the magical part: $(function' 'fibonacci). This is a so called Template Haskell splice and this is why you need {-# LANGUAGE TemplateHaskell #-} at the top of your Haskell file. This splice simply generates Haskell code that, in this case, still needs a value of type Synchronous which indicates whether calling the function will make neovim wait for its result or not. Internally, the expression $(function' 'fibonacci) Sync creates a value that contains all the necessary information to properly register the function with neovim. Note the prime symbol before the function name! This would have probably caused you some trouble if I haven't mentioned it here! Template Haskell simply requires you to put that in front of function names that are passed in a splice.

If you compile this (which should happen automatically if you have put those files at the appropriate places), you can restart nvim-hs with the command :RestartNvimhs which is available as long as you do not remove the default plugins from you rconfig. Afterwards, you can calculate the 2000th Fibonacci number like as if it were a normal vim-script function:

:echo Fibonacci(2000)

You can also directly insert the result inside any text file opened with neovim by using the evaluation register by pressing the following key sequence in insert mode:

<C-r>=Fibonacci(2000)

data NeovimPlugin Source #

Plugin values are wraped inside this data type via wrapPlugin so that we can put plugins in an ordinary list.

Constructors

NeovimPlugin (Plugin env) 

data Plugin env Source #

This data type contains meta information for the plugin manager.

Constructors

Plugin 

Fields

class NFData o => NvimObject o where Source #

Conversion from Object files to Haskell types and back with respect to neovim's interpretation.

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.

Minimal complete definition

toObject

Instances

NvimObject Bool Source # 
NvimObject Double Source # 
NvimObject Int Source # 
NvimObject Int8 Source # 
NvimObject Int16 Source # 
NvimObject Int32 Source # 
NvimObject Int64 Source # 
NvimObject Integer Source # 
NvimObject Word Source # 
NvimObject Word8 Source # 
NvimObject Word16 Source # 
NvimObject Word32 Source # 
NvimObject Word64 Source # 
NvimObject () Source # 
NvimObject ByteString Source # 
NvimObject Text Source # 
NvimObject Object Source # 
NvimObject AutocmdOptions Source # 
NvimObject CommandArguments Source # 
NvimObject RangeSpecification Source # 
NvimObject CommandOptions Source # 
NvimObject Synchronous Source # 
NvimObject Message Source # 
NvimObject Window Source # 
NvimObject Tabpage Source # 
NvimObject Buffer Source # 
NvimObject NeovimExceptionGen Source # 
NvimObject QuickfixAction Source # 
NvimObject QuickfixErrorType Source # 
NvimObject [Char] Source # 
NvimObject o => NvimObject [o] Source # 
NvimObject o => NvimObject (Maybe o) Source # 
(Monoid strType, NvimObject strType) => NvimObject (QuickfixListItem strType) Source # 
(NvimObject l, NvimObject r) => NvimObject (Either l r) Source #

Right-biased instance for toObject.

(NvimObject o1, NvimObject o2) => NvimObject (o1, o2) Source # 

Methods

toObject :: (o1, o2) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2) Source #

(Ord key, NvimObject key, NvimObject val) => NvimObject (Map key val) Source # 

Methods

toObject :: Map key val -> Object Source #

fromObjectUnsafe :: Object -> Map key val Source #

fromObject :: Object -> Either (Doc AnsiStyle) (Map key val) Source #

fromObject' :: MonadIO io => Object -> io (Map key val) Source #

(NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) Source # 

Methods

toObject :: (o1, o2, o3) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3) Source #

(NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) Source # 

Methods

toObject :: (o1, o2, o3, o4) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4) Source #

(NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) Source # 

Methods

toObject :: (o1, o2, o3, o4, o5) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4, o5) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4, o5) Source #

(NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) Source # 

Methods

toObject :: (o1, o2, o3, o4, o5, o6) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4, o5, o6) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4, o5, o6) Source #

(NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6, NvimObject o7) => NvimObject (o1, o2, o3, o4, o5, o6, o7) Source # 

Methods

toObject :: (o1, o2, o3, o4, o5, o6, o7) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4, o5, o6, o7) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4, o5, o6, o7) Source #

(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) Source # 

Methods

toObject :: (o1, o2, o3, o4, o5, o6, o7, o8) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4, o5, o6, o7, o8) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4, o5, o6, o7, o8) Source #

(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) Source # 

Methods

toObject :: (o1, o2, o3, o4, o5, o6, o7, o8, o9) -> Object Source #

fromObjectUnsafe :: Object -> (o1, o2, o3, o4, o5, o6, o7, o8, o9) Source #

fromObject :: Object -> Either (Doc AnsiStyle) (o1, o2, o3, o4, o5, o6, o7, o8, o9) Source #

fromObject' :: MonadIO io => Object -> io (o1, o2, o3, o4, o5, o6, o7, o8, o9) Source #

(+:) :: NvimObject o => o -> [Object] -> [Object] infixr 5 Source #

Convenient operator to create a list of Object from normal values. values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []

type Dictionary = Map ByteString Object Source #

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.

data Object :: * #

Constructors

ObjectNil 
ObjectUInt Word64

Unsigned integers from the MsgPack protocol: uint 8, uint 16, uint 32, uint 64

ObjectInt Int64

Signed integers and fixnums from the MsgPack protocol: positive fixnum, negative fixnum, int 8, int 16, int 32, int 64

ObjectBool Bool 
ObjectFloat Float 
ObjectDouble Double 
ObjectString ByteString 
ObjectBinary ByteString 
ObjectArray [Object] 
ObjectMap (Map Object Object) 
ObjectExt !Int8 ByteString 

Instances

Eq Object 

Methods

(==) :: Object -> Object -> Bool #

(/=) :: Object -> Object -> Bool #

Ord Object 
Show Object 
Generic Object 

Associated Types

type Rep Object :: * -> * #

Methods

from :: Object -> Rep Object x #

to :: Rep Object x -> Object #

Serialize Object 
NFData Object 

Methods

rnf :: Object -> () #

NvimObject Object Source # 
type Rep Object 
type Rep Object = D1 * (MetaData "Object" "Data.MessagePack" "messagepack-0.5.4-9LojDOfnuPsAs3GPBHUeLj" False) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "ObjectNil" PrefixI False) (U1 *)) (C1 * (MetaCons "ObjectUInt" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Word64)))) ((:+:) * (C1 * (MetaCons "ObjectInt" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int64))) ((:+:) * (C1 * (MetaCons "ObjectBool" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Bool))) (C1 * (MetaCons "ObjectFloat" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Float)))))) ((:+:) * ((:+:) * (C1 * (MetaCons "ObjectDouble" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Double))) ((:+:) * (C1 * (MetaCons "ObjectString" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * ByteString))) (C1 * (MetaCons "ObjectBinary" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * ByteString))))) ((:+:) * (C1 * (MetaCons "ObjectArray" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * [Object]))) ((:+:) * (C1 * (MetaCons "ObjectMap" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Map Object Object)))) (C1 * (MetaCons "ObjectExt" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Int8)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * ByteString))))))))

wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin Source #

Wrap a Plugin in some nice blankets, so that we can put them in a simple list.

function :: String -> Name -> Q Exp Source #

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.

Example: $(function "MyExportedFunction" 'myDefinedFunction) Sync

function' :: Name -> Q Exp Source #

Define an exported function. This function works exactly like function, but it generates the exported name automatically by converting the first letter to upper case.

command :: String -> Name -> Q Exp Source #

Similarly to function, this function is used to export a command with a custom name.

Note that commands must start with an upper case letter.

Due to limitations on the side of (neo)vim, commands can only have one of the following five signatures, where you can replace String with ByteString or Text if you wish:

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 convenient sorting. You should simply not define the same option twice.

command' :: Name -> Q Exp Source #

Define an exported command. This function works exactly like command, but it generates the command name by converting the first letter to upper case.

data Synchronous Source #

This option detemines how neovim should behave when calling some functionality on a remote host.

Constructors

Async

Call the functionality entirely for its side effects and do not wait for it to finish. Calling a functionality with this flag set is completely asynchronous and nothing is really expected to happen. This is why a call like this is called notification on the neovim side of things.

Sync

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.

Instances

Enum Synchronous Source # 
Eq Synchronous Source # 
Ord Synchronous Source # 
Read Synchronous Source # 
Show Synchronous Source # 
IsString Synchronous Source # 
Generic Synchronous Source # 

Associated Types

type Rep Synchronous :: * -> * #

NFData Synchronous Source # 

Methods

rnf :: Synchronous -> () #

Pretty Synchronous Source # 

Methods

pretty :: Synchronous -> Doc ann #

prettyList :: [Synchronous] -> Doc ann #

NvimObject Synchronous Source # 
type Rep Synchronous Source # 
type Rep Synchronous = D1 * (MetaData "Synchronous" "Neovim.Plugin.Classes" "nvim-hs-1.0.0.1-4aDMhyzK6knFlxwLZ8nzIU" False) ((:+:) * (C1 * (MetaCons "Async" PrefixI False) (U1 *)) (C1 * (MetaCons "Sync" PrefixI False) (U1 *)))

data CommandOption Source #

Options for commands.

Some command can also be described by using the OverloadedString extensions. This means that you can write a literal String inside your source file in place for a CommandOption value. See the documentation for each value on how these strings should look like (Both versions are compile time checked.)

Constructors

CmdSync Synchronous

Stringliteral "sync" or "async"

CmdRegister

Register passed to the command.

Stringliteral: "\""

CmdRange RangeSpecification

Determines how neovim passes the range.

Stringliterals: "%" for WholeFile, "," for line and ",123" for 123 lines.

CmdCount Word

Command handles a count. The argument defines the default count.

Stringliteral: string of numbers (e.g. "132")

CmdBang

Command handles a bang

Stringliteral: "!"

Instances

Eq CommandOption Source # 
Ord CommandOption Source # 
Read CommandOption Source # 
Show CommandOption Source # 
IsString CommandOption Source # 
Generic CommandOption Source # 

Associated Types

type Rep CommandOption :: * -> * #

NFData CommandOption Source # 

Methods

rnf :: CommandOption -> () #

Pretty CommandOption Source # 

Methods

pretty :: CommandOption -> Doc ann #

prettyList :: [CommandOption] -> Doc ann #

type Rep CommandOption Source # 

data RangeSpecification Source #

Specification of a range that acommand can operate on.

Constructors

CurrentLine

The line the cursor is at when the command is invoked.

WholeFile

Let the command operate on every line of the file.

RangeCount Int

Let the command operate on each line in the given range.

Instances

Eq RangeSpecification Source # 
Ord RangeSpecification Source # 
Read RangeSpecification Source # 
Show RangeSpecification Source # 
Generic RangeSpecification Source # 
NFData RangeSpecification Source # 

Methods

rnf :: RangeSpecification -> () #

Pretty RangeSpecification Source # 
NvimObject RangeSpecification Source # 
type Rep RangeSpecification Source # 
type Rep RangeSpecification = D1 * (MetaData "RangeSpecification" "Neovim.Plugin.Classes" "nvim-hs-1.0.0.1-4aDMhyzK6knFlxwLZ8nzIU" False) ((:+:) * (C1 * (MetaCons "CurrentLine" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "WholeFile" PrefixI False) (U1 *)) (C1 * (MetaCons "RangeCount" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Int)))))

data CommandArguments Source #

You can use this type as the first argument for a function which is intended to be exported as a command. It holds information about the special attributes a command can take.

Constructors

CommandArguments 

Fields

  • bang :: Maybe Bool

    Nothing means that the function was not defined to handle a bang, otherwise it means that the bang was passed (Just True) or that it was not passed when called (Just False).

  • range :: Maybe (Int, Int)

    Range passed from neovim. Only set if CmdRange was used in the export declaration of the command.

    Example:

    • Just (1,12)
  • count :: Maybe Int

    Count passed by neovim. Only set if CmdCount was used in the export declaration of the command.

  • register :: Maybe String

    Register that the command can/should/must use.

Instances

Eq CommandArguments Source # 
Ord CommandArguments Source # 
Read CommandArguments Source # 
Show CommandArguments Source # 
Generic CommandArguments Source # 
Default CommandArguments Source # 
NFData CommandArguments Source # 

Methods

rnf :: CommandArguments -> () #

Pretty CommandArguments Source # 
NvimObject CommandArguments Source # 
type Rep CommandArguments Source # 

data AutocmdOptions Source #

Options that can be used to register an autocmd. See :h :autocmd or any referenced neovim help-page from the fields of this data type.

Constructors

AutocmdOptions 

Fields

Instances

Eq AutocmdOptions Source # 
Ord AutocmdOptions Source # 
Read AutocmdOptions Source # 
Show AutocmdOptions Source # 
Generic AutocmdOptions Source # 

Associated Types

type Rep AutocmdOptions :: * -> * #

Default AutocmdOptions Source # 

Methods

def :: AutocmdOptions #

NFData AutocmdOptions Source # 

Methods

rnf :: AutocmdOptions -> () #

Pretty AutocmdOptions Source # 

Methods

pretty :: AutocmdOptions -> Doc ann #

prettyList :: [AutocmdOptions] -> Doc ann #

NvimObject AutocmdOptions Source # 
type Rep AutocmdOptions Source # 
type Rep AutocmdOptions = D1 * (MetaData "AutocmdOptions" "Neovim.Plugin.Classes" "nvim-hs-1.0.0.1-4aDMhyzK6knFlxwLZ8nzIU" False) (C1 * (MetaCons "AutocmdOptions" PrefixI True) ((:*:) * (S1 * (MetaSel (Just Symbol "acmdPattern") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * String)) ((:*:) * (S1 * (MetaSel (Just Symbol "acmdNested") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * Bool)) (S1 * (MetaSel (Just Symbol "acmdGroup") NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Maybe String))))))

addAutocmd Source #

Arguments

:: ByteString

The event to register to (e.g. BufWritePost)

-> AutocmdOptions 
-> Neovim env ()

Fully applied function to register

-> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))

A ReleaseKey if the registration worked

Register an autocmd in the current context. This means that, if you are currently in a stateful plugin, the function will be called in the current thread and has access to the configuration and state of this thread. .

Note that the function you pass must be fully applied.

ask :: MonadReader r m => m r #

Retrieves the monad environment.

asks #

Arguments

:: MonadReader r m 
=> (r -> a)

The selector function to apply to the environment.

-> m a 

Retrieves a function of the current environment.

Creating a stateful plugin

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!

File ~/.config/nvim/lib/Random/Plugin.hs:

module Random.Plugin (nextRandom, setNextRandom) where

import Neovim

import System.Random (newStdGen, randoms)
import UnliftIO.STM  (TVar, atomically, readTVar, modifyTVar, newTVarIO)

-- You may want to define a type alias for your plugin, so that if you change
-- your environment, you don't have to change all type signatures.
--
-- If I were to write a real plugin, I would probably also create a data type
-- instead of directly using a TVar here.
--
type MyNeovim a = Neovim (TVar [Int16]) a

-- This function will create an initial environment for our random number
-- generator. Note that the return type is the type of our environment.
randomNumbers :: Neovim startupEnv (TVar [Int16])
randomNumbers = do
    g <- liftIO newStdGen -- Create a new seed for a pseudo random number generator
    newTVarIO (randoms g) -- Put an infinite list of random numbers into a TVar

-- | Get the next random number and update the state of the list.
nextRandom :: MyNeovim Int16
nextRandom = do
    tVarWithRandomNumbers <- ask
    atomically $ do
        -- pick the head of our list of random numbers
        r 'head' <$ readTVar tVarWithRandomNumbers

        -- Since we do not want to return the same number all over the place
        -- remove the head of our list of random numbers
        modifyTVar tVarWithRandomNumbers tail

        return r


-- | You probably don't want this in a random number generator, but this shows
-- hoy you can edit the state of a stateful plugin.
setNextRandom :: Int16 -> MyNeovim ()
setNextRandom n = do
    tVarWithRandomNumbers <- ask

    -- cons n to the front of the infinite list
    atomically $ modifyTVar tVarWithRandomNumbers (n:)

File ~/.config/nvim/lib/Random.hs:

{-# LANGUAGE TemplateHaskell #-}
module Random (plugin) where

import Neovim
import Random.Plugin (nextRandom, setNextRandom)
import System.Random (newStdGen, randoms)

plugin :: Neovim (StartupConfig NeovimConfig) () NeovimPlugin
plugin = do
    env <- randomNumbers
    wrapPlugin Plugin
        { environment = env
        , exports         =
          [ $(function' 'nextRandom) Sync
          , $(function "SetNextRandom" 'setNextRandom) Async
          ]
        }

File ~/.config/nvim/nvim.hs:

import Neovim

import qualified Fibonacci as Fibonacci
import qualified Random    as Random

main :: IO ()
main = neovim defaultConfig
    { plugins = plugins defaultConfig ++ [ Fibonacci.plugin, Random.plugin ]
    }

That wasn't too hard, was it? The definition is very similar to the previous example, we just were able to mutate our state and share that with other functions. The only slightly tedious thing was to define the statefulExports field because it is a list of triples which has a list of exported functionalities as its third argument. Another noteworthy detail, in case you are not familiar with it, is the use of liftIO in front of newStdGen. You have to do this, because newStdGen has type IO StdGen but the actions inside the startup code are of type Neovim (StartupConfig NeovimConfig) () something. liftIO lifts an IO function so that it can be run inside the Neovim context (or more generally, any monad that implements the MonadIO type class).

After you have saved these files (and removed any typos :-)), you can restart nvim-hs with :RestartNvimhs and insert random numbers in your text files!

<C-r>=NextRandom()

You can also cheat and pretend you know the next number:

:call SetNextRandom(42)

Calling remote functions

Calling remote functions is only possible inside a Neovim context. There are a few patterns of return values for the available functions. Let's start with getting some abstract Buffer object, test whether it is valid and then try to rename it.

inspectBuffer :: Neovim env ()
inspectBuffer = do
    cb <- vim_get_current_buffer
    isValid <- buffer_is_valid cb
    when isValid $ do
        let newName = "magic"
        retval <- wait' $ buffer_set_name cb newName
        case retval of
            Right cbName | cbName == newName -> return ()
            Right _ -> err $ "Renaming the current buffer failed!"
            Left e -> err $ show e

You may have noticed the wait' function in there. Some functions have a return type with STM in it. This means that the function call is asynchronous. We can wait (or wait') for the result at the point at which we actually need it. In this short example, we put the wait' directly in front of the remote function call because we want to inspect the result immediately, though. The other functions either returned a result directly or they returned Either Object something whose result we inspected ourselves. The err function directly terminates the current thread and sends the given error message to neovim which the user immediately notices. Since it is not unusual to not know what to do if the remote function call failed, the functions waitErr and waitErr' can save you from some typing and deeply nested case expressions.

That's pretty much all there is to it.

wait :: Neovim env (STM result) -> Neovim env result Source #

Wait for the result of the STM action.

This action possibly blocks as it is an alias for ioSTM -> ioSTM >>= liftIO . atomically.

wait' :: Neovim env (STM result) -> Neovim env () Source #

Variant of wait that discards the result.

waitErr Source #

Arguments

:: String

Prefix error message with this.

-> Neovim env (STM (Either NeovimException result))

Function call to neovim

-> Neovim env result 

Wait for the result of the STM action and call err . (loc++) . show if the action returned an error.

waitErr' :: String -> Neovim env (STM (Either NeovimException result)) -> Neovim env () Source #

waitErr that discards the result.

err :: Doc AnsiStyle -> Neovim env a Source #

throw specialized to a Pretty value.

data NeovimException Source #

Exceptions specific to nvim-hs.

Constructors

ErrorMessage (Doc AnsiStyle)

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.

Generated functions for neovim interaction

Unsorted exports

liftIO :: MonadIO m => forall a. IO a -> m a #

Lift a computation from the IO monad.

withCustomEnvironment :: (Traversable t, MonadUnliftIO m) => t (String, Maybe String) -> m c -> m c Source #

Execute the given action with a changed set of environment variables and restore the original state of the environment afterwards.

whenM :: Monad m => m Bool -> m () -> m () Source #

when with a monadic predicate.

unlessM :: Monad m => m Bool -> m () -> m () Source #

unless with a monadic predicate.

docToObject :: Doc AnsiStyle -> Object Source #

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.

data Doc ann :: * -> * #

The abstract data type Doc ann represents pretty documents that have been annotated with data of type ann.

More specifically, a value of type Doc represents a non-empty set of possible layouts of a document. The layout functions select one of these possibilities, taking into account things like the width of the output document.

The annotation is an arbitrary piece of data associated with (part of) a document. Annotations may be used by the rendering backends in order to display output differently, such as

  • color information (e.g. when rendering to the terminal)
  • mouseover text (e.g. when rendering to rich HTML)
  • whether to show something or not (to allow simple or detailed versions)

The simplest way to display a Doc is via the Show class.

>>> putStrLn (show (vsep ["hello", "world"]))
hello
world

Instances

Functor Doc

Alter the document’s annotations.

This instance makes Doc more flexible (because it can be used in Functor-polymorphic values), but fmap is much less readable compared to using reAnnotate in code that only works for Doc anyway. Consider using the latter when the type does not matter.

Methods

fmap :: (a -> b) -> Doc a -> Doc b #

(<$) :: a -> Doc b -> Doc a #

Show (Doc ann)

(show doc) prettyprints document doc with defaultLayoutOptions, ignoring all annotations.

Methods

showsPrec :: Int -> Doc ann -> ShowS #

show :: Doc ann -> String #

showList :: [Doc ann] -> ShowS #

IsString (Doc ann)
>>> pretty ("hello\nworld")
hello
world

This instance uses the Pretty Text instance, and uses the same newline to line conversion.

Methods

fromString :: String -> Doc ann #

Generic (Doc ann) 

Associated Types

type Rep (Doc ann) :: * -> * #

Methods

from :: Doc ann -> Rep (Doc ann) x #

to :: Rep (Doc ann) x -> Doc ann #

Semigroup (Doc ann)
x <> y = hcat [x, y]
>>> "hello" <> "world" :: Doc ann
helloworld

Methods

(<>) :: Doc ann -> Doc ann -> Doc ann #

sconcat :: NonEmpty (Doc ann) -> Doc ann #

stimes :: Integral b => b -> Doc ann -> Doc ann #

Monoid (Doc ann)
mempty = emptyDoc
mconcat = hcat
>>> mappend "hello" "world" :: Doc ann
helloworld

Methods

mempty :: Doc ann #

mappend :: Doc ann -> Doc ann -> Doc ann #

mconcat :: [Doc ann] -> Doc ann #

type Rep (Doc ann) 
type Rep (Doc ann) = D1 * (MetaData "Doc" "Data.Text.Prettyprint.Doc.Internal" "prettyprinter-1.2.0.1-5La26ycBL8v75W5GOZOGtO" False) ((:+:) * ((:+:) * ((:+:) * (C1 * (MetaCons "Fail" PrefixI False) (U1 *)) ((:+:) * (C1 * (MetaCons "Empty" PrefixI False) (U1 *)) (C1 * (MetaCons "Char" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Char))))) ((:+:) * (C1 * (MetaCons "Text" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Text)))) ((:+:) * (C1 * (MetaCons "Line" PrefixI False) (U1 *)) (C1 * (MetaCons "FlatAlt" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann)))))))) ((:+:) * ((:+:) * (C1 * (MetaCons "Cat" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))))) ((:+:) * (C1 * (MetaCons "Nest" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness SourceStrict DecidedStrict) (Rec0 * Int)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))))) (C1 * (MetaCons "Union" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann))))))) ((:+:) * ((:+:) * (C1 * (MetaCons "Column" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Int -> Doc ann)))) (C1 * (MetaCons "WithPageWidth" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (PageWidth -> Doc ann))))) ((:+:) * (C1 * (MetaCons "Nesting" PrefixI False) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Int -> Doc ann)))) (C1 * (MetaCons "Annotated" PrefixI False) ((:*:) * (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * ann)) (S1 * (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 * (Doc ann)))))))))

data AnsiStyle :: * #

Render the annotated document in a certain style. Styles not set in the annotation will use the style of the surrounding document, or the terminal’s default if none has been set yet.

style = color Green <> bold
styledDoc = annotate style "hello world"

Instances

Eq AnsiStyle 
Ord AnsiStyle 
Show AnsiStyle 
Semigroup AnsiStyle

Keep the first decision for each of foreground color, background color, boldness, italication, and underlining. If a certain style is not set, the terminal’s default will be used.

Example:

color Red <> color Green

is red because the first color wins, and not bold because (or if) that’s the terminal’s default.

Monoid AnsiStyle

mempty does nothing, which is equivalent to inheriting the style of the surrounding doc, or the terminal’s default if no style has been set yet.

class Pretty a where #

Overloaded conversion to Doc.

Laws:

  1. output should be pretty. :-)

Minimal complete definition

pretty

Methods

pretty :: a -> Doc ann #

>>> pretty 1 <+> pretty "hello" <+> pretty 1.234
1 hello 1.234

prettyList :: [a] -> Doc ann #

prettyList is only used to define the instance Pretty a => Pretty [a]. In normal circumstances only the pretty function is used.

>>> prettyList [1, 23, 456]
[1, 23, 456]

Instances

Pretty Bool
>>> pretty True
True

Methods

pretty :: Bool -> Doc ann #

prettyList :: [Bool] -> Doc ann #

Pretty Char

Instead of (pretty '\n'), consider using line as a more readable alternative.

>>> pretty 'f' <> pretty 'o' <> pretty 'o'
foo
>>> pretty ("string" :: String)
string

Methods

pretty :: Char -> Doc ann #

prettyList :: [Char] -> Doc ann #

Pretty Double
>>> pretty (exp 1 :: Double)
2.718281828459045

Methods

pretty :: Double -> Doc ann #

prettyList :: [Double] -> Doc ann #

Pretty Float
>>> pretty (pi :: Float)
3.1415927

Methods

pretty :: Float -> Doc ann #

prettyList :: [Float] -> Doc ann #

Pretty Int
>>> pretty (123 :: Int)
123

Methods

pretty :: Int -> Doc ann #

prettyList :: [Int] -> Doc ann #

Pretty Int8 

Methods

pretty :: Int8 -> Doc ann #

prettyList :: [Int8] -> Doc ann #

Pretty Int16 

Methods

pretty :: Int16 -> Doc ann #

prettyList :: [Int16] -> Doc ann #

Pretty Int32 

Methods

pretty :: Int32 -> Doc ann #

prettyList :: [Int32] -> Doc ann #

Pretty Int64 

Methods

pretty :: Int64 -> Doc ann #

prettyList :: [Int64] -> Doc ann #

Pretty Integer
>>> pretty (2^123 :: Integer)
10633823966279326983230456482242756608

Methods

pretty :: Integer -> Doc ann #

prettyList :: [Integer] -> Doc ann #

Pretty Natural 

Methods

pretty :: Natural -> Doc ann #

prettyList :: [Natural] -> Doc ann #

Pretty Word 

Methods

pretty :: Word -> Doc ann #

prettyList :: [Word] -> Doc ann #

Pretty Word8 

Methods

pretty :: Word8 -> Doc ann #

prettyList :: [Word8] -> Doc ann #

Pretty Word16 

Methods

pretty :: Word16 -> Doc ann #

prettyList :: [Word16] -> Doc ann #

Pretty Word32 

Methods

pretty :: Word32 -> Doc ann #

prettyList :: [Word32] -> Doc ann #

Pretty Word64 

Methods

pretty :: Word64 -> Doc ann #

prettyList :: [Word64] -> Doc ann #

Pretty ()
>>> pretty ()
()

The argument is not used,

>>> pretty (error "Strict?" :: ())
()

Methods

pretty :: () -> Doc ann #

prettyList :: [()] -> Doc ann #

Pretty Void

Finding a good example for printing something that does not exist is hard, so here is an example of printing a list full of nothing.

>>> pretty ([] :: [Void])
[]

Methods

pretty :: Void -> Doc ann #

prettyList :: [Void] -> Doc ann #

Pretty Text

Automatically converts all newlines to line.

>>> pretty ("hello\nworld" :: Text)
hello
world

Note that line can be undone by group:

>>> group (pretty ("hello\nworld" :: Text))
hello world

Manually use hardline if you definitely want newlines.

Methods

pretty :: Text -> Doc ann #

prettyList :: [Text] -> Doc ann #

Pretty Text

(lazy Text instance, identical to the strict version)

Methods

pretty :: Text -> Doc ann #

prettyList :: [Text] -> Doc ann #

Pretty AutocmdOptions # 

Methods

pretty :: AutocmdOptions -> Doc ann #

prettyList :: [AutocmdOptions] -> Doc ann #

Pretty CommandArguments # 
Pretty RangeSpecification # 
Pretty CommandOptions # 

Methods

pretty :: CommandOptions -> Doc ann #

prettyList :: [CommandOptions] -> Doc ann #

Pretty CommandOption # 

Methods

pretty :: CommandOption -> Doc ann #

prettyList :: [CommandOption] -> Doc ann #

Pretty Synchronous # 

Methods

pretty :: Synchronous -> Doc ann #

prettyList :: [Synchronous] -> Doc ann #

Pretty FunctionalityDescription # 
Pretty FunctionName # 

Methods

pretty :: FunctionName -> Doc ann #

prettyList :: [FunctionName] -> Doc ann #

Pretty Notification # 

Methods

pretty :: Notification -> Doc ann #

prettyList :: [Notification] -> Doc ann #

Pretty Request # 

Methods

pretty :: Request -> Doc ann #

prettyList :: [Request] -> Doc ann #

Pretty FunctionCall # 

Methods

pretty :: FunctionCall -> Doc ann #

prettyList :: [FunctionCall] -> Doc ann #

Pretty FunctionType # 

Methods

pretty :: FunctionType -> Doc ann #

prettyList :: [FunctionType] -> Doc ann #

Pretty Message # 

Methods

pretty :: Message -> Doc ann #

prettyList :: [Message] -> Doc ann #

Pretty a => Pretty [a]
>>> pretty [1,2,3]
[1, 2, 3]

Methods

pretty :: [a] -> Doc ann #

prettyList :: [[a]] -> Doc ann #

Pretty a => Pretty (Maybe a)

Ignore Nothings, print Just contents.

>>> pretty (Just True)
True
>>> braces (pretty (Nothing :: Maybe Bool))
{}
>>> pretty [Just 1, Nothing, Just 3, Nothing]
[1, 3]

Methods

pretty :: Maybe a -> Doc ann #

prettyList :: [Maybe a] -> Doc ann #

Pretty a => Pretty (NonEmpty a) 

Methods

pretty :: NonEmpty a -> Doc ann #

prettyList :: [NonEmpty a] -> Doc ann #

(Pretty a1, Pretty a2) => Pretty (a1, a2)
>>> pretty (123, "hello")
(123, hello)

Methods

pretty :: (a1, a2) -> Doc ann #

prettyList :: [(a1, a2)] -> Doc ann #

(Pretty a1, Pretty a2, Pretty a3) => Pretty (a1, a2, a3)
>>> pretty (123, "hello", False)
(123, hello, False)

Methods

pretty :: (a1, a2, a3) -> Doc ann #

prettyList :: [(a1, a2, a3)] -> Doc ann #

putDoc :: Doc AnsiStyle -> IO () #

(putDoc doc) prettyprints document doc to standard output using defaultLayoutOptions.

>>> putDoc ("hello" <+> "world")
hello world
putDoc = hPutDoc stdout

data Priority :: * #

Priorities are used to define how important a log message is. Users can filter log messages based on priorities.

These have their roots on the traditional syslog system. The standard definitions are given below, but you are free to interpret them however you like. They are listed here in ascending importance order.

Constructors

DEBUG

Debug messages

INFO

Information

NOTICE

Normal runtime conditions

WARNING

General Warnings

ERROR

General Errors

CRITICAL

Severe situations

ALERT

Take immediate action

EMERGENCY

System is unusable

module Data.Int

module Data.Word