{-# 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 (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 msg
message) = msg -> Maybe message
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast msg
message
writeMessage :: (MonadIO m, Message message) => TQueue SomeMessage -> message -> m ()
writeMessage :: TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q message
message = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
() -> IO ()
forall a. a -> IO a
evaluate (message -> ()
forall a. NFData a => a -> ()
rnf message
message)
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue SomeMessage -> SomeMessage -> STM ()
forall a. TQueue a -> a -> STM ()
writeTQueue TQueue SomeMessage
q (message -> SomeMessage
forall msg. Message msg => msg -> SomeMessage
SomeMessage message
message)
readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage
readSomeMessage :: TQueue SomeMessage -> m SomeMessage
readSomeMessage TQueue SomeMessage
q = IO SomeMessage -> m SomeMessage
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SomeMessage -> m SomeMessage)
-> IO SomeMessage -> m SomeMessage
forall a b. (a -> b) -> a -> b
$ STM SomeMessage -> IO SomeMessage
forall a. STM a -> IO a
atomically (TQueue SomeMessage -> STM SomeMessage
forall a. TQueue a -> STM a
readTQueue TQueue SomeMessage
q)
data FunctionCall
= FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime
deriving (Typeable, (forall x. FunctionCall -> Rep FunctionCall x)
-> (forall x. Rep FunctionCall x -> FunctionCall)
-> Generic FunctionCall
forall x. Rep FunctionCall x -> FunctionCall
forall x. FunctionCall -> Rep FunctionCall x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FunctionCall x -> FunctionCall
$cfrom :: forall x. FunctionCall -> Rep FunctionCall x
Generic)
instance NFData FunctionCall where
rnf :: FunctionCall -> ()
rnf (FunctionCall FunctionName
f [Object]
os TMVar (Either Object Object)
v UTCTime
t) = FunctionName
f FunctionName -> [Object] -> [Object]
forall a b. NFData a => a -> b -> b
`deepseq` [Object]
os [Object]
-> TMVar (Either Object Object) -> TMVar (Either Object Object)
forall a b. NFData a => a -> b -> b
`deepseq` TMVar (Either Object Object)
v TMVar (Either Object Object) -> () -> ()
`seq` UTCTime
t UTCTime -> () -> ()
forall a b. NFData a => a -> b -> b
`deepseq` ()
instance Message FunctionCall
instance Pretty FunctionCall where
pretty :: FunctionCall -> Doc ann
pretty (FunctionCall FunctionName
fname [Object]
args TMVar (Either Object Object)
_ UTCTime
t) =
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Function call for:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fname
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Object] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [Object]
args
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Timestamp:"
Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (String -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow (String -> Doc ann) -> (UTCTime -> String) -> UTCTime -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%H:%M:%S (%q)") UTCTime
t
data Request = Request
{ Request -> FunctionName
reqMethod :: FunctionName
, Request -> Int64
reqId :: !Int64
, Request -> [Object]
reqArgs :: [Object]
} deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Eq Request
Eq Request
-> (Request -> Request -> Ordering)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Bool)
-> (Request -> Request -> Request)
-> (Request -> Request -> Request)
-> Ord Request
Request -> Request -> Bool
Request -> Request -> Ordering
Request -> Request -> Request
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Request -> Request -> Request
$cmin :: Request -> Request -> Request
max :: Request -> Request -> Request
$cmax :: Request -> Request -> Request
>= :: Request -> Request -> Bool
$c>= :: Request -> Request -> Bool
> :: Request -> Request -> Bool
$c> :: Request -> Request -> Bool
<= :: Request -> Request -> Bool
$c<= :: Request -> Request -> Bool
< :: Request -> Request -> Bool
$c< :: Request -> Request -> Bool
compare :: Request -> Request -> Ordering
$ccompare :: Request -> Request -> Ordering
$cp1Ord :: Eq Request
Ord, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show, Typeable, (forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Request x -> Request
$cfrom :: forall x. Request -> Rep Request x
Generic)
instance NFData Request
instance Message Request
instance Pretty Request where
pretty :: Request -> Doc ann
pretty Request{Int64
[Object]
FunctionName
reqArgs :: [Object]
reqId :: Int64
reqMethod :: FunctionName
reqArgs :: Request -> [Object]
reqId :: Request -> Int64
reqMethod :: Request -> FunctionName
..} =
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Request" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
reqId
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Method:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
reqMethod
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Object] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [Object]
reqArgs
data Notification = Notification
{ Notification -> FunctionName
notMethod :: FunctionName
, Notification -> [Object]
notArgs :: [Object]
} deriving (Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c== :: Notification -> Notification -> Bool
Eq, Eq Notification
Eq Notification
-> (Notification -> Notification -> Ordering)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Notification)
-> (Notification -> Notification -> Notification)
-> Ord Notification
Notification -> Notification -> Bool
Notification -> Notification -> Ordering
Notification -> Notification -> Notification
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Notification -> Notification -> Notification
$cmin :: Notification -> Notification -> Notification
max :: Notification -> Notification -> Notification
$cmax :: Notification -> Notification -> Notification
>= :: Notification -> Notification -> Bool
$c>= :: Notification -> Notification -> Bool
> :: Notification -> Notification -> Bool
$c> :: Notification -> Notification -> Bool
<= :: Notification -> Notification -> Bool
$c<= :: Notification -> Notification -> Bool
< :: Notification -> Notification -> Bool
$c< :: Notification -> Notification -> Bool
compare :: Notification -> Notification -> Ordering
$ccompare :: Notification -> Notification -> Ordering
$cp1Ord :: Eq Notification
Ord, Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notification] -> ShowS
$cshowList :: [Notification] -> ShowS
show :: Notification -> String
$cshow :: Notification -> String
showsPrec :: Int -> Notification -> ShowS
$cshowsPrec :: Int -> Notification -> ShowS
Show, Typeable, (forall x. Notification -> Rep Notification x)
-> (forall x. Rep Notification x -> Notification)
-> Generic Notification
forall x. Rep Notification x -> Notification
forall x. Notification -> Rep Notification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Notification x -> Notification
$cfrom :: forall x. Notification -> Rep Notification x
Generic)
instance NFData Notification
instance Message Notification
instance Pretty Notification where
pretty :: Notification -> Doc ann
pretty Notification{[Object]
FunctionName
notArgs :: [Object]
notMethod :: FunctionName
notArgs :: Notification -> [Object]
notMethod :: Notification -> FunctionName
..} =
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Notification"
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Method:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FunctionName -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
notMethod
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> [Object] -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow [Object]
notArgs