nvim-hs 2.3.0.0 → 2.3.1.0
raw patch · 35 files changed
+2207/−2129 lines, 35 filesdep ~prettyprintersetup-changed
Dependency ranges changed: prettyprinter
Files
- CHANGELOG.md +9/−0
- Setup.hs +1/−1
- library/Neovim.hs +10/−3
- library/Neovim/API/ByteString.hs +7/−9
- library/Neovim/API/String.hs +7/−8
- library/Neovim/API/TH.hs +8/−6
- library/Neovim/API/Text.hs +7/−9
- library/Neovim/Classes.hs +258/−277
- library/Neovim/Config.hs +15/−17
- library/Neovim/Context.hs +3/−1
- library/Neovim/Context/Internal.hs +208/−171
- library/Neovim/Debug.hs +161/−145
- library/Neovim/Exceptions.hs +19/−23
- library/Neovim/Log.hs +20/−22
- library/Neovim/Main.hs +146/−134
- library/Neovim/Plugin.hs +196/−195
- library/Neovim/Plugin/Classes.hs +258/−271
- library/Neovim/Plugin/IPC.hs +3/−5
- library/Neovim/Plugin/IPC/Classes.hs +79/−77
- library/Neovim/Plugin/Internal.hs +19/−24
- library/Neovim/Quickfix.hs +110/−109
- library/Neovim/RPC/Classes.hs +48/−61
- library/Neovim/RPC/EventHandler.hs +52/−53
- library/Neovim/RPC/FunctionCall.hs +47/−44
- library/Neovim/RPC/SocketReader.hs +98/−120
- library/Neovim/Test.hs +79/−74
- library/Neovim/Util.hs +5/−9
- nvim-hs.cabal +3/−2
- test-suite/Neovim/API/THSpec.hs +81/−81
- test-suite/Neovim/API/THSpecFunctions.hs +3/−4
- test-suite/Neovim/EmbeddedRPCSpec.hs +77/−72
- test-suite/Neovim/EventSubscriptionSpec.hs +64/−0
- test-suite/Neovim/Plugin/ClassesSpec.hs +26/−32
- test-suite/Neovim/RPC/CommonSpec.hs +12/−12
- test-suite/Neovim/RPC/SocketReaderSpec.hs +68/−58
CHANGELOG.md view
@@ -1,3 +1,12 @@+# 2.3.1.0++* Add `subscribe` and `unsubscribe` function. Neovim doesn't automatically send+ event notifications to nvim-hs (or any other remote plugin) and for the+ callback of the `subscribe` funtion to trigger, you have to call a specific+ function before (e.g. `nvim_buf_attach`). In any case, if you want to subscribe + to a specific event, you have to read the documentation of the neovim + documentation. Some events are still better handled with autocommands.+ # 2.3.0.0 * Windows is now rudimentarily supported. Since I couldn't find a library to
Setup.hs view
@@ -1,3 +1,3 @@-import Distribution.Simple+import Distribution.Simple main = defaultMain
library/Neovim.hs view
@@ -54,6 +54,12 @@ ask, asks, + -- ** Subscribing to notifications or events+ Subscription,+ subscribe,+ unsubscribe,+ NeovimEventId(..),+ -- ** Creating a stateful plugin -- $statefulplugin @@ -106,7 +112,7 @@ NeovimException(..), exceptionToDoc, ask, asks, err,- errOnInvalidResult)+ errOnInvalidResult, subscribe, unsubscribe) import Neovim.Main (neovim) import Neovim.Exceptions (catchNeovimException) import Neovim.Plugin (addAutocmd)@@ -114,13 +120,14 @@ CommandArguments (..), CommandOption (CmdBang, CmdCount, CmdRange, CmdRegister, CmdSync), RangeSpecification (..),- Synchronous (..))+ Synchronous (..),+ Subscription, NeovimEventId(..)) import Neovim.Plugin.Internal (NeovimPlugin (..), Plugin (..), wrapPlugin) import Neovim.RPC.FunctionCall (wait, wait') import Neovim.Util (unlessM, whenM) import System.Log.Logger (Priority (..))-import Data.Text.Prettyprint.Doc.Render.Terminal (putDoc)+import Prettyprinter.Render.Terminal (putDoc) -- Installation {{{1 {- $installation
library/Neovim/API/ByteString.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}+ {- | Module : Neovim.API.ByteString Description : ByteString based API@@ -12,12 +13,9 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -}-module Neovim.API.ByteString- where+module Neovim.API.ByteString where -import Neovim.API.TH+import Neovim.API.TH $(generateAPI bytestringVectorTypeMap)-
library/Neovim/API/String.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}+ {- | Module : Neovim.API.String Description : String based API@@ -17,10 +18,8 @@ available to you. All the functions in this module depend on the neovim version that was used when this package was compiled. -}-module Neovim.API.String- where+module Neovim.API.String where -import Neovim.API.TH+import Neovim.API.TH $(generateAPI stringListTypeMap)-
library/Neovim/API/TH.hs view
@@ -40,7 +40,7 @@ import Neovim.Plugin.Internal (ExportedFunctionality (..)) import Neovim.RPC.FunctionCall -import Language.Haskell.TH hiding (dataD, instanceD, conP)+import Language.Haskell.TH hiding (conP, dataD, instanceD) import TemplateHaskell.Compat.V0208 import Control.Applicative@@ -59,8 +59,8 @@ import Data.Monoid import qualified Data.Set as Set import Data.Text (Text)-import Data.Text.Prettyprint.Doc (viaShow) import Data.Vector (Vector)+import Prettyprinter (viaShow) import UnliftIO.Exception import Prelude@@ -203,7 +203,8 @@ vars <- mapM ( \(t, n) ->- (,) <$> apiTypeToHaskellType typeMap t+ (,)+ <$> apiTypeToHaskellType typeMap t <*> newName n ) $ applyPrefixWithNumber nf@@ -272,11 +273,12 @@ let fromObjectClause :: Name -> Int64 -> Q Clause fromObjectClause n i = do bs <- newName "bs"- let objectExtMatch = conP+ let objectExtMatch =+ conP (mkName "ObjectExt") [(LitP . integerL . fromIntegral) i, VarP bs] clause- [ pure objectExtMatch ]+ [pure objectExtMatch] (normalB [|return $ $(conE n) $(varE bs)|]) [] fromObjectErrorClause :: Q Clause@@ -518,7 +520,7 @@ [varP args] ( caseE (varE args)- (zipWith matchingCase [n, n -1 ..] [0 .. minLength] ++ [errorCase])+ (zipWith matchingCase [n, n - 1 ..] [0 .. minLength] ++ [errorCase]) ) -- _ -> err "Wrong number of arguments"
library/Neovim/API/Text.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE NoOverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TemplateHaskell #-}+ {- | Module : Neovim.API.Text Description : Text based API@@ -12,12 +13,9 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -}-module Neovim.API.Text- where+module Neovim.API.Text where -import Neovim.API.TH+import Neovim.API.TH $(generateAPI textVectorTypeMap)-
library/Neovim/Classes.hs view
@@ -1,11 +1,9 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-#if __GLASGOW_HASKELL__ < 710-{-# LANGUAGE OverlappingInstances #-}-#endif+{-# LANGUAGE RankNTypes #-}+ {- | Module : Neovim.Classes Description : Type classes used for conversion of msgpack and Haskell types@@ -14,121 +12,119 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -}-module Neovim.Classes- ( NvimObject(..)- , Dictionary- , (+:)- , Generic- , docToObject- , docFromObject- , docToText-- , Doc- , AnsiStyle- , Pretty(..)- , (<+>)- , module Data.Int- , module Data.Word- , module Control.DeepSeq- ) where+module Neovim.Classes (+ NvimObject (..),+ Dictionary,+ (+:),+ Generic,+ docToObject,+ docFromObject,+ docToText,+ Doc,+ AnsiStyle,+ Pretty (..),+ (<+>),+ module Data.Int,+ module Data.Word,+ module Control.DeepSeq,+) where import Neovim.Exceptions (NeovimException (..)) -import Control.Applicative-import Control.Arrow ((***))-import Control.DeepSeq-import Control.Monad.Except-import Data.ByteString (ByteString)-import Data.Int- ( Int16- , Int32- , Int64- , Int8- )-import qualified Data.Map.Strict as SMap-import Data.MessagePack-import Data.Monoid-import Data.Text as Text (Text)-import Data.Text.Prettyprint.Doc- ( Doc- , Pretty (..)- , defaultLayoutOptions- , layoutPretty- , viaShow- , (<+>)- )-import qualified Data.Text.Prettyprint.Doc as P-import Data.Text.Prettyprint.Doc.Render.Terminal- ( AnsiStyle- , renderStrict- )-import Data.Traversable hiding (forM, mapM)-import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.Word- ( Word- , Word16- , Word32- , Word64- , Word8- )-import GHC.Generics (Generic)+import Control.Applicative+import Control.Arrow ((***))+import Control.DeepSeq+import Control.Monad.Except+import Data.ByteString (ByteString)+import Data.Int (+ Int16,+ Int32,+ Int64,+ Int8,+ )+import qualified Data.Map.Strict as SMap+import Data.MessagePack+import Data.Monoid+import Data.Text as Text (Text)+import Data.Traversable hiding (forM, mapM)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Word (+ Word,+ Word16,+ Word32,+ Word64,+ Word8,+ )+import GHC.Generics (Generic)+import Prettyprinter (+ Doc,+ Pretty (..),+ defaultLayoutOptions,+ layoutPretty,+ viaShow,+ (<+>),+ )+import qualified Prettyprinter as P+import Prettyprinter.Render.Terminal (+ AnsiStyle,+ renderStrict,+ ) import qualified Data.ByteString.UTF8 as UTF8 (fromString, toString)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)-import UnliftIO.Exception (throwIO)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import UnliftIO.Exception (throwIO) import Prelude - infixr 5 +: --- | Convenient operator to create a list of 'Object' from normal values.--- @--- values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []--- @+{- | Convenient operator to create a list of 'Object' from normal values.+ @+ values +: of :+ different :+ types :+ can +: be +: combined +: this +: way +: []+ @+-} (+:) :: (NvimObject o) => o -> [Object] -> [Object] o +: os = toObject o : os ---- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience--- method to transport error message from and to neovim. It generally does not--- hold that 'docToObject . docFromObject' = 'id'.+{- | Convert a 'Doc'-ument to a messagepack 'Object'. This is more a convenience+ method to transport error message from and to neovim. It generally does not+ hold that 'docToObject . docFromObject' = 'id'.+-} docToObject :: Doc AnsiStyle -> Object docToObject = ObjectString . encodeUtf8 . docToText - -- | See 'docToObject'. docFromObject :: Object -> Either (Doc AnsiStyle) (Doc AnsiStyle) docFromObject o = (P.viaShow :: Text -> Doc AnsiStyle) <$> fromObject o - docToText :: Doc AnsiStyle -> Text docToText = renderStrict . layoutPretty defaultLayoutOptions ---- | 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.+{- | A generic vim dictionary is a simply a map from strings to objects. This+ type alias is sometimes useful as a type annotation especially if the+ OverloadedStrings extension is enabled.+-} type Dictionary = SMap.Map ByteString Object +{- | Conversion from 'Object' files to Haskell types and back with respect+ to neovim's interpretation. --- | 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.+ The 'NFData' constraint has been added to allow forcing results of function+ evaluations in order to catch exceptions from pure code. This adds more+ stability to the plugin provider and seems to be a cleaner approach.+-} class NFData o => NvimObject o where toObject :: o -> Object fromObjectUnsafe :: Object -> o fromObjectUnsafe o = case fromObject o of- Left e -> error . show $- "Not the expected object:" <+> P.viaShow o- <+> P.lparen <> e <> P.rparen+ Left e ->+ error . show $+ "Not the expected object:"+ <+> P.viaShow o+ <+> P.lparen <> e <> P.rparen Right obj -> obj fromObject :: Object -> Either (Doc AnsiStyle) o@@ -139,226 +135,211 @@ {-# MINIMAL toObject, (fromObject | fromObjectUnsafe) #-} - -- Instances for NvimObject {{{1 instance NvimObject () where- toObject _ = ObjectNil+ toObject _ = ObjectNil fromObject ObjectNil = return ()- fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o-+ fromObject o = throwError $ "Expected ObjectNil, but got" <+> P.viaShow o -- We may receive truthy values from neovim, so we should be more forgiving -- here. instance NvimObject Bool where- toObject = ObjectBool+ toObject = ObjectBool - fromObject (ObjectBool o) = return o- fromObject (ObjectInt 0) = return False- fromObject (ObjectUInt 0) = return False- fromObject ObjectNil = return False+ fromObject (ObjectBool o) = return o+ fromObject (ObjectInt 0) = return False+ fromObject (ObjectUInt 0) = return False+ fromObject ObjectNil = return False fromObject (ObjectBinary "0") = return False- fromObject (ObjectBinary "") = return False+ fromObject (ObjectBinary "") = return False fromObject (ObjectString "0") = return False- fromObject (ObjectString "") = return False- fromObject _ = return True-+ fromObject (ObjectString "") = return False+ fromObject _ = return True instance NvimObject Double where- toObject = ObjectDouble+ toObject = ObjectDouble fromObject (ObjectDouble o) = return o- fromObject (ObjectFloat o) = return $ realToFrac o- fromObject (ObjectInt o) = return $ fromIntegral o- fromObject (ObjectUInt o) = return $ fromIntegral o- fromObject o = throwError $ "Expected ObjectDouble, but got"- <+> viaShow o-+ fromObject (ObjectFloat o) = return $ realToFrac o+ fromObject (ObjectInt o) = return $ fromIntegral o+ fromObject (ObjectUInt o) = return $ fromIntegral o+ fromObject o =+ throwError $+ "Expected ObjectDouble, but got"+ <+> viaShow o instance NvimObject Integer where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt o) = return $ toInteger o- fromObject (ObjectUInt o) = return $ toInteger o+ fromObject (ObjectInt o) = return $ toInteger o+ fromObject (ObjectUInt o) = return $ toInteger o fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected ObjectInt, but got" <+> viaShow o instance NvimObject Int64 where- toObject = ObjectInt+ toObject = ObjectInt - fromObject (ObjectInt i) = return i- fromObject (ObjectUInt o) = return $ fromIntegral o+ fromObject (ObjectInt i) = return i+ fromObject (ObjectUInt o) = return $ fromIntegral o fromObject (ObjectDouble o) = return $ round o- fromObject (ObjectFloat o) = return $ round o- fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Int32 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Int16 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Int8 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Word where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Word64 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Word32 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Word16 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Word8 where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance NvimObject Int where- toObject = ObjectInt . fromIntegral+ toObject = ObjectInt . fromIntegral - fromObject (ObjectInt i) = return $ fromIntegral i- fromObject (ObjectUInt i) = return $ fromIntegral i+ fromObject (ObjectInt i) = return $ fromIntegral i+ fromObject (ObjectUInt 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" <+> viaShow o-+ fromObject (ObjectFloat o) = return $ round o+ fromObject o = throwError $ "Expected any Integer value, but got" <+> viaShow o instance {-# OVERLAPPING #-} NvimObject [Char] where- toObject = ObjectBinary . UTF8.fromString+ toObject = ObjectBinary . UTF8.fromString fromObject (ObjectBinary o) = return $ UTF8.toString o fromObject (ObjectString o) = return $ UTF8.toString o- fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o-+ fromObject o = throwError $ "Expected ObjectString, but got" <+> viaShow o instance {-# OVERLAPPABLE #-} NvimObject o => NvimObject [o] where- toObject = ObjectArray . map toObject+ toObject = ObjectArray . map toObject fromObject (ObjectArray os) = mapM fromObject os- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o-+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o instance NvimObject o => NvimObject (Maybe o) where toObject = maybe ObjectNil toObject fromObject ObjectNil = return Nothing- fromObject o = either throwError (return . Just) $ fromObject o-+ fromObject o = either throwError (return . Just) $ fromObject o instance NvimObject o => NvimObject (Vector o) where toObject = ObjectArray . V.toList . V.map toObject fromObject (ObjectArray os) = V.fromList <$> mapM fromObject os- fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o-+ fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o -- | Right-biased instance for toObject. instance (NvimObject l, NvimObject r) => NvimObject (Either l r) where toObject = either toObject toObject fromObject o = case fromObject o of- Right r ->- return $ Right r-- Left e1 -> case fromObject o of- Right l ->- return $ Left l-- Left e2 ->- throwError $ e1 <+> "--" <+> e2---instance (Ord key, NvimObject key, NvimObject val)- => NvimObject (SMap.Map key val) where- toObject = ObjectMap- . SMap.fromList . map (toObject *** toObject) . SMap.toList+ Right r ->+ return $ Right r+ Left e1 -> case fromObject o of+ Right l ->+ return $ Left l+ Left e2 ->+ throwError $ e1 <+> "--" <+> e2 - fromObject (ObjectMap om) = SMap.fromList <$>- (sequenceA- . map (uncurry (liftA2 (,))- . (fromObject *** fromObject))- . SMap.toList) om+instance+ (Ord key, NvimObject key, NvimObject val) =>+ NvimObject (SMap.Map key val)+ where+ toObject =+ ObjectMap+ . SMap.fromList+ . map (toObject *** toObject)+ . SMap.toList + fromObject (ObjectMap om) =+ SMap.fromList+ <$> ( traverse+ ( uncurry (liftA2 (,))+ . (fromObject *** fromObject)+ )+ . SMap.toList+ )+ om fromObject o = throwError $ "Expected ObjectMap, but got" <+> viaShow o - instance NvimObject Text where- toObject = ObjectBinary . encodeUtf8+ toObject = ObjectBinary . encodeUtf8 fromObject (ObjectBinary o) = return $ decodeUtf8 o fromObject (ObjectString o) = return $ decodeUtf8 o- fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o-+ fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o instance NvimObject ByteString where- toObject = ObjectBinary+ toObject = ObjectBinary fromObject (ObjectBinary o) = return o fromObject (ObjectString o) = return o- fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o-+ fromObject o = throwError $ "Expected ObjectBinary, but got" <+> viaShow o instance NvimObject Object where toObject = id@@ -366,105 +347,105 @@ fromObject = return fromObjectUnsafe = id - -- 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] - fromObject (ObjectArray [o1, o2]) = (,)- <$> fromObject o1- <*> fromObject o2+ fromObject (ObjectArray [o1, o2]) =+ (,)+ <$> fromObject o1+ <*> fromObject o2 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o instance (NvimObject o1, NvimObject o2, NvimObject o3) => NvimObject (o1, o2, o3) where toObject (o1, o2, o3) = ObjectArray $ [toObject o1, toObject o2, toObject o3] - fromObject (ObjectArray [o1, o2, o3]) = (,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3+ fromObject (ObjectArray [o1, o2, o3]) =+ (,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o - instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4) => NvimObject (o1, o2, o3, o4) where- toObject (o1, o2, o3, o4) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4]+ toObject (o1, o2, o3, o4) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4] - fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4+ fromObject (ObjectArray [o1, o2, o3, o4]) =+ (,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o - instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5) => NvimObject (o1, o2, o3, o4, o5) where- toObject (o1, o2, o3, o4, o5) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5]+ toObject (o1, o2, o3, o4, o5) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5] - fromObject (ObjectArray [o1, o2, o3, o4, o5]) = (,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5+ fromObject (ObjectArray [o1, o2, o3, o4, o5]) =+ (,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o - instance (NvimObject o1, NvimObject o2, NvimObject o3, NvimObject o4, NvimObject o5, NvimObject o6) => NvimObject (o1, o2, o3, o4, o5, o6) where- toObject (o1, o2, o3, o4, o5, o6) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6]+ toObject (o1, o2, o3, o4, o5, o6) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6] - fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) = (,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) =+ (,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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- toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7]+ toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7] - fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) = (,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) =+ (,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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 toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8] - fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) = (,,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7- <*> fromObject o8+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) =+ (,,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7+ <*> fromObject o8 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow 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 toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray $ [toObject o1, toObject o2, toObject o3, toObject o4, toObject o5, toObject o6, toObject o7, toObject o8, toObject o9] - fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) = (,,,,,,,,)- <$> fromObject o1- <*> fromObject o2- <*> fromObject o3- <*> fromObject o4- <*> fromObject o5- <*> fromObject o6- <*> fromObject o7- <*> fromObject o8- <*> fromObject o9+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) =+ (,,,,,,,,)+ <$> fromObject o1+ <*> fromObject o2+ <*> fromObject o3+ <*> fromObject o4+ <*> fromObject o5+ <*> fromObject o6+ <*> fromObject o7+ <*> fromObject o8+ <*> fromObject o9 fromObject o = throwError $ "Expected ObjectArray, but got" <+> viaShow o- -- 1}}}
library/Neovim/Config.hs view
@@ -6,28 +6,26 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -} module Neovim.Config (- NeovimConfig(..),+ NeovimConfig (..), module System.Log,- ) where+) where -import Neovim.Context (Neovim)-import Neovim.Plugin.Internal (NeovimPlugin)+import Neovim.Context (Neovim)+import Neovim.Plugin.Internal (NeovimPlugin) -import System.Log (Priority (..))+import System.Log (Priority (..)) --- | 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.+{- | 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- { plugins :: [Neovim () NeovimPlugin]- -- ^ The list of plugins. The IO type inside the list allows the plugin- -- author to run some arbitrary startup code before creating a value of- -- type 'NeovimPlugin'.-- , logOptions :: Maybe (FilePath, Priority)- -- ^ Set the general logging options.+ { -- | The list of plugins. The IO type inside the list allows the plugin+ -- author to run some arbitrary startup code before creating a value of+ -- type 'NeovimPlugin'.+ plugins :: [Neovim () NeovimPlugin]+ , -- | Set the general logging options.+ logOptions :: Maybe (FilePath, Priority) }-
library/Neovim/Context.hs view
@@ -23,6 +23,8 @@ errOnInvalidResult, restart, quit,+ subscribe,+ unsubscribe, ask, asks,@@ -46,7 +48,7 @@ import Neovim.Classes import Neovim.Context.Internal (FunctionMap, FunctionMapEntry, Neovim, mkFunctionMap,- newUniqueFunctionName, runNeovim)+ newUniqueFunctionName, runNeovim, subscribe, unsubscribe) import Neovim.Exceptions (NeovimException (..), exceptionToDoc) import qualified Neovim.Context.Internal as Internal
library/Neovim/Context/Internal.hs view
@@ -1,10 +1,9 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses #-}+ {- | Module : Neovim.Context.Internal Description : Abstract description of the plugin provider's internal context@@ -17,115 +16,115 @@ To shorten function and data type names, import this qualfied as @Internal@. -}-module Neovim.Context.Internal- where+module Neovim.Context.Internal where -import Neovim.Classes-import Neovim.Exceptions (NeovimException (..),- exceptionToDoc)-import Neovim.Plugin.Classes-import Neovim.Plugin.IPC (SomeMessage)+import Neovim.Classes+import Neovim.Exceptions (+ NeovimException (..),+ exceptionToDoc,+ )+import Neovim.Plugin.Classes+import Neovim.Plugin.IPC (SomeMessage) -import Control.Applicative-import Control.Exception (ArithException,- ArrayException,- ErrorCall,- PatternMatchFail)-import Control.Monad.Except-import Control.Monad.Reader-import Control.Monad.Trans.Resource-import qualified Data.ByteString.UTF8 as U (fromString)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.MessagePack (Object)-import Data.Monoid (Ap(Ap))-import System.Log.Logger-import UnliftIO+import Control.Applicative+import Control.Exception (+ ArithException,+ ArrayException,+ ErrorCall,+ PatternMatchFail,+ )+import Control.Monad.Except+import Control.Monad.Reader+import Control.Monad.Trans.Resource+import qualified Data.ByteString.UTF8 as U (fromString)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.MessagePack (Object)+import Data.Monoid (Ap (Ap))+import Data.Text (Text)+import System.Log.Logger+import UnliftIO -import Data.Text.Prettyprint.Doc (viaShow)+import Prettyprinter (viaShow) import qualified Control.Monad.Fail as Fail-import Prelude+import Prelude +{- | This is the environment in which all plugins are initially started. --- | 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.+ 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.+-} newtype Neovim env a = Neovim- { unNeovim :: ResourceT (ReaderT (Config env) IO) a }-- deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)- deriving (Semigroup, Monoid) via (Ap (Neovim env) a)-+ {unNeovim :: ResourceT (ReaderT (Config env) IO) a}+ deriving newtype (Functor, Applicative, Monad, MonadIO, MonadThrow, MonadUnliftIO)+ deriving (Semigroup, Monoid) via (Ap (Neovim env) a) -- | User facing instance declaration for the reader state. instance MonadReader env (Neovim env) where ask = Neovim $ asks customConfig local f (Neovim a) = do r <- Neovim ask- liftIO $ runReaderT (runResourceT a)- (r { customConfig = f (customConfig r)})-+ liftIO $+ runReaderT+ (runResourceT a)+ (r{customConfig = f (customConfig r)}) instance MonadResource (Neovim env) where liftResourceT m = Neovim $ liftResourceT m - instance Fail.MonadFail (Neovim env) where- fail = throwIO . ErrorMessage . pretty-+ fail = throwIO . ErrorMessage . pretty -- | Same as 'ask' for the 'InternalConfig'. ask' :: Neovim env (Config env) ask' = Neovim ask - -- | Same as 'asks' for the 'InternalConfig'. asks' :: (Config env -> a) -> Neovim env a asks' = Neovim . asks - exceptionHandlers :: [Handler IO (Either (Doc ann) a)] exceptionHandlers =- [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)"- , Handler $ \(_ :: ArrayException) -> ret "ArrayException"- , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error"+ [ Handler $ \(_ :: ArithException) -> ret "ArithException (e.g. division by 0)"+ , Handler $ \(_ :: ArrayException) -> ret "ArrayException"+ , Handler $ \(_ :: ErrorCall) -> ret "ErrorCall (e.g. call of undefined or error" , Handler $ \(_ :: PatternMatchFail) -> ret "Pattern match failure"- , Handler $ \(_ :: SomeException) -> ret "Unhandled exception"+ , Handler $ \(_ :: SomeException) -> ret "Unhandled exception" ] where ret = return . Left -- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.-runNeovim :: NFData a- => Config env- -> Neovim env a- -> IO (Either (Doc AnsiStyle) a)+runNeovim ::+ NFData a =>+ Config env ->+ Neovim env a ->+ IO (Either (Doc AnsiStyle) a) runNeovim = runNeovimInternal (\a -> a `deepseq` return a) -runNeovimInternal :: (a -> IO a)- -> Config env- -> Neovim env a- -> IO (Either (Doc AnsiStyle) a)+runNeovimInternal ::+ (a -> IO a) ->+ Config env ->+ Neovim env a ->+ IO (Either (Doc AnsiStyle) a) runNeovimInternal f r (Neovim a) = (try . runReaderT (runResourceT a)) r >>= \case Left e -> case fromException e of Just e' -> return . Left . exceptionToDoc $ (e' :: NeovimException)- Nothing -> do liftIO . errorM "Context" $ "Converting Exception to Error message: " ++ show e (return . Left . viaShow) e Right res -> (Right <$> f res) `catches` exceptionHandlers ---- | Create a new unique function name. To prevent possible name clashes, digits--- are stripped from the given suffix.+{- | Create a new unique function name. To prevent possible name clashes, digits+ are stripped from the given suffix.+-} newUniqueFunctionName :: Neovim env FunctionName newUniqueFunctionName = do tu <- asks' uniqueCounter@@ -136,140 +135,178 @@ modifyTVar' tu succ return u ---- | This data type is used to dispatch a remote function call to the appopriate--- recipient.-newtype FunctionType = Stateful (TQueue SomeMessage)- -- ^ 'Stateful' functions are handled within a special thread, the 'TQueue'- -- is the communication endpoint for the arguments we have to pass.-+{- | This data type is used to dispatch a remote function call to the appopriate+ recipient.+-}+newtype FunctionType+ = -- | 'Stateful' functions are handled within a special thread, the 'TQueue'+ -- is the communication endpoint for the arguments we have to pass.+ Stateful (TQueue SomeMessage) instance Pretty FunctionType where pretty = \case- Stateful _ -> "\\os -> Neovim env o"-+ Stateful _ -> "\\os -> Neovim env o" -- | Type of the values stored in the function map. type FunctionMapEntry = (FunctionalityDescription, FunctionType) +{- | A function map is a map containing the names of functions as keys and some+ context dependent value which contains all the necessary information to+ execute that function in the intended way. --- | A function map is a map containing the names of functions as keys and some--- context dependent value which contains all the necessary information to--- execute that function in the intended way.------ This type is only used internally and handles two distinct cases. One case--- is a direct function call, wich is simply a function that accepts a list of--- 'Object' values and returns a result in the 'Neovim' context. The second--- case is calling a function that has a persistent state. This is mediated to--- a thread that reads from a 'TQueue'. (NB: persistent currently means, that--- state is stored for as long as the plugin provider is running and not--- restarted.)+ This type is only used internally and handles two distinct cases. One case+ is a direct function call, wich is simply a function that accepts a list of+ 'Object' values and returns a result in the 'Neovim' context. The second+ case is calling a function that has a persistent state. This is mediated to+ a thread that reads from a 'TQueue'. (NB: persistent currently means, that+ state is stored for as long as the plugin provider is running and not+ restarted.)+-} type FunctionMap = Map NvimMethod FunctionMapEntry - -- | Create a new function map from the given list of 'FunctionMapEntry' values. mkFunctionMap :: [FunctionMapEntry] -> FunctionMap mkFunctionMap = Map.fromList . map (\e -> (nvimMethod (fst e), e)) ---- | A wrapper for a reader value that contains extra fields required to--- communicate with the messagepack-rpc components and provide necessary data to--- provide other globally available operations.------ Note that you most probably do not want to change the fields prefixed with an--- underscore.-data Config env = Config- -- Global settings; initialized once- { eventQueue :: TQueue SomeMessage- -- ^ A queue of messages that the event handler will propagate to- -- appropriate threads and handlers.-- , transitionTo :: MVar StateTransition- -- ^ The main thread will wait for this 'MVar' to be filled with a value- -- and then perform an action appropriate for the value of type- -- 'StateTransition'.+data Subscriptions = Subscriptions+ { nextSubscriptionId :: SubscriptionId+ , byEventId :: Map NeovimEventId [Subscription]+ } - , providerName :: TMVar (Either String Int)- -- ^ Since nvim-hs must have its "Neovim.RPC.SocketReader" and- -- "Neovim.RPC.EventHandler" running to determine the actual channel id- -- (i.e. the 'Int' value here) this field can only be set properly later.- -- Hence, the value of this field is put in an 'TMVar'.- -- Name that is used to identify this provider. Assigning such a name is- -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).+{- | Subscribe to an event. When the event is received, the given callback function+ is run. It is usually necessary to call the appropriate API function in order for+ /neovim/ to send the notifications to /nvim-hs/. The returned subscription can be+ used to 'unsubscribe'.+-}+subscribe :: Text -> ([Object] -> Neovim env ()) -> Neovim env Subscription+subscribe event action = do+ let eventId = NeovimEventId event+ cfg <- ask'+ let subscriptions' = subscriptions cfg+ atomically $ do+ s <- takeTMVar subscriptions'+ let subscriptionId = nextSubscriptionId s+ let newSubscription =+ Subscription+ { subId = subscriptionId+ , subEventId = eventId+ , subAction = void . runNeovim cfg . action+ }+ putTMVar+ subscriptions'+ s+ { nextSubscriptionId = succ subscriptionId+ , byEventId = Map.insertWith (<>) eventId [newSubscription] (byEventId s)+ }+ pure newSubscription - , uniqueCounter :: TVar Integer- -- ^ This 'TVar' is used to generate uniqe function names on the side of- -- /nvim-hs/. This is useful if you don't want to overwrite existing- -- functions or if you create autocmd functions.+-- | Remove the subscription that has been returned by 'subscribe'.+unsubscribe :: Subscription -> Neovim env ()+unsubscribe subscription = do+ subscriptions' <- asks' subscriptions+ void . atomically $ do+ s <- takeTMVar subscriptions'+ let eventId = subEventId subscription+ deleteSubscription = Just . filter ((/= subId subscription) . subId)+ putTMVar+ subscriptions'+ s+ { byEventId = Map.update deleteSubscription eventId (byEventId s)+ } - , globalFunctionMap :: TMVar FunctionMap- -- ^ This map is used to dispatch received messagepack function calls to- -- it's appropriate targets.+{- | A wrapper for a reader value that contains extra fields required to+ communicate with the messagepack-rpc components and provide necessary data to+ provide other globally available operations. - -- Local settings; intialized for each stateful component- , pluginSettings :: Maybe (PluginSettings env)- -- ^ In a registered functionality this field contains a function (and- -- possibly some context dependent values) to register new functionality.+ Note that you most probably do not want to change the fields prefixed with an+ underscore.+-}+data Config env = Config+ -- Global settings; initialized once+ { -- | A queue of messages that the event handler will propagate to+ -- appropriate threads and handlers.+ eventQueue :: TQueue SomeMessage+ , -- | The main thread will wait for this 'MVar' to be filled with a value+ -- and then perform an action appropriate for the value of type+ -- 'StateTransition'.+ transitionTo :: MVar StateTransition+ , -- | Since nvim-hs must have its "Neovim.RPC.SocketReader" and+ -- "Neovim.RPC.EventHandler" running to determine the actual channel id+ -- (i.e. the 'Int' value here) this field can only be set properly later.+ -- Hence, the value of this field is put in an 'TMVar'.+ -- Name that is used to identify this provider. Assigning such a name is+ -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).+ providerName :: TMVar (Either String Int)+ , -- | This 'TVar' is used to generate uniqe function names on the side of+ -- /nvim-hs/. This is useful if you don't want to overwrite existing+ -- functions or if you create autocmd functions.+ uniqueCounter :: TVar Integer+ , -- | This map is used to dispatch received messagepack function calls to+ -- it's appropriate targets.+ globalFunctionMap :: TMVar FunctionMap+ , -- Local settings; intialized for each stateful component - , customConfig :: env- -- ^ Plugin author supplyable custom configuration. Queried on the- -- user-facing side with 'ask' or 'asks'.+ -- | In a registered functionality this field contains a function (and+ -- possibly some context dependent values) to register new functionality.+ pluginSettings :: Maybe (PluginSettings env)+ , -- | Plugins can dynamically subscribe to events that neovim sends.+ subscriptions :: TMVar Subscriptions+ , -- | Plugin author supplyable custom configuration. Queried on the+ -- user-facing side with 'ask' or 'asks'.+ customConfig :: env } +{- | Convenient helper to create a new config for the given state and read-only+ config. --- | Convenient helper to create a new config for the given state and read-only--- config.------ Sets the 'pluginSettings' field to 'Nothing'.+ Sets the 'pluginSettings' field to 'Nothing'.+-} retypeConfig :: env -> Config anotherEnv -> Config env-retypeConfig r cfg = cfg { pluginSettings = Nothing, customConfig = r }-+retypeConfig r cfg = cfg{pluginSettings = Nothing, customConfig = r} --- | This GADT is used to share information between stateless and stateful--- plugin threads since they work fundamentally in the same way. They both--- contain a function to register some functionality in the plugin provider--- as well as some values which are specific to the one or the other context.+{- | This GADT is used to share information between stateless and stateful+ plugin threads since they work fundamentally in the same way. They both+ contain a function to register some functionality in the plugin provider+ as well as some values which are specific to the one or the other context.+-} data PluginSettings env where- StatefulSettings- :: (FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env (Maybe FunctionMapEntry))- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> PluginSettings env+ StatefulSettings ::+ ( FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ Neovim env (Maybe FunctionMapEntry)+ ) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ PluginSettings env +{- | Create a new 'InternalConfig' object by providing the minimal amount of+ necessary information. --- | Create a new 'InternalConfig' object by providing the minimal amount of--- necessary information.------ This function should only be called once per /nvim-hs/ session since the--- arguments are shared across processes.+ This function should only be called once per /nvim-hs/ session since the+ arguments are shared across processes.+-} newConfig :: IO (Maybe String) -> IO env -> IO (Config env)-newConfig ioProviderName r = Config- <$> newTQueueIO- <*> newEmptyMVar- <*> (maybe (atomically newEmptyTMVar) (newTMVarIO . Left) =<< ioProviderName)- <*> newTVarIO 100- <*> atomically newEmptyTMVar- <*> pure Nothing- <*> r-+newConfig ioProviderName r =+ Config+ <$> newTQueueIO+ <*> newEmptyMVar+ <*> (maybe newEmptyTMVarIO (newTMVarIO . Left) =<< ioProviderName)+ <*> newTVarIO 100+ <*> newEmptyTMVarIO+ <*> pure Nothing+ <*> newTMVarIO (Subscriptions (SubscriptionId 1) mempty)+ <*> r -- | The state that the plugin provider wants to transition to. data StateTransition- = Quit- -- ^ Quit the plugin provider.-- | Restart- -- ^ Restart the plugin provider.-- | Failure (Doc AnsiStyle)- -- ^ The plugin provider failed to start or some other error occured.-- | InitSuccess- -- ^ The plugin provider started successfully.-+ = -- | Quit the plugin provider.+ Quit+ | -- | Restart the plugin provider.+ Restart+ | -- | The plugin provider failed to start or some other error occured.+ Failure (Doc AnsiStyle)+ | -- | The plugin provider started successfully.+ InitSuccess deriving (Show)-
library/Neovim/Debug.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE NamedFieldPuns #-}+ {- | Module : Neovim.Debug Description : Utilities to debug Neovim and nvim-hs functionality@@ -8,204 +9,219 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Debug ( debug, debug',-- NvimHSDebugInstance(..),+ NvimHSDebugInstance (..), develMain, quitDevelMain, restartDevelMain,- printGlobalFunctionMap,- runNeovim, runNeovim', module Neovim,- ) where+) where -import Neovim-import Neovim.Classes-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+import Neovim.Classes+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.Monad-import qualified Data.Map as Map-import Foreign.Store+import Control.Monad+import qualified Data.Map as Map+import Foreign.Store -import UnliftIO.Async (Async, async,- cancel)-import UnliftIO.Concurrent (putMVar, takeMVar)-import UnliftIO.STM+import UnliftIO.Async (+ Async,+ async,+ cancel,+ )+import UnliftIO.Concurrent (putMVar, takeMVar)+import UnliftIO.STM -import Data.Text.Prettyprint.Doc (nest, softline,- vcat, vsep)+import Prettyprinter (+ nest,+ softline,+ vcat,+ vsep,+ ) -import Prelude+import Prelude +{- | Run a 'Neovim' function. --- | Run a 'Neovim' function.------ This function connects to the socket pointed to by the environment variable--- @$NVIM@ and executes the command. It does not register itself--- as a real plugin provider, you can simply call neovim-functions from the--- module "Neovim.API.String" this way.------ Tip: If you run a terminal inside a neovim instance, then this variable is--- automatically set.+ This function connects to the socket pointed to by the environment variable+ @$NVIM@ and executes the command. It does not register itself+ as a real plugin provider, you can simply call neovim-functions from the+ module "Neovim.API.String" this way.++ Tip: If you run a terminal inside a neovim instance, then this variable is+ automatically set.+-} debug :: env -> Internal.Neovim env a -> IO (Either (Doc AnsiStyle) a) debug env a = disableLogger $ do- runPluginProvider def { envVar = True } Nothing transitionHandler+ runPluginProvider def{envVar = True} Nothing transitionHandler where- transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case- Internal.Failure e ->- return $ Left e-- Internal.InitSuccess -> do- res <- Internal.runNeovimInternal- return- (cfg { Internal.customConfig = env, Internal.pluginSettings = Nothing })- a+ transitionHandler tids cfg =+ takeMVar (Internal.transitionTo cfg) >>= \case+ Internal.Failure e ->+ return $ Left e+ Internal.InitSuccess -> do+ res <-+ Internal.runNeovimInternal+ return+ (cfg{Internal.customConfig = env, Internal.pluginSettings = Nothing})+ a - mapM_ cancel tids- return res+ mapM_ cancel tids+ return res+ _ ->+ return . Left $ "Unexpected transition state." - _ ->- return . Left $ "Unexpected transition state."+{- | Run a 'Neovim'' function. + @+ debug' = debug ()+ @ --- | Run a 'Neovim'' function.------ @--- debug' = debug ()--- @------ See documentation for 'debug'.+ See documentation for 'debug'.+-} debug' :: Internal.Neovim () a -> IO (Either (Doc AnsiStyle) a) debug' = debug () --- | Simple datatype storing neccessary information to start, stop and reload a--- set of plugins. This is passed to most of the functions in this module for--- storing state even when the ghci-session has been reloaded.+{- | Simple datatype storing neccessary information to start, stop and reload a+ set of plugins. This is passed to most of the functions in this module for+ storing state even when the ghci-session has been reloaded.+-} data NvimHSDebugInstance = NvimHSDebugInstance- { threads :: [Async ()]- , neovimConfig :: NeovimConfig- , internalConfig :: Internal.Config RPCConfig- }+ { threads :: [Async ()]+ , neovimConfig :: NeovimConfig+ , internalConfig :: Internal.Config RPCConfig+ } --- | This function is intended to be run _once_ in a ghci session that to--- give a REPL based workflow when developing a plugin.------ Note that the dyre-based reload mechanisms, i.e. the--- "Neovim.Plugin.ConfigHelper" plugin, is not started this way.------ To use this in ghci, you simply bind the results to some variables. After--- each reload of ghci, you have to rebind those variables.------ Example:------ @--- λ di <- 'develMain' 'Nothing'------ λ 'runNeovim'' di \$ vim_call_function \"getqflist\" []--- 'Right' ('Right' ('ObjectArray' []))------ λ :r------ λ di <- 'develMain' 'Nothing'--- @------ You can also create a GHCI alias to get rid of most the busy-work:--- @--- :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\"--- @----develMain- :: NeovimConfig- -> IO (Maybe NvimHSDebugInstance)-develMain neovimConfig = lookupStore 0 >>= \case- Nothing -> do- x <- disableLogger $ runPluginProvider- def{ envVar = True }- (Just neovimConfig)- transitionHandler- void $ newStore x- return x+{- | This function is intended to be run _once_ in a ghci session that to+ give a REPL based workflow when developing a plugin. - Just x ->- readStore x- where- transitionHandler tids cfg = takeMVar (Internal.transitionTo cfg) >>= \case- Internal.Failure e -> do- putDoc e- return Nothing+ Note that the dyre-based reload mechanisms, i.e. the+ "Neovim.Plugin.ConfigHelper" plugin, is not started this way. - Internal.InitSuccess -> do- transitionHandlerThread <- async $ do- void $ transitionHandler (tids) cfg- return . Just $ NvimHSDebugInstance- { threads = (transitionHandlerThread:tids)- , neovimConfig = neovimConfig- , internalConfig = cfg- }+ To use this in ghci, you simply bind the results to some variables. After+ each reload of ghci, you have to rebind those variables. - Internal.Quit -> do- lookupStore 0 >>= \case- Nothing ->- return ()+ Example: - Just x ->- deleteStore x+ @+ λ di <- 'develMain' 'Nothing' - mapM_ cancel tids- putStrLn "Quit develMain"- return Nothing+ λ 'runNeovim'' di \$ vim_call_function \"getqflist\" []+ 'Right' ('Right' ('ObjectArray' [])) - _ -> do- putStrLn $ "Unexpected transition state for develMain."- return Nothing+ λ :r + λ di <- 'develMain' 'Nothing'+ @ + You can also create a GHCI alias to get rid of most the busy-work:+ @+ :def! x \\_ -> return \":reload\\nJust di <- develMain 'defaultConfig'{ 'plugins' = [ myDebugPlugin ] }\"+ @+-}+develMain ::+ NeovimConfig ->+ IO (Maybe NvimHSDebugInstance)+develMain neovimConfig =+ lookupStore 0 >>= \case+ Nothing -> do+ x <-+ disableLogger $+ runPluginProvider+ def{envVar = True}+ (Just neovimConfig)+ transitionHandler+ void $ newStore x+ return x+ Just x ->+ readStore x+ where+ transitionHandler tids cfg =+ takeMVar (Internal.transitionTo cfg) >>= \case+ Internal.Failure e -> do+ putDoc e+ return Nothing+ Internal.InitSuccess -> do+ transitionHandlerThread <- async $ do+ void $ transitionHandler (tids) cfg+ return . Just $+ NvimHSDebugInstance+ { threads = (transitionHandlerThread : tids)+ , neovimConfig = neovimConfig+ , internalConfig = cfg+ }+ Internal.Quit -> do+ lookupStore 0 >>= \case+ Nothing ->+ return ()+ Just x ->+ deleteStore x++ mapM_ cancel tids+ putStrLn "Quit develMain"+ return Nothing+ _ -> do+ putStrLn $ "Unexpected transition state for develMain."+ return Nothing+ -- | Quit a previously started plugin provider. quitDevelMain :: NvimHSDebugInstance -> IO () quitDevelMain NvimHSDebugInstance{internalConfig} =- putMVar (Internal.transitionTo internalConfig) Internal.Quit-+ putMVar (Internal.transitionTo internalConfig) Internal.Quit -- | Restart the development plugin provider.-restartDevelMain- :: NvimHSDebugInstance- -> IO (Maybe NvimHSDebugInstance)+restartDevelMain ::+ NvimHSDebugInstance ->+ IO (Maybe NvimHSDebugInstance) restartDevelMain di = do quitDevelMain di develMain (neovimConfig di) - -- | Convenience function to run a stateless 'Neovim' function.-runNeovim' :: NFData a- => NvimHSDebugInstance -> Neovim () a -> IO (Either (Doc AnsiStyle) a)+runNeovim' ::+ NFData a =>+ NvimHSDebugInstance ->+ Neovim () a ->+ IO (Either (Doc AnsiStyle) a) runNeovim' NvimHSDebugInstance{internalConfig} = runNeovim (Internal.retypeConfig () (internalConfig)) - -- | Print the global function map to the console. printGlobalFunctionMap :: NvimHSDebugInstance -> IO () printGlobalFunctionMap NvimHSDebugInstance{internalConfig} = do- es <- fmap Map.toList . atomically $+ es <-+ fmap Map.toList . atomically $ readTMVar (Internal.globalFunctionMap internalConfig) let header = "Printing global function map:"- funs = map (\(fname, (d, f)) ->- nest 3 (pretty fname- <> softline <> "->"- <> softline <> pretty d <+> ":"- <+> pretty f)) es+ funs =+ map+ ( \(fname, (d, f)) ->+ nest+ 3+ ( pretty fname+ <> softline+ <> "->"+ <> softline+ <> pretty d+ <+> ":"+ <+> pretty f+ )+ )+ es putDoc $- nest 2 $ vsep [header, vcat funs, mempty]--+ nest 2 $+ vsep [header, vcat funs, mempty]
library/Neovim/Exceptions.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+ {- | Module : Neovim.Exceptions Description : General Exceptions@@ -8,45 +9,40 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -}-module Neovim.Exceptions- ( NeovimException(..)- , exceptionToDoc- , catchNeovimException- ) where+module Neovim.Exceptions (+ NeovimException (..),+ exceptionToDoc,+ catchNeovimException,+) where -import Control.Exception (Exception)-import Data.MessagePack (Object (..))-import Data.String (IsString (..))-import Data.Text.Prettyprint.Doc (Doc, (<+>), viaShow)-import Data.Text.Prettyprint.Doc.Render.Terminal (AnsiStyle)-import Data.Typeable (Typeable)-import UnliftIO (MonadUnliftIO, catch)+import Control.Exception (Exception)+import Data.MessagePack (Object (..))+import Data.String (IsString (..))+import Data.Typeable (Typeable)+import Prettyprinter (Doc, viaShow, (<+>))+import Prettyprinter.Render.Terminal (AnsiStyle)+import UnliftIO (MonadUnliftIO, catch) -- | Exceptions specific to /nvim-hs/. data NeovimException- = ErrorMessage (Doc AnsiStyle)- -- ^ Simple error message that is passed to neovim. It should currently only- -- contain one line of text.- | ErrorResult (Doc AnsiStyle) Object- -- ^ Error that can be returned by a remote API call. The 'Doc' argument is- -- the name of the remote function that threw this exception.+ = -- | Simple error message that is passed to neovim. It should currently only+ -- contain one line of text.+ ErrorMessage (Doc AnsiStyle)+ | -- | Error that can be returned by a remote API call. The 'Doc' argument is+ -- the name of the remote function that threw this exception.+ ErrorResult (Doc AnsiStyle) Object deriving (Typeable, Show) - instance Exception NeovimException - instance IsString NeovimException where fromString = ErrorMessage . fromString - exceptionToDoc :: NeovimException -> Doc AnsiStyle exceptionToDoc = \case ErrorMessage e -> "Error message:" <+> e- ErrorResult fn o -> "Function" <+> fn <+> "has thrown an error:" <+> viaShow o
library/Neovim/Log.hs view
@@ -7,20 +7,18 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Log ( disableLogger, withLogger,- module System.Log.Logger,- ) where+) where -import Control.Exception-import System.Log.Formatter (simpleLogFormatter)-import System.Log.Handler (setFormatter)-import System.Log.Handler.Simple-import System.Log.Logger+import Control.Exception+import System.Log.Formatter (simpleLogFormatter)+import System.Log.Handler (setFormatter)+import System.Log.Handler.Simple+import System.Log.Logger -- | Disable logging to stderr. disableLogger :: IO a -> IO a@@ -28,19 +26,21 @@ updateGlobalLogger rootLoggerName removeHandler action --- | Initialize the root logger to avoid stderr and set it to log the given--- file instead. Simply wrap the main entry point with this function to--- initialze the logger.------ @--- main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do--- 'putStrLn' "Hello, World!"--- @+{- | Initialize the root logger to avoid stderr and set it to log the given+ file instead. Simply wrap the main entry point with this function to+ initialze the logger.++ @+ main = 'withLogger' "\/home\/dude\/nvim.log" 'Debug' \$ do+ 'putStrLn' "Hello, World!"+ @+-} withLogger :: FilePath -> Priority -> IO a -> IO a-withLogger fp p action = bracket- setupRootLogger- (\fh -> closeFunc fh (privData fh))- (const action)+withLogger fp p action =+ bracket+ setupRootLogger+ (\fh -> closeFunc fh (privData fh))+ (const action) where setupRootLogger = do -- We shouldn't log to stderr or stdout as it is not unlikely that our@@ -56,5 +56,3 @@ logM "Neovim.Debug" DEBUG $ unwords ["Initialized root looger with priority", show p, "and file: ", fp] return fh'--
library/Neovim/Main.hs view
@@ -6,167 +6,183 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -}-module Neovim.Main- where+module Neovim.Main where -import Neovim.Config+import Neovim.Config import qualified Neovim.Context.Internal as Internal-import Neovim.Log-import qualified Neovim.Plugin as P-import Neovim.RPC.Common as RPC-import Neovim.RPC.EventHandler-import Neovim.RPC.SocketReader-import Neovim.Util (oneLineErrorMessage)+import Neovim.Log+import qualified Neovim.Plugin as P+import Neovim.RPC.Common as RPC+import Neovim.RPC.EventHandler+import Neovim.RPC.SocketReader+import Neovim.Util (oneLineErrorMessage) -import Control.Concurrent-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 UnliftIO.Async (Async, async)+import Control.Concurrent+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 UnliftIO.Async (Async, async) import Prelude - logger :: String logger = "Neovim.Main" --data CommandLineOptions =- Opt { providerName :: Maybe String- , hostPort :: Maybe (String, Int)- , unix :: Maybe FilePath- , envVar :: Bool- , logOpts :: Maybe (FilePath, Priority)- }-+data CommandLineOptions = Opt+ { providerName :: Maybe String+ , hostPort :: Maybe (String, Int)+ , unix :: Maybe FilePath+ , envVar :: Bool+ , logOpts :: Maybe (FilePath, Priority)+ } instance Default CommandLineOptions where- def = Opt+ def =+ Opt { providerName = Nothing- , hostPort = Nothing- , unix = Nothing- , envVar = False- , logOpts = Nothing+ , hostPort = Nothing+ , unix = Nothing+ , envVar = False+ , logOpts = Nothing } - optParser :: Parser CommandLineOptions-optParser = Opt- <$> optional (strArgument- (metavar "NAME"- <> help (unlines- [ "Name that associates the plugin provider with neovim."- , "This option has only an effect if you start nvim-hs"- , "with rpcstart()/jobstart() and use the factory method approach."- , "Since it is extremely hard to figure that out inside"- , "nvim-hs, this option is assumed to used if the input"- , "and output is tied to standard in and standard out."- ])))- <*> optional ((,)- <$> strOption- (long "host"- <> short 'a'- <> metavar "HOSTNAME"- <> help "Connect to the specified host. (requires -p)")- <*> option auto- (long "port"- <> short 'p'- <> metavar "PORT"- <> help "Connect to the specified port. (requires -a)"))- <*> optional (strOption- (long "unix"- <> short 'u'- <> help "Connect to the given unix domain socket."))- <*> switch- ( long "environment"- <> short 'e'- <> help "Read connection information from $NVIM.")- <*> optional ((,)- <$> strOption- (long "log-file"- <> short 'l'- <> help "File to log to.")- <*> option auto- (long "log-level"- <> short 'v'- <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels)))+optParser =+ Opt+ <$> optional+ ( strArgument+ ( metavar "NAME"+ <> help+ ( unlines+ [ "Name that associates the plugin provider with neovim."+ , "This option has only an effect if you start nvim-hs"+ , "with rpcstart()/jobstart() and use the factory method approach."+ , "Since it is extremely hard to figure that out inside"+ , "nvim-hs, this option is assumed to used if the input"+ , "and output is tied to standard in and standard out."+ ]+ )+ )+ )+ <*> optional+ ( (,)+ <$> strOption+ ( long "host"+ <> short 'a'+ <> metavar "HOSTNAME"+ <> help "Connect to the specified host. (requires -p)"+ )+ <*> option+ auto+ ( long "port"+ <> short 'p'+ <> metavar "PORT"+ <> help "Connect to the specified port. (requires -a)"+ )+ )+ <*> optional+ ( strOption+ ( long "unix"+ <> short 'u'+ <> help "Connect to the given unix domain socket."+ )+ )+ <*> switch+ ( long "environment"+ <> short 'e'+ <> help "Read connection information from $NVIM."+ )+ <*> optional+ ( (,)+ <$> strOption+ ( long "log-file"+ <> short 'l'+ <> help "File to log to."+ )+ <*> option+ auto+ ( long "log-level"+ <> short 'v'+ <> help ("Log level. Must be one of: " ++ (unwords . map show) logLevels)+ )+ ) where -- [minBound..maxBound] would have been nice here. logLevels :: [Priority]- logLevels = [ DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY ]-+ logLevels = [DEBUG, INFO, NOTICE, WARNING, ERROR, CRITICAL, ALERT, EMERGENCY] opts :: ParserInfo CommandLineOptions-opts = info (helper <*> optParser)- (fullDesc- <> header "Start a neovim plugin provider for Haskell plugins."- <> progDesc "This is still work in progress. Feel free to contribute.")-+opts =+ info+ (helper <*> optParser)+ ( fullDesc+ <> header "Start a neovim plugin provider for Haskell plugins."+ <> progDesc "This is still work in progress. Feel free to contribute."+ ) --- | This is essentially the main function for /nvim-hs/, at least if you want--- to use "Config.Dyre" for the configuration.+{- | This is essentially the main function for /nvim-hs/, at least if you want+ to use "Config.Dyre" for the configuration.+-} neovim :: NeovimConfig -> IO () neovim = realMain standalone ---- | A 'TransitionHandler' function receives the 'ThreadId's of all running--- threads which have been started by the plugin provider as well as the--- 'Internal.Config' with the custom field set to 'RPCConfig'. These information--- can be used to properly clean up a session and then do something else.--- The transition handler is first called after the plugin provider has started.+{- | A 'TransitionHandler' function receives the 'ThreadId's of all running+ threads which have been started by the plugin provider as well as the+ 'Internal.Config' with the custom field set to 'RPCConfig'. These information+ can be used to properly clean up a session and then do something else.+ The transition handler is first called after the plugin provider has started.+-} type TransitionHandler a = [Async ()] -> Internal.Config RPCConfig -> IO a ---- | This main functions can be used to create a custom executable without--- using the "Config.Dyre" library while still using the /nvim-hs/ specific--- configuration facilities.-realMain :: TransitionHandler a- -> NeovimConfig- -> IO ()+{- | This main functions can be used to create a custom executable without+ using the "Config.Dyre" library while still using the /nvim-hs/ specific+ configuration facilities.+-}+realMain ::+ TransitionHandler a ->+ NeovimConfig ->+ IO () realMain transitionHandler cfg = do os <- execParser opts maybe disableLogger (uncurry withLogger) (logOpts os <|> logOptions cfg) $ do debugM logger "Starting up neovim haskell plguin provider" void $ runPluginProvider os (Just cfg) transitionHandler - -- | Generic main function. Most arguments are optional or have sane defaults.-runPluginProvider- :: CommandLineOptions -- ^ See /nvim-hs/ executables --help function or 'optParser'- -> Maybe NeovimConfig- -> TransitionHandler a- -> IO a+runPluginProvider ::+ -- | See /nvim-hs/ executables --help function or 'optParser'+ CommandLineOptions ->+ Maybe NeovimConfig ->+ TransitionHandler a ->+ IO a runPluginProvider os mcfg transitionHandler = case (hostPort os, unix os) of- (Just (h,p), _) ->+ (Just (h, p), _) -> createHandle (TCP p h) >>= \s -> run s s- (_, Just fp) -> createHandle (UnixSocket fp) >>= \s -> run s s-- _ | envVar os ->- createHandle Environment >>= \s -> run s s-+ _+ | envVar os ->+ createHandle Environment >>= \s -> run s s _ -> run stdout stdin- where run evHandlerHandle sockreaderHandle = do- -- The plugins to register depend on the given arguments and may need -- special initialization methods. let allPlugins = maybe [] plugins mcfg conf <- Internal.newConfig (pure (providerName os)) newRPCConfig - ehTid <- async $ runEventHandler- evHandlerHandle- conf { Internal.pluginSettings = Nothing }+ ehTid <-+ async $+ runEventHandler+ evHandlerHandle+ conf{Internal.pluginSettings = Nothing} srTid <- async $ runSocketReader sockreaderHandle conf @@ -176,28 +192,24 @@ errorM logger $ "Error initializing plugins: " <> show (oneLineErrorMessage e) putMVar (Internal.transitionTo conf) $ Internal.Failure e transitionHandler [ehTid, srTid] conf- Right (funMapEntries, pluginTids) -> do- atomically $ putTMVar- (Internal.globalFunctionMap conf)- (Internal.mkFunctionMap funMapEntries)+ atomically $+ putTMVar+ (Internal.globalFunctionMap conf)+ (Internal.mkFunctionMap funMapEntries) putMVar (Internal.transitionTo conf) $ Internal.InitSuccess- transitionHandler (srTid:ehTid:pluginTids) conf-+ transitionHandler (srTid : ehTid : pluginTids) conf standalone :: TransitionHandler ()-standalone threads cfg = takeMVar (Internal.transitionTo cfg) >>= \case- Internal.InitSuccess -> do- debugM logger "Initialization Successful"- standalone threads cfg-- Internal.Restart -> do- errorM logger "Cannot restart"- standalone threads cfg-- Internal.Failure e ->- errorM logger . show $ oneLineErrorMessage e-- Internal.Quit ->- return ()-+standalone threads cfg =+ takeMVar (Internal.transitionTo cfg) >>= \case+ Internal.InitSuccess -> do+ debugM logger "Initialization Successful"+ standalone threads cfg+ Internal.Restart -> do+ errorM logger "Cannot restart"+ standalone threads cfg+ Internal.Failure e ->+ errorM logger . show $ oneLineErrorMessage e+ Internal.Quit ->+ return ()
library/Neovim/Plugin.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE GADTs #-}+ {- | Module : Neovim.Plugin Description : Plugin and functionality registration code@@ -9,83 +9,82 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -}- module Neovim.Plugin ( startPluginThreads, wrapPlugin, NeovimPlugin,- Plugin(..),- Synchronous(..),- CommandOption(..),-+ Plugin (..),+ Synchronous (..),+ CommandOption (..), addAutocmd,- registerPlugin,- ) where--import Neovim.API.String-import Neovim.Classes-import Neovim.Context-import Neovim.Context.Internal (FunctionType (..),- runNeovimInternal)-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes hiding (register)-import Neovim.Plugin.Internal-import Neovim.Plugin.IPC.Classes-import Neovim.RPC.FunctionCall+) where -import Control.Applicative-import Control.Monad (foldM, void)-import Control.Monad.Trans.Resource hiding (register)-import Data.ByteString (ByteString)-import Data.Foldable (forM_)-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Maybe (catMaybes)-import Data.MessagePack-import Data.Traversable (forM)-import System.Log.Logger-import UnliftIO.Async (Async, async, race)-import UnliftIO.Concurrent (threadDelay)-import UnliftIO.Exception (SomeException, try, catch)-import UnliftIO.STM+import Neovim.API.String+import Neovim.Classes+import Neovim.Context+import Neovim.Context.Internal (+ FunctionType (..),+ runNeovimInternal,+ )+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes hiding (register)+import Neovim.Plugin.IPC.Classes+import Neovim.Plugin.Internal+import Neovim.RPC.FunctionCall -import Prelude+import Control.Applicative+import Control.Monad (foldM, void)+import Control.Monad.Trans.Resource hiding (register)+import Data.ByteString (ByteString)+import Data.Foldable (forM_)+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Maybe (catMaybes)+import Data.MessagePack+import Data.Traversable (forM)+import System.Log.Logger+import UnliftIO.Async (Async, async, race)+import UnliftIO.Concurrent (threadDelay)+import UnliftIO.Exception (SomeException, catch, try)+import UnliftIO.STM +import Prelude logger :: String logger = "Neovim.Plugin" --startPluginThreads :: Internal.Config ()- -> [Neovim () NeovimPlugin]- -> IO (Either (Doc AnsiStyle) ([FunctionMapEntry],[Async ()]))+startPluginThreads ::+ Internal.Config () ->+ [Neovim () NeovimPlugin] ->+ IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()])) startPluginThreads cfg = runNeovimInternal return cfg . foldM go ([], []) where- go :: ([FunctionMapEntry], [Async ()])- -> Neovim () NeovimPlugin- -> Neovim () ([FunctionMapEntry], [Async ()])+ go ::+ ([FunctionMapEntry], [Async ()]) ->+ Neovim () NeovimPlugin ->+ Neovim () ([FunctionMapEntry], [Async ()]) go (es, tids) iop = do NeovimPlugin p <- iop (es', tid) <- registerStatefulFunctionality p - return $ (es ++ es', tid:tids)+ return (es ++ es', tid : tids) +{- | Callthe vimL functions to define a function, command or autocmd on the+ neovim side. Returns 'True' if registration was successful. --- | Callthe vimL functions to define a function, command or autocmd on the--- neovim side. Returns 'True' if registration was successful.------ Note that this does not have any effect on the side of /nvim-hs/.+ Note that this does not have any effect on the side of /nvim-hs/.+-} registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool registerWithNeovim = \case func@(Function (F functionName) s) -> do pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#FunctionOnHost", toObject n))- (\c -> ("remote#define#FunctionOnChannel", toObject c))- pName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#FunctionOnHost", toObject n))+ (\c -> ("remote#define#FunctionOnChannel", toObject c))+ pName reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register function: " ++ show functionName ++ show e@@ -96,22 +95,23 @@ return True flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: []- logSuccess-+ void $+ vim_call_function defineFunction $+ host +: nvimMethodName (nvimMethod func) +: s +: functionName +: (Map.empty :: Dictionary) +: []+ logSuccess cmd@(Command (F functionName) copts) -> do let sync = case getCommandOptions copts of- -- This works because CommandOptions are sorted and CmdSync is- -- the smallest element in the sorting- (CmdSync s:_) -> s- _ -> Sync+ -- This works because CommandOptions are sorted and CmdSync is+ -- the smallest element in the sorting+ (CmdSync s : _) -> s+ _ -> Sync pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#CommandOnHost", toObject n))- (\c -> ("remote#define#CommandOnChannel", toObject c))- pName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#CommandOnHost", toObject n))+ (\c -> ("remote#define#CommandOnChannel", toObject c))+ pName reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register command: " ++ show functionName ++ show e@@ -121,16 +121,17 @@ "Registered command: " ++ show functionName return True flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: []- logSuccess-+ void $+ vim_call_function defineFunction $+ host +: nvimMethodName (nvimMethod cmd) +: sync +: functionName +: copts +: []+ logSuccess Autocmd acmdType (F functionName) sync opts -> do pName <- getProviderName- let (defineFunction, host) = either- (\n -> ("remote#define#AutocmdOnHost", toObject n))- (\c -> ("remote#define#AutocmdOnChannel", toObject c))- pName+ let (defineFunction, host) =+ either+ (\n -> ("remote#define#AutocmdOnHost", toObject n))+ (\c -> ("remote#define#AutocmdOnChannel", toObject c))+ pName reportError (e :: NeovimException) = do liftIO . errorM logger $ "Failed to register autocmd: " ++ show functionName ++ show e@@ -140,68 +141,63 @@ "Registered autocmd: " ++ show functionName return True flip catch reportError $ do- void $ vim_call_function defineFunction $- host +: functionName +: sync +: acmdType +: opts +: []- logSuccess-+ void $+ vim_call_function defineFunction $+ host +: functionName +: sync +: acmdType +: opts +: []+ logSuccess --- | Return or retrive the provider name that the current instance is associated--- with on the neovim side.+{- | Return or retrive the provider name that the current instance is associated+ with on the neovim side.+-} getProviderName :: Neovim env (Either String Int) getProviderName = do mp <- Internal.asks' Internal.providerName (liftIO . atomically . tryReadTMVar) mp >>= \case Just p -> return p- Nothing -> do api <- nvim_get_api_info case api of [] -> err "empty nvim_get_api_info"- (i:_) -> do+ (i : _) -> do case fromObject i :: Either (Doc AnsiStyle) Int of- Left _ ->- err $ "Expected an integral value as the first"- <+> "argument of nvim_get_api_info"- Right channelId -> do- liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId- return . Right $ fromIntegral channelId---registerFunctionality :: FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))-registerFunctionality d f = Internal.asks' Internal.pluginSettings >>= \case- Nothing -> do- liftIO $ errorM logger "Cannot register functionality in this context."- return Nothing-- Just (Internal.StatefulSettings reg q m) ->- reg d f q m >>= \case- Just e -> do- -- Redefine fields so that it gains a new type- cfg <- Internal.retypeConfig () <$> Internal.ask'- rk <- fst <$> allocate (return ()) (free cfg (fst e))- return $ Just (e, Right rk)-- Nothing ->- return Nothing+ Left _ ->+ err $+ "Expected an integral value as the first"+ <+> "argument of nvim_get_api_info"+ Right channelId -> do+ liftIO . atomically . putTMVar mp . Right $ fromIntegral channelId+ return . Right $ fromIntegral channelId +registerFunctionality ::+ FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))+registerFunctionality d f =+ Internal.asks' Internal.pluginSettings >>= \case+ Nothing -> do+ liftIO $ errorM logger "Cannot register functionality in this context."+ return Nothing+ Just (Internal.StatefulSettings reg q m) ->+ reg d f q m >>= \case+ Just e -> do+ -- Redefine fields so that it gains a new type+ cfg <- Internal.retypeConfig () <$> Internal.ask'+ rk <- fst <$> allocate (return ()) (free cfg (fst e))+ return $ Just (e, Right rk)+ Nothing ->+ return Nothing where freeFun = \case Autocmd _ _ _ AutocmdOptions{} -> do liftIO $ warningM logger "Free not implemented for autocmds."- Command{} -> liftIO $ warningM logger "Free not implemented for commands."- Function{} -> liftIO $ warningM logger "Free not implemented for functions." - free cfg fd _ = void . runNeovimInternal return cfg $ freeFun fd - registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env () registerInGlobalFunctionMap e = do liftIO . debugM logger $ "Adding function to global function map." ++ show (fst e)@@ -211,123 +207,128 @@ putTMVar funMap $ Map.insert ((nvimMethod . fst) e) e m liftIO . debugM logger $ "Added function to global function map." ++ show (fst e) -registerPlugin- :: (FunctionMapEntry -> Neovim env ())- -> FunctionalityDescription- -> ([Object] -> Neovim env Object)- -> TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env (Maybe FunctionMapEntry)-registerPlugin reg d f q tm = registerWithNeovim d >>= \case- True -> do- let n = nvimMethod d- e = (d, Stateful q)- liftIO . atomically . modifyTVar tm $ Map.insert n f- reg e- return (Just e)-- False ->- return Nothing+registerPlugin ::+ (FunctionMapEntry -> Neovim env ()) ->+ FunctionalityDescription ->+ ([Object] -> Neovim env Object) ->+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ Neovim env (Maybe FunctionMapEntry)+registerPlugin reg d f q tm =+ registerWithNeovim d >>= \case+ True -> do+ let n = nvimMethod d+ e = (d, Stateful q)+ liftIO . atomically . modifyTVar tm $ Map.insert n f+ reg e+ return (Just e)+ False ->+ return Nothing +{- | 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. . --- | 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.----addAutocmd :: ByteString- -- ^ The event to register to (e.g. BufWritePost)- -> Synchronous- -> AutocmdOptions- -> (Neovim env ())- -- ^ Fully applied function to register- -> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))- -- ^ A 'ReleaseKey' if the registration worked+ Note that the function you pass must be fully applied.+-}+addAutocmd ::+ -- | The event to register to (e.g. BufWritePost)+ ByteString ->+ Synchronous ->+ AutocmdOptions ->+ -- | Fully applied function to register+ (Neovim env ()) ->+ -- | A 'ReleaseKey' if the registration worked+ Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey)) addAutocmd event s (opts@AutocmdOptions{}) f = do n <- newUniqueFunctionName fmap snd <$> registerFunctionality (Autocmd event n s opts) (\_ -> toObject <$> f) ---- | Create a listening thread for events and add update the 'FunctionMap' with--- the corresponding 'TQueue's (i.e. communication channels).-registerStatefulFunctionality- :: Plugin env- -> Neovim anyEnv ([FunctionMapEntry], Async ())-registerStatefulFunctionality (Plugin { environment = env, exports = fs }) = do+{- | Create a listening thread for events and add update the 'FunctionMap' with+ the corresponding 'TQueue's (i.e. communication channels).+-}+registerStatefulFunctionality ::+ Plugin env ->+ Neovim anyEnv ([FunctionMapEntry], Async ())+registerStatefulFunctionality (Plugin{environment = env, exports = fs}) = do messageQueue <- liftIO newTQueueIO route <- liftIO $ newTVarIO Map.empty+ subscribers <- liftIO $ newTVarIO [] cfg <- Internal.ask' - let startupConfig = cfg- { Internal.customConfig = env- , Internal.pluginSettings = Just $ Internal.StatefulSettings- (registerPlugin (\_ -> return ())) messageQueue route- }+ let startupConfig =+ cfg+ { Internal.customConfig = env+ , Internal.pluginSettings =+ Just $+ Internal.StatefulSettings+ (registerPlugin (\_ -> return ()))+ messageQueue+ route+ } res <- liftIO . runNeovimInternal return startupConfig . forM fs $ \f ->- registerFunctionality (getDescription f) (getFunction f)+ registerFunctionality (getDescription f) (getFunction f) es <- case res of- Left e -> err e+ Left e -> err e Right a -> return $ catMaybes a - let pluginThreadConfig = cfg- { Internal.customConfig = env- , Internal.pluginSettings = Just $ Internal.StatefulSettings- (registerPlugin registerInGlobalFunctionMap) messageQueue route- }+ let pluginThreadConfig =+ cfg+ { Internal.customConfig = env+ , Internal.pluginSettings =+ Just $+ Internal.StatefulSettings+ (registerPlugin registerInGlobalFunctionMap)+ messageQueue+ route+ } tid <- liftIO . async . void . runNeovim pluginThreadConfig $ do- listeningThread messageQueue route+ listeningThread messageQueue route subscribers return (map fst es, tid) -- NB: dropping release functions/keys here-- where- executeFunction- :: ([Object] -> Neovim env Object)- -> [Object]- -> Neovim env (Either String Object)- executeFunction f args = try (f args) >>= \case+ executeFunction ::+ ([Object] -> Neovim env Object) ->+ [Object] ->+ Neovim env (Either String Object)+ executeFunction f args =+ try (f args) >>= \case Left e -> return . Left $ show (e :: SomeException) Right res -> return $ Right res - timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String+ killAfterSeconds :: Word -> Neovim anyEnv ()+ killAfterSeconds seconds = threadDelay (fromIntegral seconds * 1000 * 1000)++ timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String timeoutAndLog seconds functionName = do- threadDelay (fromIntegral seconds * 1000 * 1000)+ killAfterSeconds seconds return . show $ pretty functionName <+> "has been aborted after"- <+> pretty seconds <+> "seconds"-+ <+> pretty seconds+ <+> "seconds" - listeningThread :: TQueue SomeMessage- -> TVar (Map NvimMethod ([Object] -> Neovim env Object))- -> Neovim env ()- listeningThread q route = do+ listeningThread ::+ TQueue SomeMessage ->+ TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->+ TVar [Notification -> Neovim env ()] ->+ Neovim env ()+ listeningThread q route subscribers = do msg <- readSomeMessage q forM_ (fromMessage msg) $ \req@(Request fun@(F methodName) _ args) -> do let method = NvimMethod methodName route' <- liftIO $ readTVarIO route forM_ (Map.lookup method route') $ \f -> do- respond req . either Left id =<< race- (timeoutAndLog 10 fun)- (executeFunction f args)-- forM_ (fromMessage msg) $ \(Notification fun@(F methodName) args) -> do- let method = NvimMethod methodName- route' <- liftIO $ readTVarIO route- forM_ (Map.lookup method route') $ \f ->- void . async $ do- result <- either Left id <$> race- (timeoutAndLog 600 fun)+ respond req . either Left id+ =<< race+ (timeoutAndLog 10 fun) (executeFunction f args)- case result of- Left message ->- nvim_err_writeln message- Right _ ->- return () -- listeningThread q route+ forM_ (fromMessage msg) $ \notification -> do+ subscribers' <- liftIO $ readTVarIO subscribers+ forM_ subscribers' $ \subscriber ->+ async $ void $ race (subscriber notification) (killAfterSeconds 10) + listeningThread q route subscribers
library/Neovim/Plugin/Classes.hs view
@@ -1,5 +1,7 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE RecordWildCards #-}+ {- | Module : Neovim.Plugin.Classes Description : Classes and data types related to plugins@@ -9,121 +11,130 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Plugin.Classes (- FunctionalityDescription(..),- FunctionName(..),- NvimMethod(..),- Synchronous(..),- CommandOption(..),+ FunctionalityDescription (..),+ FunctionName (..),+ NeovimEventId (..),+ SubscriptionId (..),+ Subscription (..),+ NvimMethod (..),+ Synchronous (..),+ CommandOption (..), CommandOptions,- RangeSpecification(..),- CommandArguments(..),+ RangeSpecification (..),+ CommandArguments (..), getCommandOptions, mkCommandOptions,- AutocmdOptions(..),- HasFunctionName(..),- ) where--import Neovim.Classes+ AutocmdOptions (..),+ HasFunctionName (..),+) where -import Control.Applicative hiding (empty)-import Control.Monad.Error.Class-import Data.ByteString (ByteString)-import Data.Char (isDigit)-import Data.Default-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.Text.Encoding (decodeUtf8)+import Neovim.Classes -import Data.Text.Prettyprint.Doc+import Control.Applicative hiding (empty)+import Control.Monad.Error.Class+import Data.ByteString (ByteString)+import Data.Char (isDigit)+import Data.Default+import Data.List (groupBy, sort)+import qualified Data.Map as Map+import Data.Maybe+import Data.MessagePack+import Data.String+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8) -import Prelude hiding (sequence)+import Prettyprinter +import Prelude hiding (sequence) -- | Essentially just a string. newtype FunctionName = F ByteString deriving (Eq, Ord, Show, Read, Generic)---instance NFData FunctionName-+ deriving (NFData) via ByteString instance Pretty FunctionName where pretty (F n) = pretty $ decodeUtf8 n +newtype NeovimEventId = NeovimEventId Text+ deriving (Eq, Ord, Show, Read, Generic)+ deriving (Pretty) via Text+ deriving (NFData) via Text --- | Functionality specific functional description entries.------ All fields which are directly specified in these constructors are not--- optional, but can partialy be generated via the Template Haskell functions.--- The last field is a data type that contains all relevant options with--- sensible defaults, hence 'def' can be used as an argument.-data FunctionalityDescription- = Function FunctionName Synchronous- -- ^ Exported function. Callable via @call name(arg1,arg2)@.- --- -- * Name of the function (must start with an uppercase letter)- -- * Option to indicate how neovim should behave when calling this function+instance NvimObject NeovimEventId where+ toObject (NeovimEventId e) = toObject e+ fromObject o = NeovimEventId <$> fromObject o - | Command FunctionName CommandOptions- -- ^ Exported Command. Callable via @:Name arg1 arg2@.- --- -- * Name of the command (must start with an uppercase letter)- -- * Options to configure neovim's behavior for calling the command+newtype SubscriptionId = SubscriptionId Int64+ deriving (Eq, Ord, Show, Read)+ deriving (Enum) via Int64 - | Autocmd ByteString FunctionName Synchronous AutocmdOptions- -- ^ Exported autocommand. Will call the given function if the type and- -- filter match.- --- -- NB: Since we are registering this on the Haskell side of things, the- -- number of accepted arguments should be 0.- --- -- * Type of the autocmd (e.g. \"BufWritePost\")- -- * Name for the function to call- -- * Whether to use rpcrequest or rpcnotify- -- * Options for the autocmd (use 'def' here if you don't want to change anything)+data Subscription = Subscription+ { subId :: SubscriptionId+ , subEventId :: NeovimEventId+ , subAction :: [Object] -> IO ()+ } - deriving (Show, Read, Eq, Ord, Generic)+{- | Functionality specific functional description entries. + All fields which are directly specified in these constructors are not+ optional, but can partialy be generated via the Template Haskell functions.+ The last field is a data type that contains all relevant options with+ sensible defaults, hence 'def' can be used as an argument.+-}+data FunctionalityDescription+ = -- | Exported function. Callable via @call name(arg1,arg2)@.+ --+ -- * Name of the function (must start with an uppercase letter)+ -- * Option to indicate how neovim should behave when calling this function+ Function FunctionName Synchronous+ | -- | Exported Command. Callable via @:Name arg1 arg2@.+ --+ -- * Name of the command (must start with an uppercase letter)+ -- * Options to configure neovim's behavior for calling the command+ Command FunctionName CommandOptions+ | -- | Exported autocommand. Will call the given function if the type and+ -- filter match.+ --+ -- NB: Since we are registering this on the Haskell side of things, the+ -- number of accepted arguments should be 0.+ --+ -- * Type of the autocmd (e.g. \"BufWritePost\")+ -- * Name for the function to call+ -- * Whether to use rpcrequest or rpcnotify+ -- * Options for the autocmd (use 'def' here if you don't want to change anything)+ Autocmd ByteString FunctionName Synchronous AutocmdOptions+ deriving (Show, Read, Eq, Ord, Generic) instance NFData FunctionalityDescription - instance Pretty FunctionalityDescription where pretty = \case Function fname s -> "Function" <+> pretty s <+> pretty fname- Command fname copts -> "Command" <+> pretty copts <+> pretty fname- Autocmd t fname s aopts -> "Autocmd" <+> pretty (decodeUtf8 t) <+> pretty s <+> pretty aopts <+> pretty fname ---- | This option detemines how neovim should behave when calling some--- functionality on a remote host.+{- | This option detemines how neovim should behave when calling some+ functionality on a remote host.+-} data Synchronous- = 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.+ = -- | 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.+ Async+ | -- | 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.+ Sync deriving (Show, Read, Eq, Ord, Enum, Generic) instance NFData Synchronous@@ -131,113 +142,99 @@ instance Pretty Synchronous where pretty = \case Async -> "async"- Sync -> "sync"-+ Sync -> "sync" instance IsString Synchronous where fromString = \case- "sync" -> Sync+ "sync" -> Sync "async" -> Async- _ -> error "Only \"sync\" and \"async\" are valid string representations"-+ _ -> error "Only \"sync\" and \"async\" are valid string representations" instance NvimObject Synchronous where toObject = \case Async -> toObject False- Sync -> toObject True+ Sync -> toObject True fromObject = \case- ObjectBool True -> return Sync+ ObjectBool True -> return Sync ObjectBool False -> return Async- ObjectInt 0 -> return Async- _ -> return Sync----- | 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.)-data CommandOption = CmdSync Synchronous- -- ^ Stringliteral "sync" or "async"-- | CmdRegister- -- ^ Register passed to the command.- --- -- Stringliteral: @\"\\\"\"@-- | CmdNargs String- -- ^ Command takes a specific amount of arguments- --- -- Automatically set via template haskell functions. You- -- really shouldn't use this option yourself unless you have- -- to.-- | 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")+ ObjectInt 0 -> return Async+ _ -> return Sync - | CmdBang- -- ^ Command handles a bang- --- -- Stringliteral: \"!\"+{- | Options for commands. - | CmdComplete String- -- ^ Verbatim string passed to the @-complete=@ command attribute+ 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.)+-}+data CommandOption+ = -- | Stringliteral "sync" or "async"+ CmdSync Synchronous+ | -- | Register passed to the command.+ --+ -- Stringliteral: @\"\\\"\"@+ CmdRegister+ | -- | Command takes a specific amount of arguments+ --+ -- Automatically set via template haskell functions. You+ -- really shouldn't use this option yourself unless you have+ -- to.+ CmdNargs String+ | -- | Determines how neovim passes the range.+ --+ -- Stringliterals: \"%\" for 'WholeFile', \",\" for line+ -- and \",123\" for 123 lines.+ CmdRange RangeSpecification+ | -- | Command handles a count. The argument defines the+ -- default count.+ --+ -- Stringliteral: string of numbers (e.g. "132")+ CmdCount Word+ | -- | Command handles a bang+ --+ -- Stringliteral: \"!\"+ CmdBang+ | -- | Verbatim string passed to the @-complete=@ command attribute+ CmdComplete String deriving (Eq, Ord, Show, Read, Generic) instance NFData CommandOption - instance Pretty CommandOption where pretty = \case CmdSync s -> pretty s- CmdRegister -> "\""- CmdNargs n -> pretty n- CmdRange rs -> pretty rs- CmdCount c -> pretty c- CmdBang -> "!"- CmdComplete cs ->- pretty cs-+ pretty cs instance IsString CommandOption where fromString = \case- "%" -> CmdRange WholeFile- "\"" -> CmdRegister- "!" -> CmdBang- "sync" -> CmdSync Sync+ "%" -> CmdRange WholeFile+ "\"" -> CmdRegister+ "!" -> CmdBang+ "sync" -> CmdSync Sync "async" -> CmdSync Async- "," -> CmdRange CurrentLine- ',':ds | not (null ds) && all isDigit ds -> CmdRange (read ds)+ "," -> CmdRange CurrentLine+ ',' : ds | not (null ds) && all isDigit ds -> CmdRange (read ds) ds | not (null ds) && all isDigit ds -> CmdCount (read ds)- _ -> error "Not a valid string for a CommandOptions. Check the docs!"+ _ -> error "Not a valid string for a CommandOptions. Check the docs!" --- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed--- object of this type is sorted and only contains zero or one object for each--- possible option.-newtype CommandOptions = CommandOptions { getCommandOptions :: [CommandOption] }+{- | Newtype wrapper for a list of 'CommandOption'. Any properly constructed+ object of this type is sorted and only contains zero or one object for each+ possible option.+-}+newtype CommandOptions = CommandOptions {getCommandOptions :: [CommandOption]} deriving (Eq, Ord, Show, Read, Generic) instance NFData CommandOptions@@ -246,56 +243,53 @@ 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--- not define the same thing multiple times.+{- | 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+ not define the same thing multiple times.+-} mkCommandOptions :: [CommandOption] -> CommandOptions mkCommandOptions = CommandOptions . map head . groupBy constructor . sort where- constructor a b = case (a,b) of- _ | a == b -> True+ constructor a b = case (a, b) of+ _ | a == b -> True -- Only CmdSync and CmdNargs may fail for the equality check, -- so we just have to check those.- (CmdSync _, CmdSync _) -> True- (CmdRange _, CmdRange _) -> True+ (CmdSync _, CmdSync _) -> True+ (CmdRange _, CmdRange _) -> True -- Range and conut are mutually recursive. -- XXX Actually '-range=N' and '-count=N' are, but the code in -- remote#define#CommandOnChannel treats it exclusive as a whole. -- (see :h :command-range)- (CmdRange _, CmdCount _) -> True- (CmdNargs _, CmdNargs _) -> True- _ -> False-+ (CmdRange _, CmdCount _) -> True+ (CmdNargs _, CmdNargs _) -> True+ _ -> False instance NvimObject CommandOptions where toObject (CommandOptions opts) = (toObject :: Dictionary -> Object) . Map.fromList $ mapMaybe addOption opts where addOption = \case- CmdRange r -> Just ("range" , toObject r)- CmdCount n -> Just ("count" , toObject n)- CmdBang -> Just ("bang" , ObjectBinary "")- CmdRegister -> Just ("register", ObjectBinary "")- CmdNargs n -> Just ("nargs" , toObject n)+ CmdRange r -> Just ("range", toObject r)+ CmdCount n -> Just ("count", toObject n)+ CmdBang -> Just ("bang", ObjectBinary "")+ CmdRegister -> Just ("register", ObjectBinary "")+ CmdNargs n -> Just ("nargs", toObject n) CmdComplete cs -> Just ("complete", toObject cs)- _ -> Nothing-- fromObject o = throwError $- "Did not expect to receive a CommandOptions object:" <+> viaShow o+ _ -> Nothing + fromObject o =+ throwError $+ "Did not expect to receive a CommandOptions object:" <+> viaShow o -- | Specification of a range that acommand can operate on. data RangeSpecification- = 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.-+ = -- | The line the cursor is at when the command is invoked.+ CurrentLine+ | -- | Let the command operate on every line of the file.+ WholeFile+ | -- | Let the command operate on each line in the given range.+ RangeCount Int deriving (Eq, Ord, Show, Read, Generic) instance NFData RangeSpecification@@ -304,167 +298,160 @@ pretty = \case CurrentLine -> mempty- WholeFile -> "%"- RangeCount c -> pretty c - instance NvimObject RangeSpecification where toObject = \case- CurrentLine -> ObjectBinary ""- WholeFile -> ObjectBinary "%"+ CurrentLine -> ObjectBinary ""+ WholeFile -> ObjectBinary "%" RangeCount n -> toObject n - fromObject o = throwError $- "Did not expect to receive a RangeSpecification object:" <+> viaShow o-+ fromObject o =+ throwError $+ "Did not expect to receive a RangeSpecification object:" <+> viaShow o --- | 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.+{- | 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.+-} data CommandArguments = CommandArguments- { 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.+ { -- | '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'@).+ bang :: Maybe Bool+ , -- | Range passed from neovim. Only set if 'CmdRange' was used in the export+ -- declaration of the command.+ --+ -- Example:+ --+ -- * @Just (1,12)@+ range :: Maybe (Int, Int)+ , -- | Count passed by neovim. Only set if 'CmdCount' was used in the export+ -- declaration of the command.+ count :: Maybe Int+ , -- | Register that the command can\/should\/must use.+ register :: Maybe String } deriving (Eq, Ord, Show, Read, Generic) - instance NFData CommandArguments - instance Pretty CommandArguments where pretty CommandArguments{..} =- cat $ catMaybes- [ (\b -> if b then "!" else mempty) <$> bang- , (\(s,e) -> lparen <> pretty s <> comma- <+> pretty e <> rparen)- <$> range- , pretty <$> count- , pretty <$> register- ]+ cat $+ catMaybes+ [ (\b -> if b then "!" else mempty) <$> bang+ , ( \(s, e) ->+ lparen <> pretty s <> comma+ <+> pretty e <> rparen+ )+ <$> range+ , pretty <$> count+ , pretty <$> register+ ] instance Default CommandArguments where- def = CommandArguments- { bang = Nothing- , range = Nothing- , count = Nothing+ def =+ CommandArguments+ { bang = Nothing+ , range = Nothing+ , count = Nothing , register = Nothing } - -- XXX This instance is used as a bit of a hack, so that I don't have to write -- special code handling in the code generator and "Neovim.RPC.SocketReader". instance NvimObject CommandArguments where- toObject CommandArguments{..} = (toObject :: Dictionary -> Object)- . Map.fromList . catMaybes $- [ bang >>= \b -> return ("bang", toObject b)- , range >>= \r -> return ("range", toObject r)- , count >>= \c -> return ("count", toObject c)- , register >>= \r -> return ("register", toObject r)- ]+ toObject CommandArguments{..} =+ (toObject :: Dictionary -> Object)+ . Map.fromList+ . catMaybes+ $ [ bang >>= \b -> return ("bang", toObject b)+ , range >>= \r -> return ("range", toObject r)+ , count >>= \c -> return ("count", toObject c)+ , register >>= \r -> return ("register", toObject r)+ ] fromObject (ObjectMap m) = do- let l key = sequence (fromObject <$> Map.lookup (ObjectBinary key) m)+ let l key = mapM fromObject (Map.lookup (ObjectBinary key) m) bang <- l "bang" range <- l "range" count <- l "count" register <- l "register" return CommandArguments{..}- fromObject ObjectNil = return def fromObject o =- throwError $ "Expected a map for CommandArguments object, but got: "- <+> viaShow o-+ throwError $+ "Expected a map for CommandArguments object, but got: "+ <+> viaShow o --- | 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.+{- | 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.+-} data AutocmdOptions = AutocmdOptions- { acmdPattern :: String- -- ^ Pattern to match on. (default: \"*\")-- , acmdNested :: Bool- -- ^ Nested autocmd. (default: False)- --- -- See @:h autocmd-nested@-- , acmdGroup :: Maybe String- -- ^ Group in which the autocmd should be registered.+ { -- | Pattern to match on. (default: \"*\")+ acmdPattern :: String+ , -- | Nested autocmd. (default: False)+ --+ -- See @:h autocmd-nested@+ acmdNested :: Bool+ , -- | Group in which the autocmd should be registered.+ acmdGroup :: Maybe String } deriving (Show, Read, Eq, Ord, Generic) - instance NFData AutocmdOptions - instance Pretty AutocmdOptions where pretty AutocmdOptions{..} = pretty acmdPattern- <+> if acmdNested then "nested" else "unnested"- <> maybe mempty (\g -> mempty <+> pretty g) acmdGroup-+ <+> if acmdNested+ then "nested"+ else+ "unnested"+ <> maybe mempty (\g -> mempty <+> pretty g) acmdGroup instance Default AutocmdOptions where- def = AutocmdOptions- { acmdPattern = "*"- , acmdNested = False- , acmdGroup = Nothing- }-+ def =+ AutocmdOptions+ { acmdPattern = "*"+ , acmdNested = False+ , acmdGroup = Nothing+ } instance NvimObject AutocmdOptions where toObject AutocmdOptions{..} = (toObject :: Dictionary -> Object) . Map.fromList $ [ ("pattern", toObject acmdPattern) , ("nested", toObject acmdNested)- ] ++ catMaybes- [ acmdGroup >>= \g -> return ("group", toObject g) ]- fromObject o = throwError $- "Did not expect to receive an AutocmdOptions object: " <+> viaShow o--newtype NvimMethod =- NvimMethod { nvimMethodName :: ByteString }- deriving (Eq, Ord, Show, Read, Generic)+ ++ catMaybes+ [ acmdGroup >>= \g -> return ("group", toObject g)+ ]+ fromObject o =+ throwError $+ "Did not expect to receive an AutocmdOptions object: " <+> viaShow o +newtype NvimMethod = NvimMethod {nvimMethodName :: ByteString}+ deriving (Eq, Ord, Show, Read, Generic) instance NFData NvimMethod - instance Pretty NvimMethod where pretty (NvimMethod n) = pretty $ decodeUtf8 n - -- | Conveniennce class to extract a name from some value. class HasFunctionName a where name :: a -> FunctionName nvimMethod :: a -> NvimMethod - instance HasFunctionName FunctionalityDescription where name = \case- Function n _ -> n- Command n _ -> n+ Function n _ -> n+ Command n _ -> n Autocmd _ n _ _ -> n nvimMethod = \case
library/Neovim/Plugin/IPC.hs view
@@ -11,10 +11,8 @@ plugins (or more generally threads running in the same plugin provider). -} module Neovim.Plugin.IPC (- SomeMessage(..),+ SomeMessage (..), fromMessage,-- ) where--import Neovim.Plugin.IPC.Classes+) where +import Neovim.Plugin.IPC.Classes
library/Neovim/Plugin/IPC/Classes.hs view
@@ -1,7 +1,8 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards #-}+ {- | Module : Neovim.Plugin.IPC.Classes Description : Classes used for Inter Plugin Communication@@ -11,52 +12,50 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Plugin.IPC.Classes (- SomeMessage(..),- Message(..),- FunctionCall(..),- Request(..),- Notification(..),+ SomeMessage (..),+ Message (..),+ FunctionCall (..),+ Request (..),+ Notification (..), writeMessage, readSomeMessage,- UTCTime, getCurrentTime,- module Data.Int,- ) where+) where -import Neovim.Classes-import Neovim.Plugin.Classes (FunctionName)+import Neovim.Classes+import Neovim.Plugin.Classes (FunctionName, NeovimEventId) -import Control.Exception (evaluate)-import Control.Concurrent.STM-import Control.Monad.IO.Class (MonadIO(..))-import Data.Data (Typeable, cast)-import Data.Int (Int64)-import Data.MessagePack-import Data.Time (UTCTime, formatTime, getCurrentTime)-import Data.Time.Locale.Compat (defaultTimeLocale)-import Data.Text.Prettyprint.Doc (nest, hardline, viaShow)+import Control.Concurrent.STM+import Control.Exception (evaluate)+import Control.Monad.IO.Class (MonadIO (..))+import Data.Data (Typeable, cast)+import Data.Int (Int64)+import Data.MessagePack+import Data.Time (UTCTime, formatTime, getCurrentTime)+import Data.Time.Locale.Compat (defaultTimeLocale)+import Prettyprinter (hardline, nest, viaShow) -import Prelude+import Prelude --- | Taken from xmonad and based on ideas in /An Extensible Dynamically-Typed--- Hierarchy of Exceptions/, Simon Marlow, 2006.------ User-extensible messages must be put into a value of this type, so that it--- can be sent to other plugins.-data SomeMessage = forall msg. Message msg => SomeMessage msg+{- | Taken from xmonad and based on ideas in /An Extensible Dynamically-Typed+ Hierarchy of Exceptions/, Simon Marlow, 2006. + User-extensible messages must be put into a value of this type, so that it+ can be sent to other plugins.+-}+data SomeMessage = forall msg. Message msg => SomeMessage msg --- | This class allows type safe casting of 'SomeMessage' to an actual message.--- The cast is successful if the type you're expecting matches the type in the--- 'SomeMessage' wrapper. This way, you can subscribe to an arbitrary message--- type withouth having to pattern match on the constructors. This also allows--- plugin authors to create their own message types without having to change the--- core code of /nvim-hs/.+{- | This class allows type safe casting of 'SomeMessage' to an actual message.+ The cast is successful if the type you're expecting matches the type in the+ 'SomeMessage' wrapper. This way, you can subscribe to an arbitrary message+ type withouth having to pattern match on the constructors. This also allows+ plugin authors to create their own message types without having to change the+ core code of /nvim-hs/.+-} class (NFData message, Typeable message) => Message message where -- | Try to convert a given message to a value of the message type we are -- interested in. Will evaluate to 'Nothing' for any other type.@@ -73,70 +72,73 @@ -- | Haskell representation of supported Remote Procedure Call messages. data FunctionCall- = FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime- -- ^ Method name, parameters, callback, timestamp+ = -- | Method name, parameters, callback, timestamp+ FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime deriving (Typeable, Generic) instance NFData FunctionCall where- rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` ()+ rnf (FunctionCall f os v t) = f `deepseq` os `deepseq` v `seq` t `deepseq` () instance Message FunctionCall - instance Pretty FunctionCall where pretty (FunctionCall fname args _ t) =- nest 2 $ "Function call for:" <+> pretty fname- <> hardline <> "Arguments:" <+> viaShow args- <> hardline <> "Timestamp:"- <+> (viaShow . formatTime defaultTimeLocale "%H:%M:%S (%q)") t-+ nest 2 $+ "Function call for:" <+> pretty fname+ <> hardline+ <> "Arguments:" <+> viaShow args+ <> hardline+ <> "Timestamp:"+ <+> (viaShow . 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.+{- | 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- { reqMethod :: FunctionName- -- ^ Name of the function to call.- , reqId :: !Int64- -- ^ Identifier to map the result to a function call invocation.- , reqArgs :: [Object]- -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable, Generic)-+ { -- | Name of the function to call.+ reqMethod :: FunctionName+ , -- | Identifier to map the result to a function call invocation.+ reqId :: !Int64+ , -- | Arguments for the function.+ reqArgs :: [Object]+ }+ deriving (Eq, Ord, Show, Typeable, Generic) instance NFData Request - instance Message Request - instance Pretty Request where pretty Request{..} =- nest 2 $ "Request" <+> "#" <> pretty reqId- <> hardline <> "Method:" <+> pretty reqMethod- <> hardline <> "Arguments:" <+> viaShow reqArgs-+ nest 2 $+ "Request" <+> "#" <> pretty reqId+ <> hardline+ <> "Method:" <+> pretty reqMethod+ <> hardline+ <> "Arguments:" <+> viaShow 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--- of the computation.+{- | 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+ of the computation.+-} data Notification = Notification- { notMethod :: FunctionName- -- ^ Name of the function to call.- , notArgs :: [Object]- -- ^ Arguments for the function.- } deriving (Eq, Ord, Show, Typeable, Generic)-+ { -- | Event name of the notification.+ notEvent :: NeovimEventId+ , -- | Arguments for the function.+ notArgs :: [Object]+ }+ deriving (Eq, Ord, Show, Typeable, Generic) instance NFData Notification - instance Message Notification - instance Pretty Notification where pretty Notification{..} =- nest 2 $ "Notification"- <> hardline <> "Method:" <+> pretty notMethod- <> hardline <> "Arguments:" <+> viaShow notArgs-+ nest 2 $+ "Notification"+ <> hardline+ <> "Event:" <+> pretty notEvent+ <> hardline+ <> "Arguments:" <+> viaShow notEvent
library/Neovim/Plugin/Internal.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE ExistentialQuantification #-}+ {- | Module : Neovim.Plugin.Internal Description : Split module that can import Neovim.Context without creating import circles@@ -8,58 +9,52 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Plugin.Internal (- ExportedFunctionality(..),+ ExportedFunctionality (..), getFunction, getDescription,- NeovimPlugin(..),- Plugin(..),+ NeovimPlugin (..),+ Plugin (..), wrapPlugin,- ) where--import Neovim.Context-import Neovim.Plugin.Classes+) where -import Data.MessagePack+import Neovim.Context+import Neovim.Plugin.Classes +import Data.MessagePack --- | This data type is used in the plugin registration to properly register the--- functions.+{- | This data type is used in the plugin registration to properly register the+ functions.+-} newtype ExportedFunctionality env = EF (FunctionalityDescription, [Object] -> Neovim env Object) - -- | Extract the description of an 'ExportedFunctionality'. getDescription :: ExportedFunctionality env -> FunctionalityDescription-getDescription (EF (d,_)) = d-+getDescription (EF (d, _)) = d -- | Extract the function of an 'ExportedFunctionality'. getFunction :: ExportedFunctionality env -> [Object] -> Neovim env Object getFunction (EF (_, f)) = f - instance HasFunctionName (ExportedFunctionality env) where name = name . getDescription nvimMethod = nvimMethod . getDescription - -- | This data type contains meta information for the plugin manager.--- data Plugin env = Plugin { environment :: env- , exports :: [ExportedFunctionality env]+ , exports :: [ExportedFunctionality env] } ---- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that--- we can put plugins in an ordinary list.+{- | 'Plugin' values are wraped inside this data type via 'wrapPlugin' so that+ we can put plugins in an ordinary list.+-} data NeovimPlugin = forall env. NeovimPlugin (Plugin env) ---- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple--- list.+{- | Wrap a 'Plugin' in some nice blankets, so that we can put them in a simple+ list.+-} wrapPlugin :: Applicative m => Plugin env -> m NeovimPlugin wrapPlugin = pure . NeovimPlugin
library/Neovim/Quickfix.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+ {- | Module : Neovim.Quickfix Description : API for interacting with the quickfix list@@ -9,32 +10,33 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -}-module Neovim.Quickfix- where+module Neovim.Quickfix where -import Control.Applicative-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 Data.Text.Prettyprint.Doc (viaShow)+import Control.Applicative+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 Prettyprinter (viaShow) -import Prelude+import Neovim.API.String+import Neovim.Classes+import Neovim.Context --- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any--- string that you can append to (hence 'Monoid') that is also an instance--- of 'NvimObject'. You can e.g. use the plain old 'String'.-setqflist :: (Monoid strType, NvimObject strType)- => [QuickfixListItem strType]- -> QuickfixAction- -> Neovim env ()+import Prelude++{- | This is a wrapper around neovim's @setqflist()@. @strType@ can be any+ string that you can append to (hence 'Monoid') that is also an instance+ of 'NvimObject'. You can e.g. use the plain old 'String'.+-}+setqflist ::+ (Monoid strType, NvimObject strType) =>+ [QuickfixListItem strType] ->+ QuickfixAction ->+ Neovim env () setqflist qs a = void $ vim_call_function "setqflist" $ qs +: a +: [] @@ -42,106 +44,104 @@ = VisualColumn Int | ByteIndexColumn Int | NoColumn- deriving (Eq, Ord, Show, Generic)-+ deriving (Eq, Ord, Show, Generic) instance NFData ColumnNumber data SignLocation strType = LineNumber Int | SearchPattern strType- deriving (Eq, Ord, Show, Generic)-+ deriving (Eq, Ord, Show, Generic) instance (NFData strType) => NFData (SignLocation strType) +{- | Quickfix list item. The parameter names should mostly conform to those in+ @:h setqflist()@. Some fields are merged to explicitly state mutually+ exclusive elements or some other behavior of the fields. --- | Quickfix list item. The parameter names should mostly conform to those in--- @:h setqflist()@. Some fields are merged to explicitly state mutually--- exclusive elements or some other behavior of the fields.------ see 'quickfixListItem' for creating a value of this type without typing too--- much.+ see 'quickfixListItem' for creating a value of this type without typing too+ much.+-} data QuickfixListItem strType = QFItem- { bufOrFile :: Either Int strType- -- ^ Since the filename is only used if no buffer can be specified, this- -- field is a merge of @bufnr@ and @filename@.-- , lnumOrPattern :: Either Int strType- -- ^ Line number or search pattern to locate the error.-- , col :: ColumnNumber- -- ^ A tuple of a column number and a boolean indicating which kind of- -- indexing should be used. 'True' means that the visual column should be- -- used. 'False' means to use the byte index.-- , nr :: Maybe Int- -- ^ Error number.-- , text :: strType- -- ^ Description of the error.-- , errorType :: QuickfixErrorType- -- ^ Type of error.- } deriving (Eq, Show, Generic)-+ { -- | Since the filename is only used if no buffer can be specified, this+ -- field is a merge of @bufnr@ and @filename@.+ bufOrFile :: Either Int strType+ , -- | Line number or search pattern to locate the error.+ lnumOrPattern :: Either Int strType+ , -- | A tuple of a column number and a boolean indicating which kind of+ -- indexing should be used. 'True' means that the visual column should be+ -- used. 'False' means to use the byte index.+ col :: ColumnNumber+ , -- | Error number.+ nr :: Maybe Int+ , -- | Description of the error.+ text :: strType+ , -- | Type of error.+ errorType :: QuickfixErrorType+ }+ deriving (Eq, Show, Generic) instance (NFData strType) => NFData (QuickfixListItem strType) - -- | Simple error type enum. data QuickfixErrorType = Warning | Error deriving (Eq, Ord, Show, Read, Enum, Bounded, Generic) - instance NFData QuickfixErrorType - instance NvimObject QuickfixErrorType where toObject = \case Warning -> ObjectBinary "W"- Error -> ObjectBinary "E"+ Error -> ObjectBinary "E" fromObject o = case fromObject o :: Either (Doc AnsiStyle) String of Right "W" -> return Warning Right "E" -> return Error- _ -> return Error----- | Create a 'QuickfixListItem' by providing the minimal amount of arguments--- needed.-quickfixListItem :: (Monoid strType)- => Either Int strType -- ^ buffer of file name- -> Either Int strType -- ^ line number or pattern- -> QuickfixListItem strType-quickfixListItem bufferOrFile lineOrPattern = QFItem- { bufOrFile = bufferOrFile- , lnumOrPattern = lineOrPattern- , col = NoColumn- , nr = Nothing- , text = mempty- , errorType = Error- }+ _ -> return Error +{- | Create a 'QuickfixListItem' by providing the minimal amount of arguments+ needed.+-}+quickfixListItem ::+ (Monoid strType) =>+ -- | buffer of file name+ Either Int strType ->+ -- | line number or pattern+ Either Int strType ->+ QuickfixListItem strType+quickfixListItem bufferOrFile lineOrPattern =+ QFItem+ { bufOrFile = bufferOrFile+ , lnumOrPattern = lineOrPattern+ , col = NoColumn+ , nr = Nothing+ , text = mempty+ , errorType = Error+ } -instance (Monoid strType, NvimObject strType)- => NvimObject (QuickfixListItem strType) where+instance+ (Monoid strType, NvimObject strType) =>+ NvimObject (QuickfixListItem strType)+ where toObject QFItem{..} = (toObject :: Map.Map ByteString Object -> Object) . Map.fromList $- [ either (\b -> ("bufnr", toObject b))- (\f -> ("filename", toObject f))- bufOrFile- , either (\l -> ("lnum", toObject l))- (\p -> ("pattern", toObject p))- lnumOrPattern+ [ either+ (\b -> ("bufnr", toObject b))+ (\f -> ("filename", toObject f))+ bufOrFile+ , either+ (\l -> ("lnum", toObject l))+ (\p -> ("pattern", toObject p))+ lnumOrPattern , ("type", toObject errorType) , ("text", toObject text)- ] ++ concat- [ case col of- NoColumn -> []- ByteIndexColumn i -> [ ("col", toObject i), ("vcol", toObject False) ]- VisualColumn i -> [ ("col", toObject i), ("vcol", toObject True) ] ]+ ++ concat+ [ case col of+ NoColumn -> []+ ByteIndexColumn i -> [("col", toObject i), ("vcol", toObject False)]+ VisualColumn i -> [("col", toObject i), ("vcol", toObject True)]+ ] fromObject objectMap@(ObjectMap _) = do m <- fromObject objectMap@@ -152,16 +152,17 @@ 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 $ "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."+ (_, Right pat) -> return $ Right pat+ _ -> throwError $ "No line number or search pattern inside quickfix list item." let l' :: NvimObject o => ByteString -> Either (Doc AnsiStyle) (Maybe o) l' key = case Map.lookup key m of Just o -> Just <$> fromObject o Nothing -> return Nothing- nr <- l' "nr" >>= \case+ nr <-+ l' "nr" >>= \case Just 0 -> return Nothing nr' -> return nr' c <- l' "col"@@ -169,38 +170,38 @@ let col = maybe NoColumn id $ do c' <- c v' <- v- case (c',v') of+ case (c', v') of (0, _) -> return $ NoColumn (_, True) -> return $ VisualColumn c' (_, False) -> return $ ByteIndexColumn c' text <- fromMaybe mempty <$> l' "text" errorType <- fromMaybe Error <$> l' "type" return QFItem{..}-- fromObject o = throwError $ "Could not deserialize QuickfixListItem,"- <+> "expected a map but received:"- <+> viaShow o-+ fromObject o =+ throwError $+ "Could not deserialize QuickfixListItem,"+ <+> "expected a map but received:"+ <+> viaShow o data QuickfixAction- = Append -- ^ Add items to the current list (or create a new one if none exists).- | Replace -- ^ Replace current list (or create a new one if none exists).- | New -- ^ Create a new list.+ = -- | Add items to the current list (or create a new one if none exists).+ Append+ | -- | Replace current list (or create a new one if none exists).+ Replace+ | -- | Create a new list.+ New deriving (Eq, Ord, Enum, Bounded, Show, Generic) - instance NFData QuickfixAction - instance NvimObject QuickfixAction where toObject = \case- Append -> ObjectBinary "a"+ Append -> ObjectBinary "a" Replace -> ObjectBinary "r"- New -> ObjectBinary ""+ New -> ObjectBinary "" fromObject o = case fromObject o of Right "a" -> return Append Right "r" -> return Replace Right s | BS.all (`BS.elem` " \t\n\r") s -> return New- _ -> Left "Could not convert to QuickfixAction"-+ _ -> Left "Could not convert to QuickfixAction"
library/Neovim/RPC/Classes.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveGeneric #-}+ {- | Module : Neovim.RPC.Classes Description : Data types and classes for the RPC components@@ -13,102 +13,89 @@ Import this module qualified as @MsgpackRPC@ -}-module Neovim.RPC.Classes- ( Message (..),- ) where+module Neovim.RPC.Classes (+ Message (..),+) where -import Neovim.Classes-import Neovim.Plugin.Classes (FunctionName (..))+import Neovim.Classes+import Neovim.Plugin.Classes (FunctionName (..), NeovimEventId (..)) import qualified Neovim.Plugin.IPC.Classes as IPC -import Control.Applicative-import Control.Monad.Error.Class-import Data.Data (Typeable)-import Data.MessagePack (Object (..))--import Data.Text.Prettyprint.Doc (hardline, nest, viaShow)+import Control.Applicative+import Control.Monad.Error.Class+import Data.Data (Typeable)+import Data.MessagePack (Object (..))+import Prettyprinter (hardline, nest, viaShow) -import Prelude+import Prelude --- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for--- details about the msgpack rpc specification.+{- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for+ details about the msgpack rpc specification.+-} data Message- = Request IPC.Request- -- ^ Request in the sense of the msgpack rpc specification- --- -- Parameters- -- * Message identifier that has to be put in the response to this request- -- * Function name- -- * Function arguments-- | Response !Int64 (Either Object Object)- -- ^ Response in the sense of the msgpack rpc specifcation- --- -- Parameters- -- * Mesage identifier which matches a request- -- * 'Either' an error 'Object' or a result 'Object'-- | Notification IPC.Notification- -- ^ Notification in the sense of the msgpack rpc specification+ = -- | Request in the sense of the msgpack rpc specification+ --+ -- Parameters+ -- * Message identifier that has to be put in the response to this request+ -- * Function name+ -- * Function arguments+ Request IPC.Request+ | -- | Response in the sense of the msgpack rpc specifcation+ --+ -- Parameters+ -- * Mesage identifier which matches a request+ -- * 'Either' an error 'Object' or a result 'Object'+ Response !Int64 (Either Object Object)+ | -- | Notification in the sense of the msgpack rpc specification+ Notification IPC.Notification deriving (Eq, Ord, Show, Typeable, Generic) - instance NFData Message - instance IPC.Message Message - instance NvimObject Message where toObject = \case Request (IPC.Request (F m) i ps) ->- ObjectArray $ (0 :: Int64) +: i +: m +: ps +: []-+ ObjectArray $ (0 :: Int64) +: i +: m +: ps +: [] Response i (Left e) -> ObjectArray $ (1 :: Int64) +: i +: e +: () +: []- Response i (Right r) -> ObjectArray $ (1 :: Int64) +: i +: () +: r +: []-- Notification (IPC.Notification (F m) ps) ->- ObjectArray $ (2 :: Int64) +: m +: ps +: []-+ Notification (IPC.Notification (NeovimEventId eventId) ps) ->+ ObjectArray $ (2 :: Int64) +: eventId +: ps +: [] fromObject = \case ObjectArray [ObjectInt 0, i, m, ps] -> do- r <- IPC.Request- <$> (fmap F (fromObject m))+ r <-+ IPC.Request+ <$> fmap F (fromObject m) <*> fromObject i <*> fromObject ps return $ Request r- ObjectArray [ObjectInt 1, i, e, r] -> let eer = case e of- ObjectNil -> Right r- _ -> Left e- in Response <$> fromObject i- <*> pure eer-+ ObjectNil -> Right r+ _ -> Left e+ in Response <$> fromObject i+ <*> pure eer ObjectArray [ObjectInt 2, m, ps] -> do- n <- IPC.Notification- <$> (fmap F (fromObject m))+ n <-+ IPC.Notification+ <$> fmap NeovimEventId (fromObject m) <*> fromObject ps return $ Notification n- o -> throwError $ "Not a known/valid msgpack-rpc message:" <+> viaShow o - instance Pretty Message where pretty = \case Request request -> pretty request- Response i ret ->- nest 2 $ "Response" <+> "#" <> pretty i- <> hardline <> either viaShow viaShow ret-+ nest 2 $+ "Response" <+> "#" <> pretty i+ <> hardline+ <> either viaShow viaShow ret Notification notification -> pretty notification--
library/Neovim/RPC/EventHandler.hs view
@@ -1,5 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+ {- | Module : Neovim.RPC.EventHandler Description : Event handling loop@@ -8,73 +9,74 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -} module Neovim.RPC.EventHandler ( runEventHandler,- ) where--import Neovim.Classes-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.IPC.Classes-import qualified Neovim.RPC.Classes as MsgpackRPC-import Neovim.RPC.Common-import Neovim.RPC.FunctionCall+) where -import Control.Applicative-import Control.Concurrent.STM hiding (writeTQueue)-import Control.Monad.Reader-import Control.Monad.Trans.Resource-import Data.ByteString (ByteString)-import Conduit as C-import qualified Data.Map as Map-import Data.Serialize (encode)-import System.IO (Handle)-import System.Log.Logger+import Neovim.Classes+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.IPC.Classes+import qualified Neovim.RPC.Classes as MsgpackRPC+import Neovim.RPC.Common+import Neovim.RPC.FunctionCall -import Prelude+import Conduit as C+import Control.Applicative+import Control.Concurrent.STM hiding (writeTQueue)+import Control.Monad.Reader+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import qualified Data.Map as Map+import Data.Serialize (encode)+import System.IO (Handle)+import System.Log.Logger +import Prelude --- | This function will establish a connection to the given socket and write--- msgpack-rpc requests to it.-runEventHandler :: Handle- -> Internal.Config RPCConfig- -> IO ()+{- | This function will establish a connection to the given socket and write+ msgpack-rpc requests to it.+-}+runEventHandler ::+ Handle ->+ Internal.Config RPCConfig ->+ IO () runEventHandler writeableHandle env = runEventHandlerContext env . runConduit $ do eventHandlerSource .| eventHandler .| (sinkHandleFlush writeableHandle) - -- | Convenient monad transformer stack for the event handler-newtype EventHandler a =- EventHandler (ResourceT (ReaderT (Internal.Config RPCConfig) IO) a)- deriving ( Functor, Applicative, Monad, MonadIO- , MonadReader (Internal.Config RPCConfig))-+newtype EventHandler a+ = EventHandler (ResourceT (ReaderT (Internal.Config RPCConfig) IO) a)+ deriving+ ( Functor+ , Applicative+ , Monad+ , MonadIO+ , MonadReader (Internal.Config RPCConfig)+ ) -runEventHandlerContext- :: Internal.Config RPCConfig -> EventHandler a -> IO a+runEventHandlerContext ::+ Internal.Config RPCConfig -> EventHandler a -> IO a runEventHandlerContext env (EventHandler a) = runReaderT (runResourceT a) env - eventHandlerSource :: ConduitT () SomeMessage EventHandler ()-eventHandlerSource = asks Internal.eventQueue >>= \q ->- forever $ yield =<< readSomeMessage q-+eventHandlerSource =+ asks Internal.eventQueue >>= \q ->+ forever $ yield =<< readSomeMessage q eventHandler :: ConduitM SomeMessage EncodedResponse EventHandler ()-eventHandler = await >>= \case- Nothing ->- return () -- i.e. close the conduit -- TODO signal shutdown globally-- Just message -> do- handleMessage (fromMessage message, fromMessage message)- eventHandler-+eventHandler =+ await >>= \case+ Nothing ->+ return () -- i.e. close the conduit -- TODO signal shutdown globally+ Just message -> do+ handleMessage (fromMessage message, fromMessage message)+ eventHandler type EncodedResponse = C.Flush ByteString @@ -84,8 +86,9 @@ yield . Chunk . encode $ toObject o yield Flush -handleMessage :: (Maybe FunctionCall, Maybe MsgpackRPC.Message)- -> ConduitM i EncodedResponse EventHandler ()+handleMessage ::+ (Maybe FunctionCall, Maybe MsgpackRPC.Message) ->+ ConduitM i EncodedResponse EventHandler () handleMessage = \case (Just (FunctionCall fn params reply time), _) -> do cfg <- asks (Internal.customConfig)@@ -95,13 +98,9 @@ modifyTVar' (recipients cfg) $ Map.insert i (time, reply) return i yield' $ MsgpackRPC.Request (Request fn messageId params)- (_, Just r@MsgpackRPC.Response{}) -> yield' r- (_, Just n@MsgpackRPC.Notification{}) -> yield' n- _ -> return () -- i.e. skip to next message-
library/Neovim/RPC/FunctionCall.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-}+ {- | Module : Neovim.RPC.FunctionCall Description : Functions for calling functions@@ -7,7 +8,6 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -} module Neovim.RPC.FunctionCall ( acall,@@ -18,28 +18,29 @@ wait, wait', respond,- ) where+) where -import Neovim.Classes-import Neovim.Context-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 Neovim.Classes+import Neovim.Context+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 Control.Applicative-import Control.Concurrent.STM-import Control.Monad.Reader-import Data.MessagePack-import UnliftIO.Exception (throwIO)+import Control.Applicative+import Control.Concurrent.STM+import Control.Monad.Reader+import Data.MessagePack+import UnliftIO.Exception (throwIO) -import Prelude+import Prelude -- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result.-acall :: (NvimObject result)- => FunctionName- -> [Object]- -> Neovim env (STM (Either NeovimException result))+acall ::+ (NvimObject result) =>+ FunctionName ->+ [Object] ->+ Neovim env (STM (Either NeovimException result)) acall fn parameters = do q <- Internal.asks' Internal.eventQueue mv <- liftIO newEmptyTMVarIO@@ -47,59 +48,61 @@ writeMessage q $ FunctionCall fn parameters mv timestamp return $ convertObject <$> readTMVar mv where- convertObject :: (NvimObject result)- => Either Object Object -> Either NeovimException result+ convertObject ::+ (NvimObject result) =>+ Either Object Object ->+ Either NeovimException result convertObject = \case Left e -> Left $ ErrorResult (pretty fn) e Right o -> case fromObject o of- Left e -> Left $ ErrorMessage e- Right r -> Right r+ Left e -> Left $ ErrorMessage e+ Right r -> Right r --- | Call a neovim function synchronously. This function blocks until the--- result is available.-scall :: (NvimObject result)- => FunctionName- -> [Object] -- ^ Parameters in an 'Object' array- -> Neovim env (Either NeovimException result)- -- ^ result value of the call or the thrown exception+{- | Call a neovim function synchronously. This function blocks until the+ result is available.+-}+scall ::+ (NvimObject result) =>+ FunctionName ->+ -- | Parameters in an 'Object' array+ [Object] ->+ -- | result value of the call or the thrown exception+ Neovim env (Either NeovimException result) scall fn parameters = acall fn parameters >>= atomically' -- | Similar to 'scall', but throw a 'NeovimException' instead of returning it.-scallThrow :: (NvimObject result)- => FunctionName- -> [Object]- -> Neovim env result+scallThrow ::+ (NvimObject result) =>+ FunctionName ->+ [Object] ->+ Neovim env result scallThrow fn parameters = scall fn parameters >>= either throwIO return ---- | Helper function similar to 'scall' that throws a runtime exception if the--- result is an error object.+{- | Helper function similar to 'scall' that throws a runtime exception if the+ result is an error object.+-} scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result scall' fn = either throwIO pure <=< scall fn - -- | Lifted variant of 'atomically'. atomically' :: (MonadIO io) => STM result -> io result atomically' = liftIO . atomically +{- | Wait for the result of the STM action. --- | Wait for the result of the STM action.------ This action possibly blocks as it is an alias for--- @ \ioSTM -> ioSTM >>= liftIO . atomically@.+ This action possibly blocks as it is an alias for+ @ \ioSTM -> ioSTM >>= liftIO . atomically@.+-} wait :: Neovim env (STM result) -> Neovim env result wait = (=<<) atomically' - -- | Variant of 'wait' that discards the result. wait' :: Neovim env (STM result) -> Neovim env () wait' = void . wait - -- | Send the result back to the neovim instance. respond :: (NvimObject result) => Request -> Either String result -> Neovim env () respond Request{..} result = do q <- Internal.asks' Internal.eventQueue writeMessage q . MsgpackRPC.Response reqId $ either (Left . toObject) (Right . toObject) result-
library/Neovim/RPC/SocketReader.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.SocketReader Description : The component which reads RPC messages from the neovim instance@@ -9,141 +6,135 @@ Maintainer : woozletoff@gmail.com Stability : experimental- -} module Neovim.RPC.SocketReader ( runSocketReader, parseParams,- ) where+) where -import Neovim.Classes-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes (CommandArguments (..),- CommandOption (..),- FunctionName (..),- NvimMethod (..),- FunctionalityDescription (..),- getCommandOptions)-import Neovim.Plugin.IPC.Classes-import qualified Neovim.RPC.Classes as MsgpackRPC-import Neovim.RPC.Common-import Neovim.RPC.FunctionCall+import Neovim.Classes+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes (+ CommandArguments (..),+ CommandOption (..),+ FunctionName (..),+ FunctionalityDescription (..),+ NeovimEventId (..),+ NvimMethod (..),+ Subscription (..),+ getCommandOptions,+ )+import Neovim.Plugin.IPC.Classes+import qualified Neovim.RPC.Classes as MsgpackRPC+import Neovim.RPC.Common+import Neovim.RPC.FunctionCall -import Control.Applicative-import Control.Concurrent.STM-import Control.Monad (void)-import Conduit as C-import Data.Conduit.Cereal (conduitGet2)-import Data.Default (def)-import Data.Foldable (foldl', forM_)-import qualified Data.Map as Map-import Data.MessagePack-import Data.Monoid-import qualified Data.Serialize (get)-import System.IO (Handle)-import System.Log.Logger-import UnliftIO.Async (async, race)-import UnliftIO.Concurrent (threadDelay)+import Conduit as C+import Control.Applicative+import Control.Concurrent.STM+import Control.Monad (void)+import Data.Conduit.Cereal (conduitGet2)+import Data.Default (def)+import Data.Foldable (foldl', forM_)+import qualified Data.Map as Map+import Data.Maybe (fromMaybe)+import Data.MessagePack+import Data.Monoid+import qualified Data.Serialize (get)+import System.IO (Handle)+import System.Log.Logger+import UnliftIO.Async (async, race)+import UnliftIO.Concurrent (threadDelay) -import Prelude+import Prelude logger :: String logger = "Socket Reader" - type SocketHandler = Neovim RPCConfig ---- | This function will establish a connection to the given socket and read--- msgpack-rpc events from it.-runSocketReader :: Handle- -> Internal.Config RPCConfig- -> IO ()+{- | This function will establish a connection to the given socket and read+ msgpack-rpc events from it.+-}+runSocketReader ::+ Handle ->+ Internal.Config RPCConfig ->+ IO () runSocketReader readableHandle cfg = void . runNeovim (Internal.retypeConfig (Internal.customConfig cfg) cfg) . runConduit $ do sourceHandle readableHandle .| conduitGet2 Data.Serialize.get .| messageHandlerSink ---- | Sink that delegates the messages depending on their type.--- <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>+{- | Sink that delegates the messages depending on their type.+ <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>+-} messageHandlerSink :: ConduitT Object Void SocketHandler () messageHandlerSink = awaitForever $ \rpc -> do liftIO . debugM logger $ "Received: " <> show rpc case fromObject rpc of Right (MsgpackRPC.Request (Request fn i ps)) ->- handleRequestOrNotification (Just i) fn ps-+ handleRequest i fn ps Right (MsgpackRPC.Response i r) -> handleResponse i r-- Right (MsgpackRPC.Notification (Notification fn ps)) ->- handleRequestOrNotification Nothing fn ps-- Left e -> liftIO . errorM logger $- "Unhandled rpc message: " <> show e-+ Right (MsgpackRPC.Notification (Notification eventId args)) ->+ handleNotification eventId args+ Left e ->+ liftIO . errorM logger $ "Unhandled rpc message: " <> show e -handleResponse :: Int64 -> Either Object Object- -> ConduitT a Void SocketHandler ()+handleResponse :: Int64 -> Either Object Object -> ConduitT a Void SocketHandler () handleResponse i result = do answerMap <- asks recipients mReply <- Map.lookup i <$> liftIO (readTVarIO answerMap) case mReply of- Nothing -> liftIO $ warningM logger- "Received response but could not find a matching recipient."- Just (_,reply) -> do+ Nothing ->+ liftIO $ warningM logger "Received response but could not find a matching recipient."+ Just (_, reply) -> do atomically' . modifyTVar' answerMap $ Map.delete i atomically' $ putTMVar reply result ---- | Act upon the received request or notification. The main difference between--- the two is that a notification does not generate a reply. The distinction--- between those two cases is done via the first paramater which is 'Maybe' the--- function call identifier.-handleRequestOrNotification :: Maybe Int64 -> FunctionName -> [Object]- -> ConduitT a Void SocketHandler ()-handleRequestOrNotification requestId functionToCall@(F functionName) params = do+handleRequest :: Int64 -> FunctionName -> [Object] -> ConduitT a Void SocketHandler ()+handleRequest requestId functionToCall@(F functionName) params = do cfg <- lift Internal.ask' void . liftIO . async $ race logTimeout (handle cfg) return ()- where- lookupFunction- :: TMVar Internal.FunctionMap- -> STM (Maybe (FunctionalityDescription, Internal.FunctionType))+ lookupFunction ::+ TMVar Internal.FunctionMap ->+ STM (Maybe (FunctionalityDescription, Internal.FunctionType)) lookupFunction funMap = Map.lookup (NvimMethod functionName) <$> readTMVar funMap logTimeout :: IO () logTimeout = do let seconds = 1000 * 1000 threadDelay (10 * seconds)- debugM logger $ "Cancelled another action before it was finished"+ debugM logger "Cancelled another action before it was finished" handle :: Internal.Config RPCConfig -> IO ()- handle rpc = atomically (lookupFunction (Internal.globalFunctionMap rpc)) >>= \case-- Nothing -> do- let errM = "No provider for: " <> show functionToCall- debugM logger errM- forM_ requestId $ \i -> writeMessage (Internal.eventQueue rpc) $- MsgpackRPC.Response i (Left (toObject errM))-- Just (copts, Internal.Stateful c) -> do- now <- liftIO getCurrentTime- reply <- liftIO newEmptyTMVarIO- let q = (recipients . Internal.customConfig) rpc- liftIO . debugM logger $ "Executing stateful function with ID: " <> show requestId- case requestId of- Just i -> do- atomically' . modifyTVar q $ Map.insert i (now, reply)- writeMessage c $ Request functionToCall i (parseParams copts params)-- Nothing ->- writeMessage c $ Notification functionToCall (parseParams copts params)+ handle rpc =+ atomically (lookupFunction (Internal.globalFunctionMap rpc)) >>= \case+ Nothing -> do+ let errM = "No provider for: " <> show functionToCall+ debugM logger errM+ writeMessage (Internal.eventQueue rpc) $+ MsgpackRPC.Response requestId (Left (toObject errM))+ Just (copts, Internal.Stateful c) -> do+ now <- liftIO getCurrentTime+ reply <- liftIO newEmptyTMVarIO+ let q = (recipients . Internal.customConfig) rpc+ liftIO . debugM logger $ "Executing stateful function with ID: " <> show requestId+ atomically' . modifyTVar q $ Map.insert requestId (now, reply)+ writeMessage c $ Request functionToCall requestId (parseParams copts params) +handleNotification :: NeovimEventId -> [Object] -> ConduitT a Void SocketHandler ()+handleNotification eventId args = do+ subscriptions' <- lift $ Internal.asks' Internal.subscriptions+ subscribers <- liftIO $+ atomically $ do+ s <- readTMVar subscriptions'+ pure $ fromMaybe [] $ Map.lookup eventId (Internal.byEventId s)+ forM_ subscribers $ \subscription -> liftIO $ subAction subscription args parseParams :: FunctionalityDescription -> [Object] -> [Object] parseParams (Function _ _) args = case args of@@ -154,67 +145,54 @@ -- The function generating the function on neovim side is called: -- @remote#define#FunctionOnHost@ [ObjectArray fArgs] -> fArgs- _ -> args-+ _ -> args parseParams cmd@(Command _ opts) args = case args of (ObjectArray _ : _) -> let cmdArgs = filter isPassedViaRPC (getCommandOptions opts)- (c,args') =- foldl' createCommandArguments (def, []) $- zip cmdArgs args- in toObject c : args'-- _ -> parseParams cmd $ [ObjectArray args]+ (c, args') = foldl' createCommandArguments (def, []) $ zip cmdArgs args+ in toObject c : args'+ _ -> parseParams cmd [ObjectArray args] where isPassedViaRPC :: CommandOption -> Bool isPassedViaRPC = \case- CmdSync{} -> False- _ -> True+ CmdSync{} -> False+ _ -> True -- Neovim passes arguments in a special form, depending on the -- CommandOption values used to export the (command) function (e.g. via -- 'command' or 'command'').- createCommandArguments :: (CommandArguments, [Object])- -> (CommandOption, Object)- -> (CommandArguments, [Object])+ createCommandArguments ::+ (CommandArguments, [Object]) ->+ (CommandOption, Object) ->+ (CommandArguments, [Object]) createCommandArguments old@(c, args') = \case (CmdRange _, o) ->- either (const old) (\r -> (c { range = Just r }, args')) $ fromObject o-+ either (const old) (\r -> (c{range = Just r}, args')) $ fromObject o (CmdCount _, o) ->- either (const old) (\n -> (c { count = Just n }, args')) $ fromObject o-+ either (const old) (\n -> (c{count = Just n}, args')) $ fromObject o (CmdBang, o) ->- either (const old) (\b -> (c { bang = Just b }, args')) $ fromObject o-+ either (const old) (\b -> (c{bang = Just b}, args')) $ fromObject o (CmdNargs "*", ObjectArray os) -> -- CommandArguments -> [String] -> Neovim r st a (c, os)- (CmdNargs "+", ObjectArray (o:os)) ->+ (CmdNargs "+", ObjectArray (o : os)) -> -- CommandArguments -> String -> [String] -> Neovim r st a (c, o : [ObjectArray os]) (CmdNargs "?", ObjectArray [o]) -> -- CommandArguments -> Maybe String -> Neovim r st a (c, [toObject (Just o)])- (CmdNargs "?", ObjectArray []) -> -- CommandArguments -> Maybe String -> Neovim r st a (c, [toObject (Nothing :: Maybe Object)])- (CmdNargs "0", ObjectArray []) -> -- CommandArguments -> Neovim r st a (c, [])- (CmdNargs "1", ObjectArray [o]) -> -- CommandArguments -> String -> Neovim r st a (c, [o])- (CmdRegister, o) ->- either (const old) (\r -> (c { register = Just r }, args')) $ fromObject o-+ either (const old) (\r -> (c{register = Just r}, args')) $ fromObject o _ -> old--parseParams (Autocmd _ _ _ _) args = case args of+parseParams Autocmd{} args = case args of [ObjectArray fArgs] -> fArgs _ -> args-
library/Neovim/Test.hs view
@@ -7,61 +7,64 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Test ( testWithEmbeddedNeovim,- Seconds(..),- ) where+ Seconds (..),+) where -import Neovim-import Neovim.API.Text+import Neovim+import Neovim.API.Text import qualified Neovim.Context.Internal as Internal-import Neovim.RPC.Common (RPCConfig, newRPCConfig)-import Neovim.RPC.EventHandler (runEventHandler)-import Neovim.RPC.SocketReader (runSocketReader)+import Neovim.RPC.Common (RPCConfig, newRPCConfig)+import Neovim.RPC.EventHandler (runEventHandler)+import Neovim.RPC.SocketReader (runSocketReader) -import Control.Monad.Reader (runReaderT)-import Control.Monad.Trans.Resource (runResourceT)-import Data.Text.Prettyprint.Doc (annotate, vsep)-import Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)-import GHC.IO.Exception (ioe_filename)+import Control.Monad.Reader (runReaderT)+import Control.Monad.Trans.Resource (runResourceT)+import GHC.IO.Exception (ioe_filename) import Path import Path.IO-import System.Exit (ExitCode (..))-import System.IO (Handle)+import Prettyprinter (annotate, vsep)+import Prettyprinter.Render.Terminal (Color (..), color) import System.Process.Typed-import UnliftIO.Async (async, cancel)-import UnliftIO.Concurrent (threadDelay)-import UnliftIO.Exception-import UnliftIO.STM (atomically, putTMVar)+import UnliftIO+import UnliftIO.Concurrent (threadDelay) -- | Type synonym for 'Word'. newtype Seconds = Seconds Word +microSeconds :: Integral i => Seconds -> i+microSeconds (Seconds s) = fromIntegral s * 1000 * 1000 --- | Run the given 'Neovim' action according to the given parameters.--- The embedded neovim instance is started without a config (i.e. it is passed--- @-u NONE@).------ If you want to run your tests purely from haskell, you have to setup--- the desired state of neovim with the help of the functions in--- "Neovim.API.String".-testWithEmbeddedNeovim- :: Maybe (Path b File) -- ^ Optional path to a file that should be opened- -> Seconds -- ^ Maximum time (in seconds) that a test is allowed to run- -> env -- ^ Read-only configuration- -> Neovim env a -- ^ Test case- -> IO ()-testWithEmbeddedNeovim file timeout r (Internal.Neovim a) =+{- | Run the given 'Neovim' action according to the given parameters.+ The embedded neovim instance is started without a config (i.e. it is passed+ @-u NONE@).++ If you want to run your tests purely from haskell, you have to setup+ the desired state of neovim with the help of the functions in+ "Neovim.API.String".+-}+testWithEmbeddedNeovim ::+ -- | Optional path to a file that should be opened+ Maybe (Path b File) ->+ -- | Maximum time (in seconds) that a test is allowed to run+ Seconds ->+ -- | Read-only configuration+ env ->+ -- | Test case+ Neovim env a ->+ IO ()+testWithEmbeddedNeovim file timeoutAfter r (Internal.Neovim a) = runTest `catch` catchIfNvimIsNotOnPath where runTest = do- (nvimProcess, cfg, cleanUp) <- startEmbeddedNvim file timeout+ (nvimProcess, cfg, cleanUp) <- startEmbeddedNvim file timeoutAfter let testCfg = Internal.retypeConfig r cfg - void $ runReaderT (runResourceT a) testCfg+ result <- timeout (microSeconds timeoutAfter) $ do+ runReaderT (runResourceT a) testCfg -- vim_command isn't asynchronous, so we need to avoid waiting for the -- result of the operation since neovim cannot send a result if it@@ -72,62 +75,64 @@ waitExitCode nvimProcess >>= \case ExitFailure i -> fail $ "Neovim returned with an exit status of: " ++ show i-- ExitSuccess ->- return ()+ ExitSuccess -> case result of+ Nothing -> fail "Test timed out"+ Just _ -> pure () cancel testRunner cleanUp - catchIfNvimIsNotOnPath :: IOException -> IO () catchIfNvimIsNotOnPath e = case ioe_filename e of Just "nvim" ->- putDoc . annotate (color Red) $ vsep- [ "The neovim executable 'nvim' is not on the PATH."- , "You may not be testing fully!"- ]-- _ ->+ putDoc . annotate (color Red) $+ vsep+ [ "The neovim executable 'nvim' is not on the PATH."+ , "You may not be testing fully!"+ ]+ _ -> throwIO e -startEmbeddedNvim- :: Maybe (Path b File)- -> Seconds- -> IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())-startEmbeddedNvim file (Seconds timeout) = do+startEmbeddedNvim ::+ Maybe (Path b File) ->+ Seconds ->+ IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())+startEmbeddedNvim file timeoutAfter = do args <- case file of- Nothing ->- return []-- Just f -> do- -- 'fail' should work with most testing frameworks- unlessM (doesFileExist f) . fail $ "File not found: " ++ show f- return [toFilePath f]+ Nothing ->+ pure []+ Just f -> do+ unlessM (doesFileExist f) . fail $ "File not found: " ++ show f+ pure [toFilePath f] - nvimProcess <- startProcess- $ setStdin createPipe- $ setStdout createPipe- $ proc "nvim" (["-n","--clean","--embed"] ++ args)+ nvimProcess <-+ startProcess $+ setStdin createPipe $+ setStdout createPipe $+ proc "nvim" (["-n", "--clean", "--embed"] ++ args) cfg <- Internal.newConfig (pure Nothing) newRPCConfig - socketReader <- async . void $ runSocketReader- (getStdout nvimProcess)- (cfg { Internal.pluginSettings = Nothing })+ socketReader <-+ async . void $+ runSocketReader+ (getStdout nvimProcess)+ (cfg{Internal.pluginSettings = Nothing}) - eventHandler <- async . void $ runEventHandler- (getStdin nvimProcess)- (cfg { Internal.pluginSettings = Nothing })+ eventHandler <-+ async . void $+ runEventHandler+ (getStdin nvimProcess)+ (cfg{Internal.pluginSettings = Nothing}) - atomically $ putTMVar- (Internal.globalFunctionMap cfg)- (Internal.mkFunctionMap [])+ atomically $+ putTMVar+ (Internal.globalFunctionMap cfg)+ (Internal.mkFunctionMap []) timeoutAsync <- async . void $ do- threadDelay $ (fromIntegral timeout) * 1000 * 1000- getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> return ())+ threadDelay $ microSeconds timeoutAfter+ getExitCode nvimProcess >>= maybe (stopProcess nvimProcess) (\_ -> pure ()) let cleanUp = mapM_ cancel [socketReader, eventHandler, timeoutAsync] - return (nvimProcess, cfg, cleanUp)-+ pure (nvimProcess, cfg, cleanUp)
library/Neovim/Util.hs view
@@ -7,30 +7,26 @@ Maintainer : woozletoff@gmail.com Stability : experimental Portability : GHC- -} module Neovim.Util ( whenM, unlessM, oneLineErrorMessage,- ) where+) where -import Control.Monad (when, unless)-import Neovim.Context+import Control.Monad (unless, when) import qualified Data.Text as T-+import Neovim.Context -- | 'when' with a monadic predicate. whenM :: (Monad m) => m Bool -> m () -> m () whenM mp a = mp >>= \p -> when p a - -- | 'unless' with a monadic predicate. unlessM :: (Monad m) => m Bool -> m () -> m () unlessM mp a = mp >>= \p -> unless p a - oneLineErrorMessage :: Doc AnsiStyle -> T.Text oneLineErrorMessage d = case T.lines $ docToText d of- (x:_) -> x- [] -> mempty+ (x : _) -> x+ [] -> mempty
nvim-hs.cabal view
@@ -1,5 +1,5 @@ name: nvim-hs-version: 2.3.0.0+version: 2.3.1.0 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write@@ -121,7 +121,7 @@ , optparse-applicative , time-locale-compat , megaparsec < 10- , prettyprinter >= 1.2 && < 2+ , prettyprinter >= 1.7 && < 2 , prettyprinter-ansi-terminal , resourcet >= 1.1.11 , stm@@ -197,6 +197,7 @@ other-modules: Neovim.API.THSpec , Neovim.API.THSpecFunctions , Neovim.EmbeddedRPCSpec+ , Neovim.EventSubscriptionSpec , Neovim.Plugin.ClassesSpec , Neovim.RPC.SocketReaderSpec , Neovim.RPC.CommonSpec
test-suite/Neovim/API/THSpec.hs view
@@ -1,25 +1,27 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-module Neovim.API.THSpec- where+{-# LANGUAGE TemplateHaskell #-} -import Neovim.API.THSpecFunctions+module Neovim.API.THSpec where -import Neovim.API.TH hiding (function)-import qualified Neovim.API.TH as TH-import Neovim.Context-import qualified Neovim.Context.Internal as Internal-import Neovim.Plugin.Classes-import Neovim.Plugin.Internal+import Neovim.API.THSpecFunctions -import Data.Default-import qualified Data.Map as Map+import Neovim.API.TH hiding (function)+import qualified Neovim.API.TH as TH+import Neovim.Context+import qualified Neovim.Context.Internal as Internal+import Neovim.Plugin.Classes+import Neovim.Plugin.Internal -import Test.Hspec-import Test.QuickCheck+import Data.Default+import qualified Data.Map as Map -call :: ([Object] -> Neovim () Object) -> [Object]- -> IO Object+import Test.Hspec+import Test.QuickCheck++call ::+ ([Object] -> Neovim () Object) ->+ [Object] ->+ IO Object call f args = do cfg <- Internal.newConfig (pure Nothing) (pure ()) res <- runNeovim cfg (f args)@@ -27,91 +29,89 @@ Right x -> return x Left e -> (throwIO . ErrorMessage) e - isNeovimException :: NeovimException -> Bool isNeovimException _ = True - spec :: Spec spec = do- describe "calling function without an argument" $ do- let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync- it "should have a capitalized prefix" $- fname `shouldBe` F "TestFunction0"-- it "should return the consant value" $- call testFun [] `shouldReturn` ObjectInt 42-- it "should fail if supplied an argument" $- call testFun [ObjectNil] `shouldThrow` isNeovimException-+ describe "calling function without an argument" $ do+ let EF (Function fname _, testFun) = $(TH.function "TestFunction0" 'testFunction0) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` F "TestFunction0" - describe "calling testFunction with two arguments" $ do- let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync- it "should have a capitalized prefix" $- fname `shouldBe` F "TestFunction2"+ it "should return the consant value" $+ call testFun [] `shouldReturn` ObjectInt 42 - it "should return 2 for proper arguments" $- call testFun [ ObjectNil- , ObjectString "ignored"- , ObjectArray [ObjectString "42"]- ]- `shouldReturn` ObjectDouble 2+ it "should fail if supplied an argument" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException - it "should throw an exception for the wrong number of arguments" $- call testFun [ObjectNil] `shouldThrow` isNeovimException+ describe "calling testFunction with two arguments" $ do+ let EF (Function fname _, testFun) = $(function' 'testFunction2) Sync+ it "should have a capitalized prefix" $+ fname `shouldBe` F "TestFunction2" - it "should throw an exception for incompatible types" $- call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"]- `shouldThrow` isNeovimException+ it "should return 2 for proper arguments" $+ call+ testFun+ [ ObjectNil+ , ObjectString "ignored"+ , ObjectArray [ObjectString "42"]+ ]+ `shouldReturn` ObjectDouble 2 - it "should cast arguments to similar types" $- call testFun [ObjectNil, ObjectString "ignored", ObjectArray []]- `shouldReturn` ObjectDouble 2+ it "should throw an exception for the wrong number of arguments" $+ call testFun [ObjectNil] `shouldThrow` isNeovimException + it "should throw an exception for incompatible types" $+ call testFun [ObjectNil, ObjectBinary "ignored", ObjectString "42"]+ `shouldThrow` isNeovimException - describe "generating a command from the two argument test function" $ do- let EF (Command fname _, _) = $(command' 'testFunction2) []- it "should capitalize the first character" $- fname `shouldBe` F "TestFunction2"+ it "should cast arguments to similar types" $+ call testFun [ObjectNil, ObjectString "ignored", ObjectArray []]+ `shouldReturn` ObjectDouble 2 - describe "generating the test successor functions" $ do- let EF (Function fname _, testFun) = $(function' 'testSucc) Sync- it "should be named TestSucc" $- fname `shouldBe` F "TestSucc"+ describe "generating a command from the two argument test function" $ do+ let EF (Command fname _, _) = $(command' 'testFunction2) []+ it "should capitalize the first character" $+ fname `shouldBe` F "TestFunction2" - it "should return the old value + 1" . property $- \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x+1)+ describe "generating the test successor functions" $ do+ let EF (Function fname _, testFun) = $(function' 'testSucc) Sync+ it "should be named TestSucc" $+ fname `shouldBe` F "TestSucc" - describe "calling test function with a map argument" $ do- let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync- it "should capitalize the first letter" $- fname `shouldBe` F "TestFunctionMap"+ it "should return the old value + 1" . property $+ \x -> call testFun [ObjectInt x] `shouldReturn` ObjectInt (x + 1) - it "should fail for the wrong number of arguments" $- call testFun [] `shouldThrow` isNeovimException+ describe "calling test function with a map argument" $ do+ let EF (Function fname _, testFun) = $(TH.function "TestFunctionMap" 'testFunctionMap) Sync+ it "should capitalize the first letter" $+ fname `shouldBe` F "TestFunctionMap" - it "should fail for the wrong type of arguments" $- call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException+ it "should fail for the wrong number of arguments" $+ call testFun [] `shouldThrow` isNeovimException - it "should return Nothing for an empty map" $- call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"]- `shouldReturn` ObjectNil+ it "should fail for the wrong type of arguments" $+ call testFun [ObjectInt 7, ObjectString "FOO"] `shouldThrow` isNeovimException - it "should return just the value for the singletion entry" $- call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"]- `shouldReturn` ObjectInt 7+ it "should return Nothing for an empty map" $+ call testFun [toObject (Map.empty :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectNil + it "should return just the value for the singletion entry" $+ call testFun [toObject (Map.singleton "FOO" 7 :: Map.Map String Int), ObjectString "FOO"]+ `shouldReturn` ObjectInt 7 - describe "Calling function with an optional argument" $ do- let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) []- defCmdArgs = toObject (def :: CommandArguments)- it "should capitalize the first letter" $- cname `shouldBe` F "TestCommandOptArgument"+ describe "Calling function with an optional argument" $ do+ let EF (Command cname _, testFun) = $(command' 'testCommandOptArgument) []+ defCmdArgs = toObject (def :: CommandArguments)+ it "should capitalize the first letter" $+ cname `shouldBe` F "TestCommandOptArgument" - it "should return \"default\" when passed no argument" $ do- call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String)+ it "should return \"default\" when passed no argument" $ do+ call testFun [defCmdArgs] `shouldReturn` toObject ("default" :: String) - it "should return what is passed otherwise" . property $ do- \str -> call testFun [defCmdArgs, toObject str]- `shouldReturn` toObject (str :: String)+ it "should return what is passed otherwise" . property $ do+ \str ->+ call testFun [defCmdArgs, toObject str]+ `shouldReturn` toObject (str :: String)
test-suite/Neovim/API/THSpecFunctions.hs view
@@ -1,8 +1,7 @@-module Neovim.API.THSpecFunctions- where+module Neovim.API.THSpecFunctions where import qualified Data.Map as Map-import Neovim+import Neovim testFunction0 :: Neovim env Int testFunction0 = return 42@@ -18,5 +17,5 @@ testCommandOptArgument :: CommandArguments -> Maybe String -> Neovim env String testCommandOptArgument _ ms = case ms of- Just x -> return x+ Just x -> return x Nothing -> return "default"
test-suite/Neovim/EmbeddedRPCSpec.hs view
@@ -1,86 +1,91 @@-{-# LANGUAGE LambdaCase #-}-module Neovim.EmbeddedRPCSpec- where+{-# LANGUAGE LambdaCase #-} -import Test.Hspec+module Neovim.EmbeddedRPCSpec where+ import Test.HUnit+import Test.Hspec -import Neovim-import Neovim.API.Text-import Neovim.Context (docToText)+import Neovim+import Neovim.API.Text+import Neovim.Context (docToText) import qualified Neovim.Context.Internal as Internal-import Neovim.Quickfix-import Neovim.RPC.Common-import Neovim.RPC.EventHandler-import Neovim.RPC.FunctionCall (atomically')-import Neovim.RPC.SocketReader-import Neovim.Test--import Control.Concurrent-import Control.Concurrent.STM-import Control.Monad.Reader (runReaderT)-import Control.Monad.State (runStateT)-import qualified Data.Map as Map-import Path-import Path.IO-import System.Exit (ExitCode (..))-import System.Process.Typed+import Neovim.Quickfix+import Neovim.RPC.Common+import Neovim.RPC.EventHandler+import Neovim.RPC.FunctionCall (atomically')+import Neovim.RPC.SocketReader+import Neovim.Test +import Control.Concurrent+import Control.Concurrent.STM+import Control.Monad.Reader (runReaderT)+import Control.Monad.State (runStateT)+import qualified Data.Map as Map+import Path+import Path.IO+import System.Exit (ExitCode (..))+import System.Process.Typed --- | Tests in here should always be wrapped in 'withNeovimEmbedded' because they--- don't fail if neovim isn't installed. This is particularly helpful to run--- tests on stackage and be notified if non-neovim-dependent tests fail.--- Basically everybody else who runs these tests has neovim installed and would--- see the test failing.+{- | Tests in here should always be wrapped in 'withNeovimEmbedded' because they+ don't fail if neovim isn't installed. This is particularly helpful to run+ tests on stackage and be notified if non-neovim-dependent tests fail.+ Basically everybody else who runs these tests has neovim installed and would+ see the test failing.+-} spec :: Spec spec = parallel $ do- let withNeovimEmbedded f a = testWithEmbeddedNeovim f (Seconds 3) () a- describe "Read hello test file" .- it "should match 'Hello, World!'" . withNeovimEmbedded Nothing $ do- nvim_command "edit test-files/hello"- bs <- vim_get_buffers- l <- vim_get_current_line- liftIO $ l `shouldBe` "Hello, World!"- liftIO $ length bs `shouldBe` 1+ let withNeovimEmbedded :: Maybe (Path.Path b File) -> Neovim () a -> IO ()+ withNeovimEmbedded f = testWithEmbeddedNeovim f (Seconds 3) ()+ describe "Read hello test file"+ . it "should match 'Hello, World!'"+ . withNeovimEmbedded Nothing+ $ do+ nvim_command "edit test-files/hello"+ bs <- vim_get_buffers+ l <- vim_get_current_line+ liftIO $ l `shouldBe` "Hello, World!"+ liftIO $ length bs `shouldBe` 1 - describe "New empty buffer test" $ do- it "should contain the test text" . withNeovimEmbedded Nothing $ do- cl0 <- vim_get_current_line- liftIO $ cl0 `shouldBe` ""- bs <- vim_get_buffers- liftIO $ length bs `shouldBe` 1+ describe "New empty buffer test" $ do+ it "should contain the test text" . withNeovimEmbedded Nothing $ do+ cl0 <- vim_get_current_line+ liftIO $ cl0 `shouldBe` ""+ bs <- vim_get_buffers+ liftIO $ length bs `shouldBe` 1 - let testContent = "Test on empty buffer"- vim_set_current_line testContent- cl1 <- vim_get_current_line- liftIO $ cl1 `shouldBe` testContent+ let testContent = "Test on empty buffer"+ vim_set_current_line testContent+ cl1 <- vim_get_current_line+ liftIO $ cl1 `shouldBe` testContent - it "should create a new buffer" . withNeovimEmbedded Nothing $ do- bs0 <- vim_get_buffers- liftIO $ length bs0 `shouldBe` 1- vim_command "new"- bs1 <- vim_get_buffers- liftIO $ length bs1 `shouldBe` 2- vim_command "new"- bs2 <- vim_get_buffers- liftIO $ length bs2 `shouldBe` 3+ it "should create a new buffer" . withNeovimEmbedded Nothing $ do+ bs0 <- vim_get_buffers+ liftIO $ length bs0 `shouldBe` 1+ vim_command "new"+ bs1 <- vim_get_buffers+ liftIO $ length bs1 `shouldBe` 2+ vim_command "new"+ bs2 <- vim_get_buffers+ liftIO $ length bs2 `shouldBe` 3 - it "should set the quickfix list" . withNeovimEmbedded Nothing $ do- let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String- setqflist [q] Replace- q' <- vim_eval "getqflist()"- liftIO $ fromObjectUnsafe q' `shouldBe` [q]+ it "should set the quickfix list" . withNeovimEmbedded Nothing $ do+ let q = quickfixListItem (Left 1) (Left 0) :: QuickfixListItem String+ setqflist [q] Replace+ q' <- vim_eval "getqflist()"+ liftIO $ fromObjectUnsafe q' `shouldBe` [q] - it "throws NeovimException with function that failed as Doc" . withNeovimEmbedded Nothing $ do- let getVariableValue = False <$ vim_get_var "notDefined"- hasTrhownNeovimExceptionWithFunctionName <- getVariableValue `catchNeovimException` \case- ErrorResult f _ -> pure $ docToText f == "vim_get_var"- _ -> pure False- liftIO $ hasTrhownNeovimExceptionWithFunctionName `shouldBe` True+ it "throws NeovimException with function that failed as Doc" . withNeovimEmbedded Nothing $ do+ let getVariableValue = False <$ vim_get_var "notDefined"+ hasTrhownNeovimExceptionWithFunctionName <-+ getVariableValue `catchNeovimException` \case+ ErrorResult f _ -> pure $ docToText f == "vim_get_var"+ _ -> pure False+ liftIO $ hasTrhownNeovimExceptionWithFunctionName `shouldBe` True - it "catches" . withNeovimEmbedded Nothing $ do- let getUndefinedVariable = vim_get_var "notDefined"- functionThatFailed <- getUndefinedVariable `catchNeovimException` \case- ErrorResult f _ -> pure . toObject $ docToText f- _ -> pure ObjectNil- liftIO $ functionThatFailed `shouldBe` toObject ("vim_get_var" :: String)+ it "catches" . withNeovimEmbedded Nothing $ do+ let getUndefinedVariable = vim_get_var "notDefined"+ functionThatFailed <-+ getUndefinedVariable `catchNeovimException` \case+ ErrorResult f _ -> pure . toObject $ docToText f+ _ -> pure ObjectNil+ liftIO $ functionThatFailed `shouldBe` toObject ("vim_get_var" :: String)
+ test-suite/Neovim/EventSubscriptionSpec.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Neovim.EventSubscriptionSpec where++import Neovim+import Neovim.API.String+import Neovim.Test++import Test.Hspec++import UnliftIO (newEmptyMVar, putMVar, readMVar)++data BufLinesEvent = BufLinesEvent+ { bleBuffer :: Buffer+ , bleFirstLine :: Int+ , bleLastLine :: Int+ , bleLines :: [String]+ , bleMore :: Bool+ }+ deriving (Eq, Show)++parseBufLinesEvent :: [Object] -> Either (Doc AnsiStyle) BufLinesEvent+parseBufLinesEvent event = case event of+ [buf, _changedTick, firstline, lastline, linedata, more] -> do+ bleBuffer <- fromObject buf+ bleFirstLine <- fromObject firstline+ bleLastLine <- fromObject lastline+ bleLines <- fromObject linedata+ bleMore <- fromObject more+ pure BufLinesEvent{..}+ _ -> Left . pretty $ "Unexpected nvim_buf_lines_event: " ++ show event++spec :: Spec+spec = parallel $ do+ let withNeovimEmbedded = testWithEmbeddedNeovim Nothing (Seconds 2) ()+ describe "Attaching to a buffer" $ do+ it "receives nvim_buf_lines_event" . withNeovimEmbedded $ do+ received <- newEmptyMVar+ subscribe "nvim_buf_lines_event" $ putMVar received . parseBufLinesEvent+ buf <- nvim_create_buf True False+ isOk <- nvim_buf_attach buf True []++ liftIO $ do+ isOk `shouldBe` True+ Right BufLinesEvent{..} <- readMVar received+ bleBuffer `shouldBe` buf+ bleFirstLine `shouldBe` 0+ bleLastLine `shouldBe` -1+ bleLines `shouldBe` [""]+ bleMore `shouldBe` False++ it "receives nvim_buf_detach_event" . withNeovimEmbedded $ do+ received <- newEmptyMVar+ subscribe "nvim_buf_detach_event" $ putMVar received+ buf <- nvim_create_buf True False+ isOk <- nvim_buf_attach buf False []+ nvim_buf_detach buf++ liftIO $ do+ isOk `shouldBe` True+ [buf'] <- readMVar received+ fromObjectUnsafe buf' `shouldBe` buf
test-suite/Neovim/Plugin/ClassesSpec.hs view
@@ -1,20 +1,18 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE RecordWildCards #-}-module Neovim.Plugin.ClassesSpec- where -import Neovim-import Neovim.Plugin.Classes+module Neovim.Plugin.ClassesSpec where -import Test.Hspec-import Test.QuickCheck+import Neovim+import Neovim.Plugin.Classes +import Test.Hspec+import Test.QuickCheck -newtype RandomCommandArguments = RCA { getRandomCommandArguments :: CommandArguments }+newtype RandomCommandArguments = RCA {getRandomCommandArguments :: CommandArguments} deriving (Eq, Ord, Show, Read) - instance Arbitrary RandomCommandArguments where arbitrary = do bang <- arbitrary@@ -23,14 +21,12 @@ register <- fmap (fmap getNonEmpty) arbitrary return . RCA $ CommandArguments{..} --newtype RandomCommandOption = RCO { getRandomCommandOption :: CommandOption }+newtype RandomCommandOption = RCO {getRandomCommandOption :: CommandOption} deriving (Eq, Ord, Show, Read) - instance Arbitrary RandomCommandOption where arbitrary = do- a <- choose (0,5) :: Gen Int+ a <- choose (0, 5) :: Gen Int o <- case a of -- XXX Most constructor arguments are not tested anyway, so they are -- hardcoded for now.@@ -42,30 +38,28 @@ _ -> return CmdBang return $ RCO o --newtype RandomCommandOptions = RCOs { getRandomCommandOptions :: CommandOptions }+newtype RandomCommandOptions = RCOs {getRandomCommandOptions :: CommandOptions} deriving (Eq, Ord, Show, Read) - instance Arbitrary RandomCommandOptions where arbitrary = do- l <- choose (0,20)+ l <- choose (0, 20) (RCOs . mkCommandOptions . map getRandomCommandOption) <$> vectorOf l arbitrary - spec :: Spec spec = do- describe "Deserializing and serializing" $ do- it "should be id for CommandArguments" . property $ do- \args -> (fromObjectUnsafe . toObject . getRandomCommandArguments) args- `shouldBe` getRandomCommandArguments args-- describe "If a sync option is set for commands" $ do- let isSyncOption = \case- CmdSync _ -> True- _ -> False- it "must be at the head of the list" . property $ do- \(RCOs opts) -> any isSyncOption (getCommandOptions opts) ==> do- length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1- head (getCommandOptions opts) `shouldSatisfy` isSyncOption+ describe "Deserializing and serializing" $ do+ it "should be id for CommandArguments" . property $ do+ \args ->+ (fromObjectUnsafe . toObject . getRandomCommandArguments) args+ `shouldBe` getRandomCommandArguments args + describe "If a sync option is set for commands" $ do+ let isSyncOption = \case+ CmdSync _ -> True+ _ -> False+ it "must be at the head of the list" . property $ do+ \(RCOs opts) ->+ any isSyncOption (getCommandOptions opts) ==> do+ length (filter isSyncOption (getCommandOptions opts)) `shouldBe` 1+ head (getCommandOptions opts) `shouldSatisfy` isSyncOption
test-suite/Neovim/RPC/CommonSpec.hs view
@@ -6,15 +6,15 @@ spec :: Spec spec = do- describe "Parsing of $NVIM environment variable" $ do- it "is a UnixSocket if it doesn't contain a colon" $ do- UnixSocket actual <- parseNvimEnvironmentVariable "/some/file"- actual `shouldBe` "/some/file"- it "is a tcp connection if it contains a colon" $ do- TCP actualPort actualHostname <- parseNvimEnvironmentVariable "localhost:12345"- actualPort `shouldBe` 12345- actualHostname `shouldBe` "localhost"- it "the last number after many colons is the port" $ do- TCP actualPort actualHostname <- parseNvimEnvironmentVariable "the:cake:is:a:lie:777"- actualPort `shouldBe` 777- actualHostname `shouldBe` "the:cake:is:a:lie"+ describe "Parsing of $NVIM environment variable" $ do+ it "is a UnixSocket if it doesn't contain a colon" $ do+ UnixSocket actual <- parseNvimEnvironmentVariable "/some/file"+ actual `shouldBe` "/some/file"+ it "is a tcp connection if it contains a colon" $ do+ TCP actualPort actualHostname <- parseNvimEnvironmentVariable "localhost:12345"+ actualPort `shouldBe` 12345+ actualHostname `shouldBe` "localhost"+ it "the last number after many colons is the port" $ do+ TCP actualPort actualHostname <- parseNvimEnvironmentVariable "the:cake:is:a:lie:777"+ actualPort `shouldBe` 777+ actualHostname `shouldBe` "the:cake:is:a:lie"
test-suite/Neovim/RPC/SocketReaderSpec.hs view
@@ -1,67 +1,77 @@ {-# LANGUAGE OverloadedStrings #-}-module Neovim.RPC.SocketReaderSpec- where -import Neovim-import Neovim.Plugin.Classes-import Neovim.RPC.SocketReader (parseParams)+module Neovim.RPC.SocketReaderSpec where -import Test.Hspec+import Neovim+import Neovim.Plugin.Classes+import Neovim.RPC.SocketReader (parseParams) +import Test.Hspec+ spec :: Spec spec = do- describe "parseParams" $ do-- it "should pass the inner argument list as is for functions" $ do- parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]]- `shouldBe` [ObjectNil, ObjectBinary "ABC"]- parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"]- `shouldBe` [ObjectNil, ObjectBinary "ABC"]- parseParams (Function (F "") Sync) []- `shouldBe` []-- let defCmdArgs = def :: CommandArguments- it "should filter out implicit arguments" $ do- parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))- [ObjectArray []]- `shouldBe` [toObject defCmdArgs]- parseParams (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))- [ObjectArray [ObjectBinary "7", ObjectInt 7]]- `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7]+ describe "parseParams" $ do+ it "should pass the inner argument list as is for functions" $ do+ parseParams (Function (F "") Sync) [ObjectArray [ObjectNil, ObjectBinary "ABC"]]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) [ObjectNil, ObjectBinary "ABC"]+ `shouldBe` [ObjectNil, ObjectBinary "ABC"]+ parseParams (Function (F "") Sync) []+ `shouldBe` [] - it "should set the CommandOptions argument as expected" $ do- parseParams (Command (F "") (mkCommandOptions- [ CmdRange WholeFile, CmdBang, CmdNargs "*"]))- [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil]- , ObjectArray [ObjectInt 1, ObjectInt 12]- , ObjectInt 1- ]- `shouldBe` [ toObject (defCmdArgs { bang = Just True, range = Just (1,12) })- , ObjectBinary "7"- , ObjectBinary "8"- , ObjectNil]+ let defCmdArgs = def :: CommandArguments+ it "should filter out implicit arguments" $ do+ parseParams+ (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray []]+ `shouldBe` [toObject defCmdArgs]+ parseParams+ (Command (F "") (mkCommandOptions [CmdSync Sync, CmdNargs "*"]))+ [ObjectArray [ObjectBinary "7", ObjectInt 7]]+ `shouldBe` [toObject defCmdArgs, ObjectBinary "7", ObjectInt 7] - it "should pass this test" $ do- parseParams (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang]))- [ ObjectArray [ ObjectBinary "me"- , ObjectBinary "up"- , ObjectBinary "before"- , ObjectBinary "you"- , ObjectBinary "go"- , ObjectBinary "go"- ]- , ObjectArray [ ObjectInt 1- , ObjectInt 27- ]- , ObjectInt 0- ]- `shouldBe` [ toObject (defCmdArgs { bang = Just False, range = Just (1,27) })- , ObjectBinary "me"- , ObjectArray [ ObjectBinary "up"- , ObjectBinary "before"- , ObjectBinary "you"- , ObjectBinary "go"- , ObjectBinary "go"- ]- ]+ it "should set the CommandOptions argument as expected" $ do+ parseParams+ ( Command+ (F "")+ ( mkCommandOptions+ [CmdRange WholeFile, CmdBang, CmdNargs "*"]+ )+ )+ [ ObjectArray [ObjectBinary "7", ObjectBinary "8", ObjectNil]+ , ObjectArray [ObjectInt 1, ObjectInt 12]+ , ObjectInt 1+ ]+ `shouldBe` [ toObject (defCmdArgs{bang = Just True, range = Just (1, 12)})+ , ObjectBinary "7"+ , ObjectBinary "8"+ , ObjectNil+ ] + it "should pass this test" $ do+ parseParams+ (Command (F "") (mkCommandOptions [CmdNargs "+", CmdRange WholeFile, CmdBang]))+ [ ObjectArray+ [ ObjectBinary "me"+ , ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ , ObjectArray+ [ ObjectInt 1+ , ObjectInt 27+ ]+ , ObjectInt 0+ ]+ `shouldBe` [ toObject (defCmdArgs{bang = Just False, range = Just (1, 27)})+ , ObjectBinary "me"+ , ObjectArray+ [ ObjectBinary "up"+ , ObjectBinary "before"+ , ObjectBinary "you"+ , ObjectBinary "go"+ , ObjectBinary "go"+ ]+ ]