{-# 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 (
Generic,
Int64,
NFData (..),
Pretty (pretty),
deepseq,
(<+>),
)
import Neovim.Plugin.Classes (FunctionName, NeovimEventId)
import Data.Data (cast)
import Data.Int (Int64)
import Data.MessagePack (Object)
import Data.Time (UTCTime, formatTime, getCurrentTime)
import Data.Time.Locale.Compat (defaultTimeLocale)
import Prettyprinter (hardline, nest, viaShow)
import UnliftIO (
MonadIO (..),
MonadUnliftIO,
TMVar,
TQueue,
Typeable,
atomically,
evaluate,
readTQueue,
writeTQueue,
)
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) = forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast msg
message
writeMessage :: (MonadUnliftIO m, Message message) => TQueue SomeMessage -> message -> m ()
writeMessage :: forall (m :: * -> *) message.
(MonadUnliftIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q message
message = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *) a. MonadIO m => a -> m a
evaluate (forall a. NFData a => a -> ()
rnf message
message)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TQueue a -> a -> STM ()
writeTQueue TQueue SomeMessage
q (forall msg. Message msg => msg -> SomeMessage
SomeMessage message
message)
readSomeMessage :: MonadIO m => TQueue SomeMessage -> m SomeMessage
readSomeMessage :: forall (m :: * -> *).
MonadIO m =>
TQueue SomeMessage -> m SomeMessage
readSomeMessage TQueue SomeMessage
q = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (forall a. TQueue a -> STM a
readTQueue TQueue SomeMessage
q)
data FunctionCall
=
FunctionCall FunctionName [Object] (TMVar (Either Object Object)) UTCTime
deriving (Typeable, 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 forall a b. NFData a => a -> b -> b
`deepseq` [Object]
os forall a b. NFData a => a -> b -> b
`deepseq` TMVar (Either Object Object)
v seq :: forall a b. a -> b -> b
`seq` UTCTime
t forall a b. NFData a => a -> b -> b
`deepseq` ()
instance Message FunctionCall
instance Pretty FunctionCall where
pretty :: forall ann. FunctionCall -> Doc ann
pretty (FunctionCall FunctionName
fname [Object]
args TMVar (Either Object Object)
_ UTCTime
t) =
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
Doc ann
"Function call for:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fname
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow [Object]
args
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Timestamp:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> (forall a ann. Show a => a -> Doc ann
viaShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
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
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
Ord, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
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. 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 :: forall ann. Request -> Doc ann
pretty Request{Int64
[Object]
FunctionName
reqArgs :: [Object]
reqId :: Int64
reqMethod :: FunctionName
reqArgs :: Request -> [Object]
reqId :: Request -> Int64
reqMethod :: Request -> FunctionName
..} =
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
Doc ann
"Request"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#"
forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int64
reqId
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Method:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
reqMethod
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow [Object]
reqArgs
data Notification = Notification
{
Notification -> NeovimEventId
notEvent :: NeovimEventId
,
Notification -> [Object]
notArgs :: [Object]
}
deriving (Notification -> Notification -> Bool
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
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
Ord, Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
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. 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 :: forall ann. Notification -> Doc ann
pretty Notification{[Object]
NeovimEventId
notArgs :: [Object]
notEvent :: NeovimEventId
notArgs :: Notification -> [Object]
notEvent :: Notification -> NeovimEventId
..} =
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
Doc ann
"Notification"
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Event:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty NeovimEventId
notEvent
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Arguments:"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow NeovimEventId
notEvent