{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Neovim.Plugin.IPC.Classes (
SomeMessage(..),
Message(..),
FunctionCall(..),
Request(..),
Notification(..),
UTCTime,
getCurrentTime,
module Data.Int,
) where
import Neovim.Classes
import Neovim.Plugin.Classes (FunctionName)
import Control.Concurrent.STM
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 (Pretty (..), nest, hardline, (<+>), (<>), viaShow)
import Prelude
data SomeMessage = forall msg. Message msg => SomeMessage msg
class Typeable message => Message message where
fromMessage :: SomeMessage -> Maybe message
fromMessage (SomeMessage message) = cast message
data FunctionCall
= FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime
deriving (Typeable)
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
data Request = Request
{ reqMethod :: FunctionName
, reqId :: !Int64
, 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
data Notification = Notification
{ notMethod :: FunctionName
, 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