{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module PMS.Infra.Watch.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 Data.Conduit
import Data.Default
import qualified Data.Text as T
import Control.Monad.Except
import System.FilePath
import qualified Control.Exception.Safe as E
import qualified System.FSNotify as S
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DM.Constant as DM
import PMS.Infra.Watch.DM.Type
import PMS.Infra.Watch.DS.Utility
app :: AppContext ()
app :: AppContext ()
app = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"app called."
ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> AppContext ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
pipeline
where
pipeline :: ConduitM () Void AppContext ()
pipeline :: ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
pipeline = ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
src ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
()
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (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
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
cmd2task ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (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
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
sink
src :: ConduitT () DM.WatchCommand AppContext ()
src :: ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
src = AppContext WatchCommand
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
WatchCommand
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT () WatchCommand m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift AppContext WatchCommand
go ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
WatchCommand
-> (WatchCommand
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> (a
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b)
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= WatchCommand
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
-> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
()
WatchCommand
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
src
where
go :: AppContext DM.WatchCommand
go :: AppContext WatchCommand
go = do
TQueue WatchCommand
queue <- Getting (TQueue WatchCommand) DomainData (TQueue WatchCommand)
-> DomainData -> TQueue WatchCommand
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue WatchCommand) DomainData (TQueue WatchCommand)
Lens' DomainData (TQueue WatchCommand)
DM.watchQueueDomainData (DomainData -> TQueue WatchCommand)
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TQueue WatchCommand)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
IO WatchCommand -> AppContext WatchCommand
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WatchCommand -> AppContext WatchCommand)
-> IO WatchCommand -> AppContext WatchCommand
forall a b. (a -> b) -> a -> b
$ STM WatchCommand -> IO WatchCommand
forall a. STM a -> IO a
STM.atomically (STM WatchCommand -> IO WatchCommand)
-> STM WatchCommand -> IO WatchCommand
forall a b. (a -> b) -> a -> b
$ TQueue WatchCommand -> STM WatchCommand
forall a. TQueue a -> STM a
STM.readTQueue TQueue WatchCommand
queue
cmd2task :: ConduitT DM.WatchCommand (IOTask ()) AppContext ()
cmd2task :: ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
cmd2task = ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(Maybe WatchCommand)
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(Maybe WatchCommand)
-> (Maybe WatchCommand
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> (a
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b)
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just WatchCommand
cmd -> (ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ([Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ([Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ([Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a.
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> ([Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a)
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError [Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
errHdl (ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ do
AppContext (IOTask ())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(IOTask ())
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT WatchCommand (IOTask ()) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WatchCommand -> AppContext (IOTask ())
go WatchCommand
cmd) ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(IOTask ())
-> (IOTask ()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> (a
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b)
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IOTask ()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
cmd2task
Maybe WatchCommand
Nothing -> do
$Text
-> Text
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG Text
"cmd2task: await returns nothing. skip."
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
cmd2task
where
errHdl :: String -> ConduitT DM.WatchCommand (IOTask ()) AppContext ()
errHdl :: [Char]
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
errHdl [Char]
msg = do
$Text
-> Text
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG (Text
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> Text
-> ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"cmd2task: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
ConduitT
WatchCommand
(IOTask ())
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
cmd2task
go :: DM.WatchCommand -> AppContext (IOTask ())
go :: WatchCommand -> AppContext (IOTask ())
go (DM.EchoWatchCommand EchoWatchCommandData
dat) = EchoWatchCommandData -> AppContext (IOTask ())
genEchoTask EchoWatchCommandData
dat
go (DM.ToolsListWatchCommand ToolsListWatchCommandData
dat) = ToolsListWatchCommandData -> AppContext (IOTask ())
genToolsListWatchTask ToolsListWatchCommandData
dat
go (DM.PromptsListWatchCommand PromptsListWatchCommandData
dat) = PromptsListWatchCommandData -> AppContext (IOTask ())
genPromptsListWatchTask PromptsListWatchCommandData
dat
go (DM.ResourcesListWatchCommand ResourcesListWatchCommandData
dat) = ResourcesListWatchCommandData -> AppContext (IOTask ())
genResourcesListWatchTask ResourcesListWatchCommandData
dat
sink :: ConduitT (IOTask ()) Void AppContext ()
sink :: ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
sink = ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(Maybe (IOTask ()))
forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
(Maybe (IOTask ()))
-> (Maybe (IOTask ())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> (a
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b)
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just IOTask ()
req -> (ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ([Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ([Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ([Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a.
ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> ([Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a)
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError [Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
errHdl (ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ do
AppContext ()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall (m :: * -> *) a.
Monad m =>
m a -> ConduitT (IOTask ()) Void m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOTask () -> AppContext ()
go IOTask ()
req) ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b.
ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
a
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
sink
Maybe (IOTask ())
Nothing -> do
$Text
-> Text
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG Text
"sink: await returns nothing. skip."
ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
sink
where
errHdl :: String -> ConduitT (IOTask ()) Void AppContext ()
errHdl :: [Char]
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
errHdl [Char]
msg = do
$Text
-> Text
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
logWarnS Text
DM._LOGTAG (Text
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
())
-> Text
-> ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"sink: exception occurred. skip. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
msg
ConduitT
(IOTask ())
Void
(ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))))
()
sink
go :: (IO ()) -> AppContext ()
go :: IOTask () -> AppContext ()
go IOTask ()
task = do
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: start task."
IOTask () -> AppContext ()
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE IOTask ()
task
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG Text
"sink: end task."
() -> AppContext ()
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
genEchoTask :: DM.EchoWatchCommandData -> AppContext (IOTask ())
genEchoTask :: EchoWatchCommandData -> AppContext (IOTask ())
genEchoTask EchoWatchCommandData
dat = do
TQueue McpNotification
notiQ <- 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 [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TQueue McpNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
let val :: [Char]
val = EchoWatchCommandData
datEchoWatchCommandData
-> Getting [Char] EchoWatchCommandData [Char] -> [Char]
forall s a. s -> Getting a s a -> a
^.Getting [Char] EchoWatchCommandData [Char]
Lens' EchoWatchCommandData [Char]
DM.valueEchoWatchCommandData
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"echoTask: echo : " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val
IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification
-> EchoWatchCommandData -> [Char] -> IOTask ()
echoTask TQueue McpNotification
notiQ EchoWatchCommandData
dat [Char]
val
echoTask :: STM.TQueue DM.McpNotification -> DM.EchoWatchCommandData -> String -> IOTask ()
echoTask :: TQueue McpNotification
-> EchoWatchCommandData -> [Char] -> IOTask ()
echoTask TQueue McpNotification
notiQ EchoWatchCommandData
_ [Char]
val = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.echoTask run. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
val
let dat :: McpToolsListChangedNotificationData
dat = McpToolsListChangedNotificationData
forall a. Default a => a
def {DM._methodMcpToolsListChangedNotificationData = val}
res :: McpNotification
res = McpToolsListChangedNotificationData -> McpNotification
DM.McpToolsListChangedNotification McpToolsListChangedNotificationData
dat
STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification -> McpNotification -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpNotification
notiQ McpNotification
res
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Watch.DS.Core.echoTask end."
where
errHdl :: E.SomeException -> IO ()
errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.echoTask.errHdl " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
genToolsListWatchTask :: DM.ToolsListWatchCommandData -> AppContext (IOTask ())
genToolsListWatchTask :: ToolsListWatchCommandData -> AppContext (IOTask ())
genToolsListWatchTask ToolsListWatchCommandData
dat = do
[Char]
toolsDir <- Getting [Char] DomainData [Char] -> DomainData -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] DomainData [Char]
Lens' DomainData [Char]
DM.toolsDirDomainData (DomainData -> [Char])
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TQueue McpNotification
notiQ <- 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 [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TQueue McpNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TMVar WatchManager
mgrVar <- Getting (TMVar WatchManager) AppData (TMVar WatchManager)
-> AppData -> TMVar WatchManager
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar WatchManager) AppData (TMVar WatchManager)
Iso' AppData (TMVar WatchManager)
watchManagerAppData (AppData -> TMVar WatchManager)
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TMVar WatchManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
WatchManager
mgr <- IO WatchManager -> AppContext WatchManager
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO WatchManager -> AppContext WatchManager)
-> IO WatchManager -> AppContext WatchManager
forall a b. (a -> b) -> a -> b
$ STM WatchManager -> IO WatchManager
forall a. STM a -> IO a
STM.atomically (STM WatchManager -> IO WatchManager)
-> STM WatchManager -> IO WatchManager
forall a b. (a -> b) -> a -> b
$ TMVar WatchManager -> STM WatchManager
forall a. TMVar a -> STM a
STM.readTMVar TMVar WatchManager
mgrVar
let toolsJ :: [Char]
toolsJ = [Char]
toolsDir [Char] -> [Char] -> [Char]
</> [Char]
DM._TOOLS_LIST_FILE
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"toolsListWatchTask: directory " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
toolsDir
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"toolsListWatchTask: file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
toolsJ
IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification
-> ToolsListWatchCommandData -> WatchManager -> [Char] -> IOTask ()
toolsListWatchTask TQueue McpNotification
notiQ ToolsListWatchCommandData
dat WatchManager
mgr [Char]
toolsDir
toolsListWatchTask :: STM.TQueue DM.McpNotification -> DM.ToolsListWatchCommandData -> S.WatchManager -> String -> IOTask ()
toolsListWatchTask :: TQueue McpNotification
-> ToolsListWatchCommandData -> WatchManager -> [Char] -> IOTask ()
toolsListWatchTask TQueue McpNotification
notiQ ToolsListWatchCommandData
_ WatchManager
mgr [Char]
toolsDir = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.work.toolsListWatchTask run. "
IOTask ()
_stop <- WatchManager
-> [Char] -> ActionPredicate -> Action -> IO (IOTask ())
S.watchTree WatchManager
mgr [Char]
toolsDir ActionPredicate
isToolsListJson Action
onToolsListUpdated
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Watch.DS.Core.toolsListWatchTask end."
where
errHdl :: E.SomeException -> IO ()
errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.Watch.DS.Core.toolsListWatchTask exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
isToolsListJson :: S.Event -> Bool
isToolsListJson :: ActionPredicate
isToolsListJson Event
e = [Char] -> [Char]
takeFileName (Event -> [Char]
S.eventPath Event
e) [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
DM._TOOLS_LIST_FILE
onToolsListUpdated :: S.Event -> IO ()
#ifdef mingw32_HOST_OS
onToolsListUpdated e@S.Modified{} = response $ S.eventPath e
#else
onToolsListUpdated :: Action
onToolsListUpdated e :: Event
e@S.CloseWrite{} = [Char] -> IOTask ()
response ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ Event -> [Char]
S.eventPath Event
e
#endif
onToolsListUpdated Event
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.toolsListWatchTask ignore event: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
e
readToolsList :: FilePath -> IO BL.ByteString
readToolsList :: [Char] -> IO ByteString
readToolsList [Char]
path = do
Text
cont <- [Char] -> IO Text
T.readFile [Char]
path
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> ByteString) -> StrictByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> StrictByteString
TE.encodeUtf8 Text
cont
response :: String -> IO ()
response :: [Char] -> IOTask ()
response [Char]
toolFile = do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.toolsListWatchTask.response called. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
toolFile
ByteString
tools <- [Char] -> IO ByteString
readToolsList [Char]
toolFile
let params :: McpToolsListChangedNotificationDataParams
params = McpToolsListChangedNotificationDataParams
forall a. Default a => a
def {DM._toolsMcpToolsListChangedNotificationDataParams = DM.RawJsonByteString tools}
dat :: McpToolsListChangedNotificationData
dat = McpToolsListChangedNotificationData
forall a. Default a => a
def {DM._paramsMcpToolsListChangedNotificationData = params}
res :: McpNotification
res = McpToolsListChangedNotificationData -> McpNotification
DM.McpToolsListChangedNotification McpToolsListChangedNotificationData
dat
STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification -> McpNotification -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpNotification
notiQ McpNotification
res
genPromptsListWatchTask :: DM.PromptsListWatchCommandData -> AppContext (IOTask ())
genPromptsListWatchTask :: PromptsListWatchCommandData -> AppContext (IOTask ())
genPromptsListWatchTask PromptsListWatchCommandData
dat = do
[Char]
promptsDir <- Getting [Char] DomainData [Char] -> DomainData -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] DomainData [Char]
Lens' DomainData [Char]
DM.promptsDirDomainData (DomainData -> [Char])
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TQueue McpNotification
notiQ <- 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 [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TQueue McpNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TMVar WatchManager
mgrVar <- Getting (TMVar WatchManager) AppData (TMVar WatchManager)
-> AppData -> TMVar WatchManager
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar WatchManager) AppData (TMVar WatchManager)
Iso' AppData (TMVar WatchManager)
watchManagerAppData (AppData -> TMVar WatchManager)
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TMVar WatchManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
WatchManager
mgr <- IO WatchManager -> AppContext WatchManager
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO WatchManager -> AppContext WatchManager)
-> IO WatchManager -> AppContext WatchManager
forall a b. (a -> b) -> a -> b
$ STM WatchManager -> IO WatchManager
forall a. STM a -> IO a
STM.atomically (STM WatchManager -> IO WatchManager)
-> STM WatchManager -> IO WatchManager
forall a b. (a -> b) -> a -> b
$ TMVar WatchManager -> STM WatchManager
forall a. TMVar a -> STM a
STM.readTMVar TMVar WatchManager
mgrVar
let promptsJ :: [Char]
promptsJ = [Char]
promptsDir [Char] -> [Char] -> [Char]
</> [Char]
DM._PROMPTS_LIST_FILE
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"promptsListWatchTask: directory " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
promptsDir
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"promptsListWatchTask: file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
promptsJ
IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification
-> PromptsListWatchCommandData
-> WatchManager
-> [Char]
-> IOTask ()
promptsListWatchTask TQueue McpNotification
notiQ PromptsListWatchCommandData
dat WatchManager
mgr [Char]
promptsDir
promptsListWatchTask :: STM.TQueue DM.McpNotification -> DM.PromptsListWatchCommandData -> S.WatchManager -> String -> IOTask ()
promptsListWatchTask :: TQueue McpNotification
-> PromptsListWatchCommandData
-> WatchManager
-> [Char]
-> IOTask ()
promptsListWatchTask TQueue McpNotification
notiQ PromptsListWatchCommandData
_ WatchManager
mgr [Char]
promptsDir = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.work.promptsListWatchTask run. "
IOTask ()
_stop <- WatchManager
-> [Char] -> ActionPredicate -> Action -> IO (IOTask ())
S.watchTree WatchManager
mgr [Char]
promptsDir ActionPredicate
isTargetFile Action
onPromptsListUpdated
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Watch.DS.Core.promptsListWatchTask end."
where
errHdl :: E.SomeException -> IO ()
errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.Watch.DS.Core.promptsListWatchTask exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
isTargetFile :: S.Event -> Bool
isTargetFile :: ActionPredicate
isTargetFile Event
e =
let file :: [Char]
file = [Char] -> [Char]
takeFileName (Event -> [Char]
S.eventPath Event
e)
ext :: [Char]
ext = [Char] -> [Char]
takeExtension [Char]
file
in [Char]
file [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
DM._PROMPTS_LIST_FILE Bool -> Bool -> Bool
|| [Char]
ext [Char] -> [[Char]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
".md", [Char]
".txt", [Char]
".prompt"]
onPromptsListUpdated :: S.Event -> IO ()
#ifdef mingw32_HOST_OS
onPromptsListUpdated e@S.Modified{} = response $ S.eventPath e
#else
onPromptsListUpdated :: Action
onPromptsListUpdated e :: Event
e@S.CloseWrite{} = [Char] -> IOTask ()
response ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ Event -> [Char]
S.eventPath Event
e
#endif
onPromptsListUpdated Event
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.promptsListWatchTask ignore event: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
e
readPromptsList :: FilePath -> IO BL.ByteString
readPromptsList :: [Char] -> IO ByteString
readPromptsList [Char]
path = do
Text
cont <- [Char] -> IO Text
T.readFile [Char]
path
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> ByteString) -> StrictByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> StrictByteString
TE.encodeUtf8 Text
cont
response :: String -> IO ()
response :: [Char] -> IOTask ()
response [Char]
updateFile = do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.promptsListWatchTask.response called. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
updateFile
let promptsFile :: [Char]
promptsFile = [Char]
promptsDir [Char] -> [Char] -> [Char]
</> [Char]
DM._PROMPTS_LIST_FILE
ByteString
prompts <- [Char] -> IO ByteString
readPromptsList [Char]
promptsFile
let params :: McpPromptsListChangedNotificationDataParams
params = McpPromptsListChangedNotificationDataParams
forall a. Default a => a
def {DM._promptsMcpPromptsListChangedNotificationDataParams = DM.RawJsonByteString prompts}
dat :: McpPromptsListChangedNotificationData
dat = McpPromptsListChangedNotificationData
forall a. Default a => a
def {DM._paramsMcpPromptsListChangedNotificationData = params}
res :: McpNotification
res = McpPromptsListChangedNotificationData -> McpNotification
DM.McpPromptsListChangedNotification McpPromptsListChangedNotificationData
dat
STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification -> McpNotification -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpNotification
notiQ McpNotification
res
genResourcesListWatchTask :: DM.ResourcesListWatchCommandData -> AppContext (IOTask ())
genResourcesListWatchTask :: ResourcesListWatchCommandData -> AppContext (IOTask ())
genResourcesListWatchTask ResourcesListWatchCommandData
dat = do
[Char]
resourcesDir <- Getting [Char] DomainData [Char] -> DomainData -> [Char]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [Char] DomainData [Char]
Lens' DomainData [Char]
DM.resourcesDirDomainData (DomainData -> [Char])
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TQueue McpNotification
notiQ <- 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 [Char] (LoggingT IO)))
DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TQueue McpNotification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT [Char] (LoggingT IO)) DomainData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (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 [Char] (LoggingT IO)) DomainData
forall r (m :: * -> *). MonadReader r m => m r
ask
TMVar WatchManager
mgrVar <- Getting (TMVar WatchManager) AppData (TMVar WatchManager)
-> AppData -> TMVar WatchManager
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TMVar WatchManager) AppData (TMVar WatchManager)
Iso' AppData (TMVar WatchManager)
watchManagerAppData (AppData -> TMVar WatchManager)
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
-> ReaderT
AppData
(ReaderT DomainData (ExceptT [Char] (LoggingT IO)))
(TMVar WatchManager)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) AppData
forall r (m :: * -> *). MonadReader r m => m r
ask
WatchManager
mgr <- IO WatchManager -> AppContext WatchManager
forall a.
IO a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
liftIOE (IO WatchManager -> AppContext WatchManager)
-> IO WatchManager -> AppContext WatchManager
forall a b. (a -> b) -> a -> b
$ STM WatchManager -> IO WatchManager
forall a. STM a -> IO a
STM.atomically (STM WatchManager -> IO WatchManager)
-> STM WatchManager -> IO WatchManager
forall a b. (a -> b) -> a -> b
$ TMVar WatchManager -> STM WatchManager
forall a. TMVar a -> STM a
STM.readTMVar TMVar WatchManager
mgrVar
let resourcesJ :: [Char]
resourcesJ = [Char]
resourcesDir [Char] -> [Char] -> [Char]
</> [Char]
DM._RESOURCES_LIST_FILE
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"resourcesListWatchTask: directory " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
resourcesDir
$Text -> Text -> AppContext ()
logDebugS Text
DM._LOGTAG (Text -> AppContext ()) -> Text -> AppContext ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char]
"resourcesListWatchTask: file " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
resourcesJ
IOTask () -> AppContext (IOTask ())
forall a.
a
-> ReaderT
AppData (ReaderT DomainData (ExceptT [Char] (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (IOTask () -> AppContext (IOTask ()))
-> IOTask () -> AppContext (IOTask ())
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification
-> ResourcesListWatchCommandData
-> WatchManager
-> [Char]
-> IOTask ()
resourcesListWatchTask TQueue McpNotification
notiQ ResourcesListWatchCommandData
dat WatchManager
mgr [Char]
resourcesDir
resourcesListWatchTask :: STM.TQueue DM.McpNotification -> DM.ResourcesListWatchCommandData -> S.WatchManager -> String -> IOTask ()
resourcesListWatchTask :: TQueue McpNotification
-> ResourcesListWatchCommandData
-> WatchManager
-> [Char]
-> IOTask ()
resourcesListWatchTask TQueue McpNotification
notiQ ResourcesListWatchCommandData
_ WatchManager
mgr [Char]
resourcesDir = (IOTask () -> (SomeException -> IOTask ()) -> IOTask ())
-> (SomeException -> IOTask ()) -> IOTask () -> IOTask ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip IOTask () -> (SomeException -> IOTask ()) -> IOTask ()
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny SomeException -> IOTask ()
errHdl (IOTask () -> IOTask ()) -> IOTask () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.work.resourcesListWatchTask run. "
IOTask ()
_stop <- WatchManager
-> [Char] -> ActionPredicate -> Action -> IO (IOTask ())
S.watchTree WatchManager
mgr [Char]
resourcesDir ActionPredicate
isTargetFile Action
onResourcesListUpdated
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr [Char]
"[INFO] PMS.Infra.Watch.DS.Core.resourcesListWatchTask end."
where
errHdl :: E.SomeException -> IO ()
errHdl :: SomeException -> IOTask ()
errHdl SomeException
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[ERROR] PMS.Infra.Watch.DS.Core.resourcesListWatchTask exception occurred. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SomeException -> [Char]
forall a. Show a => a -> [Char]
show SomeException
e
isTargetFile :: S.Event -> Bool
isTargetFile :: ActionPredicate
isTargetFile Event
e =
let file :: [Char]
file = [Char] -> [Char]
takeFileName (Event -> [Char]
S.eventPath Event
e)
in [Char]
file [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== ([Char]
DM._RESOURCES_LIST_FILE) Bool -> Bool -> Bool
|| ([Char]
file [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
DM._RESOURCES_TPL_LIST_FILE)
onResourcesListUpdated :: S.Event -> IO ()
#ifdef mingw32_HOST_OS
onResourcesListUpdated e@S.Modified{} = response $ S.eventPath e
#else
onResourcesListUpdated :: Action
onResourcesListUpdated e :: Event
e@S.CloseWrite{} = [Char] -> IOTask ()
response ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ Event -> [Char]
S.eventPath Event
e
#endif
onResourcesListUpdated Event
e = Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.resourcesListWatchTask ignore event: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Event -> [Char]
forall a. Show a => a -> [Char]
show Event
e
readResourcesList :: FilePath -> IO BL.ByteString
readResourcesList :: [Char] -> IO ByteString
readResourcesList [Char]
path = do
Text
cont <- [Char] -> IO Text
T.readFile [Char]
path
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ StrictByteString -> ByteString
BL.fromStrict (StrictByteString -> ByteString) -> StrictByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> StrictByteString
TE.encodeUtf8 Text
cont
response :: String -> IO ()
response :: [Char] -> IOTask ()
response [Char]
updateFile = do
Handle -> [Char] -> IOTask ()
hPutStrLn Handle
stderr ([Char] -> IOTask ()) -> [Char] -> IOTask ()
forall a b. (a -> b) -> a -> b
$ [Char]
"[INFO] PMS.Infra.Watch.DS.Core.resourcesListWatchTask.response called. " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
updateFile
let resourcesFile :: [Char]
resourcesFile = [Char]
resourcesDir [Char] -> [Char] -> [Char]
</> [Char]
DM._RESOURCES_LIST_FILE
ByteString
resources <- [Char] -> IO ByteString
readResourcesList [Char]
resourcesFile
let params :: McpResourcesListChangedNotificationDataParams
params = McpResourcesListChangedNotificationDataParams
forall a. Default a => a
def {DM._resourcesMcpResourcesListChangedNotificationDataParams = DM.RawJsonByteString resources}
dat :: McpResourcesListChangedNotificationData
dat = McpResourcesListChangedNotificationData
forall a. Default a => a
def {DM._paramsMcpResourcesListChangedNotificationData = params}
res :: McpNotification
res = McpResourcesListChangedNotificationData -> McpNotification
DM.McpResourcesListChangedNotification McpResourcesListChangedNotificationData
dat
STM () -> IOTask ()
forall a. STM a -> IO a
STM.atomically (STM () -> IOTask ()) -> STM () -> IOTask ()
forall a b. (a -> b) -> a -> b
$ TQueue McpNotification -> McpNotification -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpNotification
notiQ McpNotification
res