nvim-hs 0.0.1 → 0.0.2
raw patch · 14 files changed
+490/−96 lines, 14 files
Files
- CHANGELOG.md +14/−0
- TestPlugins.hs +8/−0
- library/Neovim.hs +6/−2
- library/Neovim/API/String.hs +4/−0
- library/Neovim/API/TH.hs +71/−11
- library/Neovim/Classes.hs +61/−6
- library/Neovim/Plugin.hs +16/−7
- library/Neovim/Plugin/Classes.hs +174/−44
- library/Neovim/Plugin/ConfigHelper.hs +3/−4
- library/Neovim/Plugin/ConfigHelper/Internal.hs +23/−4
- library/Neovim/RPC/Common.hs +11/−2
- library/Neovim/RPC/EventHandler.hs +16/−3
- library/Neovim/RPC/SocketReader.hs +80/−11
- nvim-hs.cabal +3/−2
+ CHANGELOG.md view
@@ -0,0 +1,14 @@+# 0.0.2++* Add handling for special command options++ This breaks code that used `command` or `command'` to export+ functionality. You should replace the options with a list+ of `CommandOptions`.++ An export like `$(command' foo) def { cmdSync = Async }` must be redefined+ to `$(command' foo) [CmdSync Async]`.++# 0.0.1++* Usable prototype implementation
TestPlugins.hs view
@@ -23,6 +23,11 @@ { exports = [ EF (Function "Randoom" Sync, randoom) , EF (Function "Const42" Sync, const42) , EF (Function "PingNvimhs" Sync, pingNvimhs)+ , EF (Command "ComplicatedSpecialArgsHandling"+ (mkCommandOptions [ CmdSync Sync, CmdRange WholeFile+ , CmdBang , CmdNargs "+"+ ])+ , complicatedCommand) ] , statefulExports = [((), randomNumbers,@@ -31,6 +36,9 @@ ]) ] }++complicatedCommand :: [Object] -> Neovim r st Object+complicatedCommand = undefined rf :: [Object] -> Neovim cfg [Int16] Object rf _ = do
library/Neovim.hs view
@@ -52,7 +52,9 @@ command', autocmd, Synchronous(..),- CommandOptions(..),+ CommandOption(..),+ RangeSpecification(..),+ CommandArguments(..), AutocmdOptions(..), -- TODO make Neovim a newtype wrapper with MonadReader and MonadState@@ -103,8 +105,10 @@ gets, modify, put) import Neovim.Main (neovim) import Neovim.Plugin.Classes (AutocmdOptions (..),- CommandOptions (..),+ CommandArguments (..),+ CommandOption (CmdSync, CmdRegister, CmdRange, CmdCount, CmdBang), NeovimPlugin (..), Plugin (..),+ RangeSpecification (..), Synchronous (..), wrapPlugin) import Neovim.RPC.FunctionCall (wait, wait', waitErr, waitErr')
library/Neovim/API/String.hs view
@@ -10,6 +10,10 @@ Maintainer : woozletoff@gmail.com Stability : experimental +Note that this module is completely generated. If you're reading this on+hackage, the actual functions of this module may be different from what is+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
library/Neovim/API/TH.hs view
@@ -27,9 +27,11 @@ import Neovim.API.Parser import Neovim.Classes import Neovim.Context-import Neovim.Plugin.Classes (CommandOptions (..),+import Neovim.Plugin.Classes (CommandArguments (..),+ CommandOption (..), ExportedFunctionality (..),- FunctionalityDescription (..))+ FunctionalityDescription (..),+ mkCommandOptions) import Neovim.RPC.FunctionCall import Language.Haskell.TH@@ -48,7 +50,8 @@ import Data.Maybe import Data.MessagePack import Data.Monoid-import Data.Text (pack)+import qualified Data.Set as Set+import Data.Text (Text, pack) import Prelude @@ -262,6 +265,43 @@ in function (toUpper c:cs) functionName +-- | Simply data type used to identify a string-ish type (e.g. 'String', 'Text',+-- 'ByteString' for a value of type.+data ArgType = StringyType+ | ListOfStringyTypes+ | OptionalStringyType+ | CommandArgumentsType+ | OtherType+ deriving (Eq, Ord, Show, Read, Enum, Bounded)+++-- | Given a value of type 'Type', test whether it can be classified according+-- to the constructors of 'ArgType'.+classifyArgType :: Type -> Q ArgType+classifyArgType t = do+ set <- genStringTypesSet+ maybeType <- [t|Maybe|]+ cmdArgsType <- [t|CommandArguments|]+ return $ case t of+ AppT ListT (ConT str) | str `Set.member` set+ -> ListOfStringyTypes++ AppT m (ConT str) | m == maybeType && str `Set.member` set+ -> OptionalStringyType++ ConT str | str `Set.member` set+ -> StringyType+ cmd | cmd == cmdArgsType+ -> CommandArgumentsType++ _ -> OtherType++ where+ genStringTypesSet = do+ types <- sequence [[t|String|],[t|ByteString|],[t|Text|]]+ return $ Set.fromList [ n | ConT n <- types ]++ -- | Similarly to 'function', this function is used to export a command with a -- custom name. --@@ -271,9 +311,29 @@ command customFunctionName@(c:_) functionName | (not . isUpper) c = error $ "Custom command name must start with a capiatl letter: " <> show customFunctionName | otherwise = do- (nargs, fun) <- functionImplementation functionName- [|\copts -> EF (Command (pack $(litE (StringL customFunctionName))) (copts { cmdNargs = nargs }), $(return fun))|]-+ (argTypes, fun) <- functionImplementation functionName+ -- See :help :command-nargs for what the result strings mean+ cts <- mapM classifyArgType argTypes+ case cts of+ (CommandArgumentsType:_) -> return ()+ _ -> error "First argument for a function exported as a command must be CommandArguments!"+ let nargs = case tail cts of+ [] -> [|CmdNargs "0"|]+ [StringyType] -> [|CmdNargs "1"|]+ [OptionalStringyType] -> [|CmdNargs "?"|]+ [ListOfStringyTypes] -> [|CmdNargs "*"|]+ [StringyType, ListOfStringyTypes] -> [|CmdNargs "+"|]+ _ -> error $ unlines+ [ "Trying to generate a command without compatible types."+ , "Due to a limitation burdened on us by vimL, we can only"+ , "use a limited amount type signatures for commands. See"+ , "the documentation for 'command' for am ore thorough"+ , "explanation."+ ]+ [|\copts -> EF (Command+ (pack $(litE (StringL customFunctionName)))+ (mkCommandOptions ($(nargs) : copts))+ , $(return fun))|] -- | Define an exported command. This function works exactly like 'command', but -- it generates the command name by converting the first letter to upper case.@@ -311,7 +371,7 @@ -- _ -> err $ "Wrong number of arguments for add: " ++ show xs -- @ ---functionImplementation :: Name -> Q (Int, Exp)+functionImplementation :: Name -> Q ([Type], Exp) functionImplementation functionName = do fInfo <- reify functionName -- We only need the number of arguments to generate the appropriate function@@ -319,15 +379,15 @@ VarI _ functionType _ _ -> determineNumberOfArguments functionType x -> error $ "Value given to function is (likely) not the name of a function.\n" <> show x- e <- topLevelCase nargs+ e <- topLevelCase (length nargs) return (nargs, e) where- determineNumberOfArguments :: Type -> Int+ determineNumberOfArguments :: Type -> [Type] determineNumberOfArguments ft = case ft of ForallT _ _ t -> determineNumberOfArguments t- AppT (AppT ArrowT _) r -> 1 + determineNumberOfArguments r- _ -> 0+ AppT (AppT ArrowT t) r -> t : determineNumberOfArguments r+ _ -> [] -- \args -> case args of ... topLevelCase :: Int -> Q Exp topLevelCase n = newName "args" >>= \args ->
library/Neovim/Classes.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverlappingInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {- | Module : Neovim.Classes@@ -51,6 +52,7 @@ -- to neovim's interpretation. class NvimObject o where toObject :: o -> Object+ fromObjectUnsafe :: Object -> o fromObjectUnsafe o = case fromObject o of Left e -> error $ unwords@@ -58,92 +60,123 @@ , show o , "(", e, ")" ] Right obj -> obj+ fromObject :: (NvimObject o) => Object -> Either String o fromObject = return . fromObjectUnsafe + -- Instances for NvimObject {{{1 instance NvimObject () where toObject _ = ObjectNil+ fromObject ObjectNil = return () fromObject o = throwError $ "Expected ObjectNil, but got " <> show o + -- We may receive truthy values from neovim, so we should be more forgiving -- here. instance NvimObject Bool where- toObject = ObjectBool- fromObject (ObjectBool o) = return o- fromObject (ObjectInt 0) = return False- fromObject ObjectNil = return False- fromObject _ = return True+ toObject = ObjectBool + fromObject (ObjectBool o) = return o+ fromObject (ObjectInt 0) = return False+ fromObject ObjectNil = return False+ fromObject (ObjectBinary "0") = return False+ fromObject (ObjectBinary "") = return False+ fromObject (ObjectString "0") = return False+ fromObject (ObjectString "") = return False+ fromObject _ = return True++ instance NvimObject Double where toObject = ObjectDouble+ fromObject (ObjectDouble o) = return o fromObject (ObjectFloat o) = return $ realToFrac o fromObject (ObjectInt o) = return $ fromIntegral o fromObject o = throwError $ "Expected ObjectDouble, but got " <> show o + instance NvimObject Integer where toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt o) = return $ toInteger o fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o fromObject o = throwError $ "Expected ObjectInt, but got " <> show o + instance NvimObject Int64 where toObject = ObjectInt+ fromObject (ObjectInt i) = return i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o fromObject o = throwError $ "Expected any Integer value, but got " <> show o + instance NvimObject Int32 where toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o fromObject o = throwError $ "Expected any Integer value, but got " <> show o + instance NvimObject Int16 where toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o fromObject o = throwError $ "Expected any Integer value, but got " <> show o + instance NvimObject Int where toObject = ObjectInt . fromIntegral+ fromObject (ObjectInt i) = return $ fromIntegral i fromObject (ObjectDouble o) = return $ round o fromObject (ObjectFloat o) = return $ round o fromObject o = throwError $ "Expected any Integer value, but got " <> show o + instance NvimObject Char where toObject c = ObjectBinary . U.fromString $ [c]+ fromObject str = case fromObject str of Right [c] -> return c _ -> throwError $ "Expected one element string but got: " <> show str + instance NvimObject [Char] where toObject = ObjectBinary . U.fromString+ fromObject (ObjectBinary o) = return $ U.toString o fromObject (ObjectString o) = return $ U.toString o fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + instance NvimObject o => NvimObject [o] where toObject = ObjectArray . map toObject- fromObject (ObjectArray os) = return $ map fromObjectUnsafe os++ fromObject (ObjectArray os) = mapM fromObject os fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (Maybe o) where toObject = maybe ObjectNil toObject+ fromObject ObjectNil = return Nothing fromObject o = either throwError (return . Just) $ fromObject o + instance (Ord key, NvimObject key, NvimObject val) => NvimObject (Map key val) where toObject = ObjectMap . Map.fromList . map (toObject *** toObject) . Map.toList+ fromObject (ObjectMap om) = Map.fromList <$> (sequenceA . map (uncurry (liftA2 (,))@@ -152,25 +185,33 @@ fromObject o = throwError $ "Expected ObjectMap, but got " <> show o + instance NvimObject Text where toObject = ObjectBinary . encodeUtf8+ fromObject (ObjectBinary o) = return $ decodeUtf8 o fromObject (ObjectString o) = return $ decodeUtf8 o fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + instance NvimObject ByteString where toObject = ObjectBinary+ fromObject (ObjectBinary o) = return o fromObject o = throwError $ "Expected ObjectBinary, but got " <> show o + instance NvimObject Object where toObject = id+ fromObject = return fromObjectUnsafe = id + -- By the magic of vim, i will create these. instance NvimObject o => NvimObject (o, o) where toObject (o1, o2) = ObjectArray $ map toObject [o1, o2]+ fromObject (ObjectArray [o1, o2]) = (,) <$> fromObject o1 <*> fromObject o2@@ -178,14 +219,17 @@ instance NvimObject o => NvimObject (o, o, o) where toObject (o1, o2, o3) = ObjectArray $ map toObject [o1, o2, o3]+ fromObject (ObjectArray [o1, o2, o3]) = (,,) <$> fromObject o1 <*> fromObject o2 <*> fromObject o3 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o) where toObject (o1, o2, o3, o4) = ObjectArray $ map toObject [o1, o2, o3, o4]+ fromObject (ObjectArray [o1, o2, o3, o4]) = (,,,) <$> fromObject o1 <*> fromObject o2@@ -193,8 +237,10 @@ <*> fromObject o4 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o, o) where toObject (o1, o2, o3, o4, o5) = ObjectArray $ map toObject [o1, o2, o3, o4, o5]+ fromObject (ObjectArray [o1, o2, o3, o4, o5]) = (,,,,) <$> fromObject o1 <*> fromObject o2@@ -203,8 +249,10 @@ <*> fromObject o5 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o, o, o) where toObject (o1, o2, o3, o4, o5, o6) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6]+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6]) = (,,,,,) <$> fromObject o1 <*> fromObject o2@@ -214,8 +262,10 @@ <*> fromObject o6 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o, o, o, o) where toObject (o1, o2, o3, o4, o5, o6, o7) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7]+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7]) = (,,,,,,) <$> fromObject o1 <*> fromObject o2@@ -226,8 +276,10 @@ <*> fromObject o7 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o) where toObject (o1, o2, o3, o4, o5, o6, o7, o8) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, o8]+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8]) = (,,,,,,,) <$> fromObject o1 <*> fromObject o2@@ -239,8 +291,10 @@ <*> fromObject o8 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o + instance NvimObject o => NvimObject (o, o, o, o, o, o, o, o, o) where toObject (o1, o2, o3, o4, o5, o6, o7, o8, o9) = ObjectArray $ map toObject [o1, o2, o3, o4, o5, o6, o7, o8, o9]+ fromObject (ObjectArray [o1, o2, o3, o4, o5, o6, o7, o8, o9]) = (,,,,,,,,) <$> fromObject o1 <*> fromObject o2@@ -252,5 +306,6 @@ <*> fromObject o8 <*> fromObject o9 fromObject o = throwError $ "Expected ObjectArray, but got " <> show o+ -- 1}}}
library/Neovim/Plugin.hs view
@@ -18,25 +18,24 @@ NeovimPlugin, Plugin(..), Synchronous(..),- CommandOptions(..),+ CommandOption(..), ) where import Neovim.API.String import Neovim.Classes import Neovim.Context-import Neovim.Plugin.Classes+import Neovim.Plugin.Classes hiding (register) import Neovim.Plugin.IPC import Neovim.Plugin.IPC.Internal import Neovim.RPC.Common import Neovim.RPC.FunctionCall -import Control.Arrow (first, (&&&))+import Control.Arrow ((&&&)) import Control.Concurrent (ThreadId) import Control.Concurrent.STM import Control.Exception.Lifted (SomeException, try) import Control.Monad (foldM, forM, void) import qualified Control.Monad.Reader as R-import Data.ByteString (ByteString) import Data.Foldable (forM_) import qualified Data.Map as Map import Data.MessagePack@@ -69,26 +68,34 @@ map (getDescription &&& Stateless . getFunction) $ exports p functionsToRegister = statefulFunctionsToRegister ++ statelessFunctionsToRegister mapM_ (registerWithNeovim . fst) functionsToRegister- return $ map (first name) functionsToRegister+ return $ map (\(d,f) -> (name d, (d, f))) functionsToRegister liftIO . atomically . putTMVar sem . Map.fromList $ concat registeredFunctions + registerWithNeovim :: FunctionalityDescription -> Neovim customConfig () () registerWithNeovim = \case Function functionName s -> do pName <- R.asks _providerName ret <- wait $ vim_call_function "remote#define#FunctionOnHost" [ toObject pName, toObject functionName, toObject s- , toObject functionName, toObject (Map.empty :: Map.Map ByteString Object)+ , toObject functionName, toObject (Map.empty :: Dictionary) ] case ret of Left e -> liftIO . errorM logger $ "Failed to register function: " ++ unpack functionName ++ show e Right _ -> liftIO . debugM logger $ "Registered function: " ++ unpack functionName+ Command 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+ pName <- R.asks _providerName ret <- wait $ vim_call_function "remote#define#CommandOnHost"- [ toObject pName, toObject functionName, toObject (cmdSync copts)+ [ toObject pName, toObject functionName, toObject sync , toObject functionName, toObject copts ] case ret of@@ -96,6 +103,7 @@ "Failed to register command: " ++ unpack functionName ++ show e Right _ -> liftIO . debugM logger $ "Registered command: " ++ unpack functionName+ Autocmd acmdType functionName opts -> do pName <- R.asks _providerName ret <- wait $ vim_call_function "remote#define#AutocmdOnHost"@@ -107,6 +115,7 @@ "Failed to register autocmd: " ++ unpack functionName ++ show e Right _ -> liftIO . debugM logger $ "Registered autocmd: " ++ unpack functionName+ -- | Create a listening thread for events and add update the 'FunctionMap' with -- the corresponding 'TQueue's (i.e. communication channels).
library/Neovim/Plugin/Classes.hs view
@@ -23,18 +23,28 @@ Plugin(..), wrapPlugin, Synchronous(..),- CommandOptions(..),+ CommandOption(..),+ RangeSpecification(..),+ CommandArguments(..),+ getCommandOptions,+ mkCommandOptions, AutocmdOptions(..), ) where import Neovim.Classes import Neovim.Context +import Control.Applicative ((<$>))+import Data.Char (isDigit) import Data.Default-import qualified Data.Map as Map+import Data.List (groupBy, sort)+import qualified Data.Map as Map import Data.Maybe import Data.MessagePack-import Data.Text (Text)+import Data.String+import Data.Text (Text)+import Data.Traversable (sequence)+import Prelude hiding (sequence) -- | This data type is used in the plugin registration to properly register the -- functions.@@ -104,9 +114,13 @@ deriving (Show, Read, Eq, Ord, Enum) -instance Default Synchronous where- def = Sync+instance IsString Synchronous where+ fromString = \case+ "sync" -> Sync+ "async" -> Async+ _ -> error "Only \"sync\" and \"async\" are valid string representations" + instance NvimObject Synchronous where toObject = \case Async -> toObject False@@ -119,64 +133,180 @@ _ -> return Sync --- | Options that can be optionally set for commands.+-- | Options for commands. ----- TODO Determine which of these make sense, how they are transmitted back and--- which options are still missing.--- (see remote#define#CommandOnHost in runtime\/autoload\/remote\/define.vim))-data CommandOptions = CommandOptions- { cmdSync :: Synchronous- -- ^ Option to indicate whether vim shuould block until the command has- -- completed. (default: 'Sync')+-- 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+ -- ^ Should neovim wait for an answer ('Sync')?+ --+ -- Stringliteral: \"sync\" or "\async\" - , cmdRange :: Maybe Text- -- ^ Vim expression for the range (or count). (default: \"\")+ | CmdRegister+ -- ^ Register passed to the command.+ --+ -- Stringliteral: \"\"\" - , cmdCount :: Bool- -- ^ If true,+ | 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. - , cmdNargs :: Int- -- ^ Number of arguments. Note that all arguments have to be a string type.- --- -- TODO Check this in the Template Haskell functions.- --- -- If you're using the template haskell functions for registering commands,- -- this field is overridden by it.+ | CmdRange RangeSpecification+ -- ^ Determines how neovim passes the range.+ --+ -- Stringliterals: \"%\" for 'WholeFile', \",\" for line+ -- and \",123\" for 123 lines. - , cmdBang :: Bool- -- ^ Behavior changes when using a bang.- }- deriving (Show, Read, Eq, Ord)+ | CmdCount Int+ -- ^ Command handles a count. The argument defines the+ -- default count.+ --+ -- Stringliteral: string of numbers (e.g. "132") + | CmdBang+ -- ^ Command handles a bang+ --+ -- Stringliteral: \"!\" -instance Default CommandOptions where- def = CommandOptions- { cmdSync = Sync- , cmdRange = Nothing- , cmdCount = False- , cmdNargs = 0- , cmdBang = False- }+ deriving (Eq, Ord, Show, Read) +instance IsString CommandOption where+ fromString = \case+ "%" -> CmdRange WholeFile+ "\"" -> CmdRegister+ "!" -> CmdBang+ "sync" -> CmdSync Sync+ "async" -> CmdSync Async+ "," -> 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!"++-- | 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)+++mkCommandOptions :: [CommandOption] -> CommandOptions+mkCommandOptions = CommandOptions . map head . groupBy constructor . sort+ where+ 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+ -- 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++ instance NvimObject CommandOptions where- toObject (CommandOptions{..}) =- (toObject :: Dictionary -> Object) . Map.fromList . catMaybes $- [ cmdRange >>= \r -> Just ("range", toObject r)- , if cmdCount then Just ("count", toObject True) else Nothing- , if cmdNargs > 0 then Just ("nargs", toObject cmdNargs) else Nothing- , if cmdBang then Just ("bang", toObject True) else Nothing- ]+ 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)+ _ -> Nothing+ fromObject o = throwError $ "Did not expect to receive a CommandOptions object: " ++ show o +data RangeSpecification = CurrentLine+ | WholeFile+ | RangeCount Int+ deriving (Eq, Ord, Show, Read)+++instance NvimObject RangeSpecification where+ toObject = \case+ CurrentLine -> ObjectBinary ""+ WholeFile -> ObjectBinary "%"+ RangeCount n -> toObject n+++-- | 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.+ --+ -- Examples:+ -- * @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.+ }+ deriving (Eq, Ord, Show, Read)+++instance Default CommandArguments where+ 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)+ ]++ fromObject (ObjectMap m) = do+ let l key = sequence (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: " ++ show o++ data AutocmdOptions = AutocmdOptions { acmdSync :: Synchronous -- ^ Option to indicate whether vim shuould block until the function has -- completed. (default: 'Sync') - , acmdPattern :: Text+ , acmdPattern :: String -- ^ Pattern to match on. (default: \"*\") , acmdNested :: Bool
library/Neovim/Plugin/ConfigHelper.hs view
@@ -20,7 +20,6 @@ import Neovim.Config import Neovim.Plugin.Classes import Neovim.Plugin.ConfigHelper.Internal-import Data.Text (pack) -- | Note that you cannot really use this plugin by hand. It is automatically -- loaded for all Neovim instances.@@ -30,18 +29,18 @@ wrapPlugin Plugin { exports = [ $(function' 'pingNvimhs) Sync- , $(command' 'restartNvimhs) def { cmdSync = Async } ] , statefulExports = [ (params, [], [ $(autocmd 'recompileNvimhs) "BufWritePost" def { acmdSync = Async- , acmdPattern = pack cfgFile+ , acmdPattern = cfgFile } , $(autocmd 'recompileNvimhs) "BufWritePost" def { acmdSync = Async- , acmdPattern = pack (libsDir++"/.*")+ , acmdPattern = libsDir++"/*" }+ , $(command' 'restartNvimhs) [CmdSync Async, CmdBang, CmdRegister] ]) ] }
library/Neovim/Plugin/ConfigHelper/Internal.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.Plugin.ConfigHelper.Internal Description : Internals for a config helper plugin that helps recompiling nvim-hs@@ -16,6 +17,7 @@ import Neovim.API.String (vim_command) import Neovim.Config import Neovim.Context+import Neovim.Plugin.Classes import Neovim.Quickfix import Neovim.RPC.FunctionCall @@ -24,14 +26,16 @@ import Control.Applicative hiding (many, (<|>)) import Control.Monad (void) import Data.Char-import Text.Parsec+import Text.Parsec hiding (count) import Text.Parsec.String + -- | Simple function that will return @"Pong"@ if the plugin provider is -- running. pingNvimhs :: Neovim' String pingNvimhs = return "Pong" + -- | Recompile the plugin provider and put comile errors in the quickfix list. recompileNvimhs :: Neovim (Params NeovimConfig) [QuickfixListItem String] () recompileNvimhs = do@@ -42,13 +46,20 @@ setqflist qs Replace wait' $ vim_command "cwindow" + -- | Note that restarting the plugin provider implies compilation because Dyre -- does this automatically. However, if the recompilation fails, the previously -- compiled bynary is executed. This essentially means that restarting may take -- more time then you might expect.-restartNvimhs :: Neovim r st ()-restartNvimhs = restart+restartNvimhs :: CommandArguments+ -> Neovim (Params NeovimConfig) [QuickfixListItem String] ()+restartNvimhs CommandArguments{..} = do+ case bang of+ Just True -> recompileNvimhs+ _ -> return ()+ restart +-- Parsing {{{1 -- See the tests in @test-suite\/Neovim\/Plugin\/ConfigHelperSpec.hs@ on how the -- error messages look like. parseQuickfixItems :: String -> [QuickfixListItem String]@@ -57,6 +68,7 @@ Right qs -> qs Left _ -> [] + pQuickfixListItem :: Parser (QuickfixListItem String) pQuickfixListItem = do _ <- many blankLine@@ -68,22 +80,27 @@ , errorType = "E" -- TODO determine actual type } + pShortDesrciption :: Parser String pShortDesrciption = (:) <$> (many spaceChar *> notFollowedBy blankLine *> anyChar) <*> anyChar `manyTill` (void (many1 blankLine) <|> eof) + pLongDescription :: Parser String pLongDescription = anyChar `manyTill` (blank <|> eof) where blank = try (try newline *> try blankLine) + spaceChar :: Parser Char spaceChar = satisfy $ \c -> c == ' ' || c == '\t' + blankLine :: Parser () blankLine = void . try $ many spaceChar >> newline + -- | Skip anything until the next location information appears. -- -- The result will be a triple of filename, line number and column@@ -97,5 +114,7 @@ <*> pInt <* char ':' <*> pInt <* char ':' <* many spaceChar + pInt :: Parser Int pInt = read <$> many1 (satisfy isDigit)+-- 1}}}
library/Neovim/RPC/Common.hs view
@@ -15,6 +15,8 @@ where import Neovim.Context+import Neovim.Plugin.IPC+import Neovim.Plugin.Classes (FunctionalityDescription) import Control.Applicative import Control.Concurrent.STM@@ -27,7 +29,6 @@ import Data.String import Data.Text (Text) import Data.Time-import Neovim.Plugin.IPC import Network.Socket as N hiding (SocketType) import System.Environment (getEnv) import System.IO (BufferMode (..), Handle, IOMode,@@ -48,11 +49,19 @@ -- state is stored for as long as the plugin provider is running and not -- restarted.) type FunctionMap =- Map Text FunctionType+ Map Text (FunctionalityDescription, FunctionType) ++-- | This data type is used to dispatch a remote function call to the appopriate+-- recipient. data FunctionType = Stateless ([Object] -> Neovim' Object)+ -- ^ 'Stateless' functions are simply executed with the sent arguments.+ | Stateful (TQueue SomeMessage)+ -- ^ 'Stateful' functions are handled within a special thread, the 'TQueue'+ -- is the communication endpoint for the arguments we have to pass.+ -- | Things shared between the socket reader and the event handler. data RPCConfig = RPCConfig
library/Neovim/RPC/EventHandler.hs view
@@ -33,9 +33,11 @@ import Data.MessagePack import Data.Serialize (encode) import System.IO (IOMode (WriteMode))+import System.Log.Logger import Prelude + -- | This function will establish a connection to the given socket and write -- msgpack-rpc requests to it. runEventHandler :: SocketType@@ -48,25 +50,36 @@ $= eventHandler $$ addCleanup (cleanUpHandle h) (sinkHandle h) + -- | Convenient monad transformer stack for the event handler newtype EventHandler a = EventHandler (ResourceT (ReaderT (ConfigWrapper RPCConfig) (StateT Int64 IO)) a) deriving ( Functor, Applicative, Monad, MonadState Int64, MonadIO , MonadReader (ConfigWrapper RPCConfig)) + runEventHandlerContext :: ConfigWrapper RPCConfig -> EventHandler a -> IO a runEventHandlerContext env (EventHandler a) = evalStateT (runReaderT (runResourceT a) env) 1 + eventHandlerSource :: Source EventHandler SomeMessage eventHandlerSource = asks _eventQueue >>= \q -> forever $ yield =<< atomically' (readTQueue q) + eventHandler :: ConduitM SomeMessage ByteString EventHandler () eventHandler = await >>= \case Nothing -> return () -- i.e. close the conduit -- TODO signal shutdown globally Just message -> handleMessage (fromMessage message) >> eventHandler ++yield' :: (MonadIO io) => Object -> ConduitM i ByteString io ()+yield' o = do+ liftIO . debugM "EventHandler" $ "Sending: " ++ show o+ yield $ encode o++ handleMessage :: Maybe RPCMessage -> ConduitM i ByteString EventHandler () handleMessage = \case Just (FunctionCall fn params reply time) -> do@@ -74,21 +87,21 @@ modify succ rs <- asks (recipients . customConfig) atomically' . modifyTVar rs $ Map.insert i (time, reply)- yield . encode $ ObjectArray+ yield' $ ObjectArray [ toObject (0 :: Int64) , ObjectInt i , toObject fn , toObject params ] Just (Response i e res) ->- yield . encode $ ObjectArray+ yield' $ ObjectArray [ toObject (1 :: Int64) , ObjectInt i , toObject e , toObject res ] Just (NotificationCall fn params) ->- yield . encode $ ObjectArray+ yield' $ ObjectArray [ ObjectInt 2 , toObject fn , toObject params
library/Neovim/RPC/SocketReader.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-} {- | Module : Neovim.RPC.SocketReader Description : The component which reads RPC messages from the neovim instance@@ -13,10 +14,15 @@ -} module Neovim.RPC.SocketReader ( runSocketReader,+ parseParams, ) where import Neovim.Classes import Neovim.Context hiding (ask, asks)+import Neovim.Plugin.Classes (CommandArguments (..),+ CommandOption (..),+ FunctionalityDescription (..),+ getCommandOptions) import Neovim.Plugin.IPC import Neovim.Plugin.IPC.Internal import Neovim.RPC.Common@@ -27,11 +33,12 @@ import Control.Concurrent.STM import Control.Monad (void) import Control.Monad.Reader (MonadReader, ask, asks)-import Control.Monad.Trans.Resource+import Control.Monad.Trans.Resource hiding (register) import Data.Conduit as C import Data.Conduit.Binary import Data.Conduit.Cereal-import Data.Foldable (forM_)+import Data.Default (def)+import Data.Foldable (foldl', forM_) import qualified Data.Map as Map import Data.MessagePack import Data.Monoid@@ -122,7 +129,7 @@ Right m -> void . liftIO . forkIO . handle m =<< ask where- lookupFunction :: Text -> RPCConfig -> STM (Maybe FunctionType)+ lookupFunction :: Text -> RPCConfig -> STM (Maybe (FunctionalityDescription, FunctionType)) lookupFunction m rpc = Map.lookup m <$> readTMVar (functions rpc) handle m rpc = atomically (lookupFunction m (customConfig rpc)) >>= \case@@ -131,16 +138,16 @@ debugM logger errM forM_ mi $ \i -> atomically' . writeTQueue (_eventQueue rpc) . SomeMessage $ Response i (toObject errM) ObjectNil- Just (Stateless f) -> do+ Just (copts, Stateless f) -> do liftIO . debugM logger $ "Executing stateless function with ID: " <> show mi -- Stateless function: Create a boring state object for the -- Neovim context. -- drop the state of the result with (fmap fst <$>)- res <- fmap fst <$> runNeovim (rpc { customConfig = () }) () (f $ parseParams params)+ res <- fmap fst <$> runNeovim (rpc { customConfig = () }) () (f $ parseParams copts params) -- Send the result to the event handler forM_ mi $ \i -> atomically' . writeTQueue (_eventQueue rpc) . SomeMessage . uncurry (Response i) $ responseResult res- Just (Stateful c) -> do+ Just (copts, Stateful c) -> do now <- liftIO getCurrentTime reply <- liftIO newEmptyTMVarIO let q = (recipients . customConfig) rpc@@ -148,9 +155,9 @@ case mi of Just i -> do atomically' . modifyTVar q $ Map.insert i (now, reply)- atomically' . writeTQueue c . SomeMessage $ Request m i (parseParams params)+ atomically' . writeTQueue c . SomeMessage $ Request m i (parseParams copts params) Nothing ->- atomically' . writeTQueue c . SomeMessage $ Notification m (parseParams params)+ atomically' . writeTQueue c . SomeMessage $ Notification m (parseParams copts params) responseResult (Left !e) = (toObject e, ObjectNil) responseResult (Right !res) = (ObjectNil, toObject res) @@ -158,8 +165,8 @@ "Parmaeters in request are not in an object array: " <> show params -- TODO implement proper handling for additional parameters-parseParams :: [Object] -> [Object]-parseParams = \case+parseParams :: FunctionalityDescription -> [Object] -> [Object]+parseParams (Function _ _) args = case args of -- Defining a function on the remote host creates a function that, that -- passes all arguments in a list. At the time of this writing, no other -- arguments are passed for such a function.@@ -167,7 +174,69 @@ -- The function generating the function on neovim side is called: -- @remote#define#FunctionOnHost@ [ObjectArray fArgs] -> fArgs- args -> 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]+ where+ isPassedViaRPC :: CommandOption -> Bool+ isPassedViaRPC = \case+ 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 old@(c, args') = \case+ (CmdRange _, 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++ (CmdBang, o) ->+ either (const old) (\b -> (c { bang = Just b }, args')) $ fromObject o++ (CmdNargs "*", ObjectArray os) ->+ -- CommadnArguments -> [String] -> Neovim r st a+ (c, 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++ _ -> old++parseParams (Autocmd _ _ _) args = case args of+ [ObjectArray fArgs] -> fArgs+ _ -> args handleNotification :: Int64 -> Object -> Object -> Sink a SocketHandler ()
nvim-hs.cabal view
@@ -1,5 +1,5 @@ name: nvim-hs-version: 0.0.1+version: 0.0.2 synopsis: Haskell plugin backend for neovim description: This package provides a plugin provider for neovim. It allows you to write@@ -30,6 +30,7 @@ , test-files/compile-error-for-quickfix-test4 , test-files/compile-error-for-quickfix-test5 , test-files/hello+ , CHANGELOG.md source-repository head type: git location: https://github.com/saep/nvim-hs@@ -106,7 +107,7 @@ test-suite hspec type: exitcode-stdio-1.0- hs-source-dirs: test-suite, library+ hs-source-dirs: test-suite,library main-is: Spec.hs default-language: Haskell2010 build-depends: base