{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module PMS.UI.Notification.DS.Core where
import System.IO
import Control.Monad.Logger
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Lens
import Control.Monad.Reader
import qualified Control.Concurrent.STM as STM
import qualified Data.ByteString.Lazy as B
import Data.Conduit
import Data.Default
import qualified Data.Text as T
import Data.Aeson
import Control.Monad.Except
import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DS.Utility as DM
import qualified PMS.Domain.Model.DM.Constant as DM
import PMS.UI.Notification.DM.Type
app :: AppContext ()
app :: AppContext ()
app = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"app called."
ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> AppContext ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
pipeline
where
pipeline :: ConduitM () Void AppContext ()
pipeline :: ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
pipeline = ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
src ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
work ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
sink
src :: ConduitT () DM.McpNotification AppContext ()
src :: ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
src = AppContext McpNotification
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
McpNotification
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () McpNotification m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift AppContext McpNotification
go ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
McpNotification
-> (McpNotification
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> (a
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b)
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= McpNotification
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
-> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
()
McpNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
src
where
go :: AppContext DM.McpNotification
go :: AppContext McpNotification
go = do
TQueue McpNotification
queue <- Getting
(TQueue McpNotification) DomainData (TQueue McpNotification)
-> DomainData -> TQueue McpNotification
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
(TQueue McpNotification) DomainData (TQueue McpNotification)
Lens' DomainData (TQueue McpNotification)
DM.notificationQueueDomainData (DomainData -> TQueue McpNotification)
-> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
(TQueue McpNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
DomainData
forall (m :: * -> *) a. Monad m => m a -> ReaderT AppData m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
IO McpNotification -> AppContext McpNotification
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO McpNotification -> AppContext McpNotification)
-> IO McpNotification -> AppContext McpNotification
forall a b. (a -> b) -> a -> b
$ STM McpNotification -> IO McpNotification
forall a. STM a -> IO a
STM.atomically (STM McpNotification -> IO McpNotification)
-> STM McpNotification -> IO McpNotification
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification -> STM McpNotification
forall a. TQueue a -> STM a
STM.readTQueue TQueue McpNotification
queue
work :: ConduitT DM.McpNotification DM.JsonRpcNotification AppContext ()
work :: ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
work = ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
(Maybe McpNotification)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
(Maybe McpNotification)
-> (Maybe McpNotification
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> (a
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b)
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just McpNotification
reqBS -> (ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> (ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> (ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> (ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a.
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> (ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a)
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
errHdl (ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ do
AppContext JsonRpcNotification
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
JsonRpcNotification
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT McpNotification JsonRpcNotification m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (McpNotification -> AppContext JsonRpcNotification
go McpNotification
reqBS) ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
JsonRpcNotification
-> (JsonRpcNotification
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> (a
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b)
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= JsonRpcNotification
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
work
Maybe McpNotification
Nothing -> do
$Text
-> Text
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG Text
"work: await returns nothing. skip."
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
work
where
errHdl :: String -> ConduitT DM.McpNotification DM.JsonRpcNotification AppContext ()
errHdl :: ErrorData
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
errHdl ErrorData
msg = do
$Text
-> Text
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG (Text
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> Text
-> ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"work: parse error. skip. " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ErrorData
msg
ConduitT
McpNotification
JsonRpcNotification
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
work
go :: DM.McpNotification -> AppContext DM.JsonRpcNotification
go :: McpNotification -> AppContext JsonRpcNotification
go McpNotification
res = do
JsonRpcNotification
jsonRes <- McpNotification -> AppContext JsonRpcNotification
mcp2json McpNotification
res
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"work: notification: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ JsonRpcNotification -> ErrorData
forall a. Show a => a -> ErrorData
show JsonRpcNotification
jsonRes
JsonRpcNotification -> AppContext JsonRpcNotification
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return JsonRpcNotification
jsonRes
mcp2json :: DM.McpNotification -> AppContext DM.JsonRpcNotification
mcp2json :: McpNotification -> AppContext JsonRpcNotification
mcp2json (DM.McpToolsListChangedNotification McpToolsListChangedNotificationData
dat) = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ McpToolsListChangedNotificationData -> ErrorData
forall a. Show a => a -> ErrorData
show McpToolsListChangedNotificationData
dat
let params :: ByteString
params = McpToolsListChangedNotificationDataParams -> ByteString
forall a. ToJSON a => a -> ByteString
encode (McpToolsListChangedNotificationData
datMcpToolsListChangedNotificationData
-> Getting
McpToolsListChangedNotificationDataParams
McpToolsListChangedNotificationData
McpToolsListChangedNotificationDataParams
-> McpToolsListChangedNotificationDataParams
forall s a. s -> Getting a s a -> a
^.Getting
McpToolsListChangedNotificationDataParams
McpToolsListChangedNotificationData
McpToolsListChangedNotificationDataParams
Lens'
McpToolsListChangedNotificationData
McpToolsListChangedNotificationDataParams
DM.paramsMcpToolsListChangedNotificationData)
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ByteString -> ErrorData
forall a. Show a => a -> ErrorData
show ByteString
params
let json :: JsonRpcNotification
json = JsonRpcNotification
forall a. Default a => a
def {
DM._methodJsonRpcNotification = dat^.DM.methodMcpToolsListChangedNotificationData
, DM._paramsJsonRpcNotification = Just (DM.RawJsonByteString params)
}
JsonRpcNotification -> AppContext JsonRpcNotification
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return JsonRpcNotification
json
mcp2json (DM.McpPromptsListChangedNotification McpPromptsListChangedNotificationData
dat) = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ McpPromptsListChangedNotificationData -> ErrorData
forall a. Show a => a -> ErrorData
show McpPromptsListChangedNotificationData
dat
let params :: ByteString
params = McpPromptsListChangedNotificationDataParams -> ByteString
forall a. ToJSON a => a -> ByteString
encode (McpPromptsListChangedNotificationData
datMcpPromptsListChangedNotificationData
-> Getting
McpPromptsListChangedNotificationDataParams
McpPromptsListChangedNotificationData
McpPromptsListChangedNotificationDataParams
-> McpPromptsListChangedNotificationDataParams
forall s a. s -> Getting a s a -> a
^.Getting
McpPromptsListChangedNotificationDataParams
McpPromptsListChangedNotificationData
McpPromptsListChangedNotificationDataParams
Lens'
McpPromptsListChangedNotificationData
McpPromptsListChangedNotificationDataParams
DM.paramsMcpPromptsListChangedNotificationData)
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ByteString -> ErrorData
forall a. Show a => a -> ErrorData
show ByteString
params
let json :: JsonRpcNotification
json = JsonRpcNotification
forall a. Default a => a
def {
DM._methodJsonRpcNotification = dat^.DM.methodMcpPromptsListChangedNotificationData
, DM._paramsJsonRpcNotification = Just (DM.RawJsonByteString params)
}
JsonRpcNotification -> AppContext JsonRpcNotification
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return JsonRpcNotification
json
mcp2json (DM.McpResourcesListChangedNotification McpResourcesListChangedNotificationData
dat) = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ McpResourcesListChangedNotificationData -> ErrorData
forall a. Show a => a -> ErrorData
show McpResourcesListChangedNotificationData
dat
let params :: ByteString
params = McpResourcesListChangedNotificationDataParams -> ByteString
forall a. ToJSON a => a -> ByteString
encode (McpResourcesListChangedNotificationData
datMcpResourcesListChangedNotificationData
-> Getting
McpResourcesListChangedNotificationDataParams
McpResourcesListChangedNotificationData
McpResourcesListChangedNotificationDataParams
-> McpResourcesListChangedNotificationDataParams
forall s a. s -> Getting a s a -> a
^.Getting
McpResourcesListChangedNotificationDataParams
McpResourcesListChangedNotificationData
McpResourcesListChangedNotificationDataParams
Lens'
McpResourcesListChangedNotificationData
McpResourcesListChangedNotificationDataParams
DM.paramsMcpResourcesListChangedNotificationData)
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"mcp2json: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ByteString -> ErrorData
forall a. Show a => a -> ErrorData
show ByteString
params
let json :: JsonRpcNotification
json = JsonRpcNotification
forall a. Default a => a
def {
DM._methodJsonRpcNotification = dat^.DM.methodMcpResourcesListChangedNotificationData
, DM._paramsJsonRpcNotification = Just (DM.RawJsonByteString params)
}
JsonRpcNotification -> AppContext JsonRpcNotification
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return JsonRpcNotification
json
sink :: ConduitT DM.JsonRpcNotification Void AppContext ()
sink :: ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
sink = ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
(Maybe JsonRpcNotification)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
(Maybe JsonRpcNotification)
-> (Maybe JsonRpcNotification
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
())
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> (a
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b)
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just JsonRpcNotification
req -> AppContext ()
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT JsonRpcNotification Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (JsonRpcNotification -> AppContext ()
go JsonRpcNotification
req) ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
forall a b.
ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
a
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
sink
Maybe JsonRpcNotification
Nothing -> do
$Text
-> Text
-> ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG Text
"sink: await returns nothing. skip."
ConduitT
JsonRpcNotification
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))))
()
sink
where
go :: DM.JsonRpcNotification -> AppContext ()
go :: JsonRpcNotification -> AppContext ()
go JsonRpcNotification
res = do
Handle
hdl <- Getting Handle AppData Handle -> AppData -> Handle
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Handle AppData Handle
Iso' AppData Handle
outputHandleAppData (AppData -> Handle)
-> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
AppData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
Handle
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
AppData
(ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
let bs :: ByteString
bs = JsonRpcNotification -> ByteString
forall a. ToJSON a => a -> ByteString
encode JsonRpcNotification
res
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> Text
T.pack (ErrorData -> Text) -> ErrorData -> Text
forall a b. (a -> b) -> a -> b
$ ErrorData
"sink: notification bs: " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ByteString -> ErrorData
DM.lbs2str ByteString
bs
IO () -> AppContext ()
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPutStr Handle
hdl ByteString
bs
IO () -> AppContext ()
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ Handle -> ByteString -> IO ()
B.hPutStr Handle
hdl ByteString
"\n"
IO () -> AppContext ()
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppContext ()) -> IO () -> AppContext ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
hdl