{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}

module PMS.Domain.Service.DS.State.Run.ResourcesList where

import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Logger
import qualified Data.Text as T
import Control.Lens
import Control.Monad.Reader
import qualified Control.Concurrent.STM as STM
import System.FilePath
import System.Directory
import Control.Monad.Except
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8

import qualified PMS.Domain.Model.DM.Type as DM
import qualified PMS.Domain.Model.DM.Constant as DM

import PMS.Domain.Service.DM.Type
import qualified PMS.Domain.Service.DS.Utility as U


-- |
--
instance IStateActivity RunStateData ResourcesListEventData where
  action :: AppState RunStateData
-> Event ResourcesListEventData
-> AppStateContext (Maybe StateTransition)
action AppState RunStateData
_ (ResourcesListEvent (ResourcesListEventData McpResourcesListRequestData
dat)) = (AppStateContext (Maybe StateTransition)
 -> (ErrorData -> AppStateContext (Maybe StateTransition))
 -> AppStateContext (Maybe StateTransition))
-> (ErrorData -> AppStateContext (Maybe StateTransition))
-> AppStateContext (Maybe StateTransition)
-> AppStateContext (Maybe StateTransition)
forall a b c. (a -> b -> c) -> b -> a -> c
flip AppStateContext (Maybe StateTransition)
-> (ErrorData -> AppStateContext (Maybe StateTransition))
-> AppStateContext (Maybe StateTransition)
forall a.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (ErrorData
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ErrorData -> AppStateContext (Maybe StateTransition)
errHdl (AppStateContext (Maybe StateTransition)
 -> AppStateContext (Maybe StateTransition))
-> AppStateContext (Maybe StateTransition)
-> AppStateContext (Maybe StateTransition)
forall a b. (a -> b) -> a -> b
$ do
    $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
logDebugS Text
DM._LOGTAG Text
"Run ResourcesListEvent called."

    ErrorData
resourcesDir <- Getting ErrorData DomainData ErrorData -> DomainData -> ErrorData
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ErrorData DomainData ErrorData
Lens' DomainData ErrorData
DM.resourcesDirDomainData (DomainData -> ErrorData)
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     DomainData
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     ErrorData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) DomainData
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> StateT AppStateW 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

    let resourcesFile :: ErrorData
resourcesFile = ErrorData
resourcesDir ErrorData -> ErrorData -> ErrorData
</> ErrorData
DM._RESOURCES_LIST_FILE
    Bool
exists <- IO Bool
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     Bool
forall a.
IO a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      Bool)
-> IO Bool
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     Bool
forall a b. (a -> b) -> a -> b
$ ErrorData -> IO Bool
doesFileExist ErrorData
resourcesFile
    ByteString
cont <- if Bool
exists
              then ErrorData
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     ByteString
U.readFile ErrorData
resourcesFile
              else do
                $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
logInfoS Text
DM._LOGTAG (Text
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      ())
-> Text
-> StateT
     AppStateW (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
"file not found." ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ErrorData
resourcesFile
                ByteString
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     ByteString
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
"[]"

    ByteString
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
response ByteString
cont
    Maybe StateTransition -> AppStateContext (Maybe StateTransition)
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransition
noStateTransition

    where
      errHdl :: String -> AppContext (Maybe StateTransition)
      errHdl :: ErrorData -> AppStateContext (Maybe StateTransition)
errHdl ErrorData
msg = do
        $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
logErrorS Text
DM._LOGTAG (Text
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      ())
-> Text
-> StateT
     AppStateW (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
"ResourcesListEventData: exception occurred. " ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ErrorData
msg
        ByteString
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
response (ByteString
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      ())
-> ByteString
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
forall a b. (a -> b) -> a -> b
$ ErrorData -> ByteString
BL8.pack ErrorData
msg
        Maybe StateTransition -> AppStateContext (Maybe StateTransition)
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransition
noStateTransition

      response :: BL.ByteString -> AppContext ()
      response :: ByteString
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
response ByteString
cont = do
        let result :: McpResourcesListResponseResult
result = RawJsonByteString -> McpResourcesListResponseResult
DM.McpResourcesListResponseResult (RawJsonByteString -> McpResourcesListResponseResult)
-> RawJsonByteString -> McpResourcesListResponseResult
forall a b. (a -> b) -> a -> b
$ ByteString -> RawJsonByteString
DM.RawJsonByteString ByteString
cont
            jsonRpc :: JsonRpcRequest
jsonRpc = McpResourcesListRequestData
datMcpResourcesListRequestData
-> Getting
     JsonRpcRequest McpResourcesListRequestData JsonRpcRequest
-> JsonRpcRequest
forall s a. s -> Getting a s a -> a
^.Getting JsonRpcRequest McpResourcesListRequestData JsonRpcRequest
Iso' McpResourcesListRequestData JsonRpcRequest
DM.jsonrpcMcpResourcesListRequestData
            resDat :: McpResourcesListResponseData
resDat = JsonRpcRequest
-> McpResourcesListResponseResult -> McpResourcesListResponseData
DM.McpResourcesListResponseData JsonRpcRequest
jsonRpc McpResourcesListResponseResult
result
            res :: McpResponse
res = McpResourcesListResponseData -> McpResponse
DM.McpResourcesListResponse McpResourcesListResponseData
resDat

        $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
logDebugS Text
DM._LOGTAG (Text
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      ())
-> Text
-> StateT
     AppStateW (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
$ McpResponse -> ErrorData
forall a. Show a => a -> ErrorData
show McpResponse
res

        TQueue McpResponse
queue <- Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
-> DomainData -> TQueue McpResponse
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TQueue McpResponse) DomainData (TQueue McpResponse)
Lens' DomainData (TQueue McpResponse)
DM.responseQueueDomainData (DomainData -> TQueue McpResponse)
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     DomainData
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     (TQueue McpResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) DomainData
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     DomainData
forall (m :: * -> *) a. Monad m => m a -> StateT AppStateW 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 ()
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
forall a.
IO a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ()
 -> StateT
      AppStateW
      (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
      ())
-> IO ()
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) ()
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
STM.atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TQueue McpResponse -> McpResponse -> STM ()
forall a. TQueue a -> a -> STM ()
STM.writeTQueue TQueue McpResponse
queue McpResponse
res