{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE RecordWildCards #-}
module Neovim.Plugin.IPC.Classes (
SomeMessage(..),
Message(..),
FunctionCall(..),
Request(..),
Notification(..),
writeMessage,
readSomeMessage,
UTCTime,
getCurrentTime,
module Data.Int,
) where
import Neovim.Classes
import Neovim.Plugin.Classes (FunctionName)
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 (Pretty (..), nest, hardline, (<+>), (<>), viaShow)
import Prelude
data SomeMessage = forall msg. Message msg => SomeMessage msg
class (NFData message, Typeable message) => Message message where
fromMessage :: SomeMessage -> Maybe message
fromMessage (SomeMessage message) = cast message
writeMessage :: (MonadIO m, Message message) => TQueue SomeMessage -> message -> m ()
writeMessage q message = liftIO $ do
evaluate (rnf message)
atomically $ writeTQueue q (SomeMessage message)
readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage
readSomeMessage q = liftIO $ atomically (readTQueue q)
data FunctionCall
= 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` ()
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