{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}

module PMS.Domain.Service.DS.Utility where

import Control.Monad.Trans.State.Lazy
import Control.Monad.Except
import Control.Monad.Reader
import System.Log.FastLogger
import qualified Control.Exception.Safe as E
import qualified Data.Text.IO as T
import qualified Data.Text.Encoding as TE
import qualified Data.ByteString.Lazy as BL
import System.Directory
import Control.Monad.Logger
import qualified Control.Concurrent.STM as STM
import Control.Lens
import Data.Default
import qualified Data.Text as T

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.Domain.Service.DM.Type


-- |
--
changeTo :: AppStateW -> AppStateContext ()
changeTo :: AppStateW -> AppStateContext ()
changeTo AppStateW
nextSt = do
  AppStateW
curSt <- StateT
  AppStateW
  (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
  AppStateW
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Maybe StateTransition
_ <- AppStateW -> EventW -> AppStateContext (Maybe StateTransition)
forall s.
IAppStateW s =>
s -> EventW -> AppStateContext (Maybe StateTransition)
actionSW AppStateW
curSt (Event ExitEventData -> EventW
forall r. Event r -> EventW
EventW Event ExitEventData
ExitEvent)

  let req :: EventW
req = Event EntryEventData -> EventW
forall r. Event r -> EventW
EventW Event EntryEventData
EntryEvent
  Maybe StateTransition
_ <- AppStateW -> EventW -> AppStateContext (Maybe StateTransition)
forall s.
IAppStateW s =>
s -> EventW -> AppStateContext (Maybe StateTransition)
actionSW AppStateW
nextSt EventW
req

  (AppStateW -> AppStateW) -> AppStateContext ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (\AppStateW
_ -> AppStateW
nextSt)


-- |
--
runAppState :: DM.DomainData -> AppStateW -> TimedFastLogger -> AppStateContext a -> IO (Either DM.ErrorData (a, AppStateW))
runAppState :: forall a.
DomainData
-> AppStateW
-> TimedFastLogger
-> AppStateContext a
-> IO (Either ErrorData (a, AppStateW))
runAppState DomainData
domDat AppStateW
st TimedFastLogger
logger AppStateContext a
ctx =
  DomainData
-> TimedFastLogger
-> LoggingT IO (Either ErrorData (a, AppStateW))
-> IO (Either ErrorData (a, AppStateW))
forall a. DomainData -> TimedFastLogger -> LoggingT IO a -> IO a
DM.runFastLoggerT DomainData
domDat TimedFastLogger
logger
    (LoggingT IO (Either ErrorData (a, AppStateW))
 -> IO (Either ErrorData (a, AppStateW)))
-> LoggingT IO (Either ErrorData (a, AppStateW))
-> IO (Either ErrorData (a, AppStateW))
forall a b. (a -> b) -> a -> b
$ ExceptT ErrorData (LoggingT IO) (a, AppStateW)
-> LoggingT IO (Either ErrorData (a, AppStateW))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
    (ExceptT ErrorData (LoggingT IO) (a, AppStateW)
 -> LoggingT IO (Either ErrorData (a, AppStateW)))
-> ExceptT ErrorData (LoggingT IO) (a, AppStateW)
-> LoggingT IO (Either ErrorData (a, AppStateW))
forall a b. (a -> b) -> a -> b
$ (ReaderT
   DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
 -> DomainData -> ExceptT ErrorData (LoggingT IO) (a, AppStateW))
-> DomainData
-> ReaderT
     DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
-> ExceptT ErrorData (LoggingT IO) (a, AppStateW)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
-> DomainData -> ExceptT ErrorData (LoggingT IO) (a, AppStateW)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT DomainData
domDat
    (ReaderT
   DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
 -> ExceptT ErrorData (LoggingT IO) (a, AppStateW))
-> ReaderT
     DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
-> ExceptT ErrorData (LoggingT IO) (a, AppStateW)
forall a b. (a -> b) -> a -> b
$ AppStateContext a
-> AppStateW
-> ReaderT
     DomainData (ExceptT ErrorData (LoggingT IO)) (a, AppStateW)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT AppStateContext a
ctx AppStateW
st

-- |
--
liftIOE :: IO a -> AppStateContext a
liftIOE :: forall a. IO a -> AppStateContext a
liftIOE IO a
f = IO (Either ErrorData a)
-> StateT
     AppStateW
     (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
     (Either ErrorData a)
forall a. IO a -> AppStateContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO (Either ErrorData a)
forall b. IO b -> IO (Either ErrorData b)
go IO a
f) StateT
  AppStateW
  (ReaderT DomainData (ExceptT ErrorData (LoggingT IO)))
  (Either ErrorData a)
-> (Either ErrorData a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall a b.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either ErrorData a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
  where
    go :: IO b -> IO (Either String b)
    go :: forall b. IO b -> IO (Either ErrorData b)
go IO b
x = IO (Either ErrorData b)
-> (SomeException -> IO (Either ErrorData b))
-> IO (Either ErrorData b)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
E.catchAny (b -> Either ErrorData b
forall a b. b -> Either a b
Right (b -> Either ErrorData b) -> IO b -> IO (Either ErrorData b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b
x) SomeException -> IO (Either ErrorData b)
forall a. SomeException -> IO (Either ErrorData a)
errHdl

    errHdl :: E.SomeException -> IO (Either String a)
    errHdl :: forall a. SomeException -> IO (Either ErrorData a)
errHdl = Either ErrorData a -> IO (Either ErrorData a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ErrorData a -> IO (Either ErrorData a))
-> (SomeException -> Either ErrorData a)
-> SomeException
-> IO (Either ErrorData a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorData -> Either ErrorData a
forall a b. a -> Either a b
Left (ErrorData -> Either ErrorData a)
-> (SomeException -> ErrorData)
-> SomeException
-> Either ErrorData a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ErrorData
forall a. Show a => a -> ErrorData
show

-- |
--
readFile :: FilePath -> AppContext BL.ByteString
readFile :: ErrorData -> AppContext ByteString
readFile ErrorData
path = ErrorData -> AppContext ErrorData
isFileExists ErrorData
path
            AppContext ErrorData
-> (ErrorData -> AppContext ErrorData) -> AppContext ErrorData
forall a b.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrorData -> AppContext ErrorData
isReadable
            AppContext ErrorData
-> (ErrorData -> AppContext ByteString) -> AppContext ByteString
forall a b.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ErrorData -> AppContext ByteString
go
  where
    go :: ErrorData -> AppContext ByteString
go ErrorData
f = IO ByteString -> AppContext ByteString
forall a. IO a -> AppStateContext a
liftIOE (IO ByteString -> AppContext ByteString)
-> IO ByteString -> AppContext ByteString
forall a b. (a -> b) -> a -> b
$ do
      Text
cont <- ErrorData -> IO Text
T.readFile ErrorData
f
      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

-- |
--
isFileExists :: FilePath -> AppContext FilePath
isFileExists :: ErrorData -> AppContext ErrorData
isFileExists ErrorData
f = IO Bool -> AppStateContext Bool
forall a. IO a -> AppStateContext a
liftIOE (ErrorData -> IO Bool
doesFileExist ErrorData
f) AppStateContext Bool
-> (Bool -> AppContext ErrorData) -> AppContext ErrorData
forall a b.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True  -> ErrorData -> AppContext ErrorData
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorData
f
  Bool
False -> ErrorData -> AppContext ErrorData
forall a.
ErrorData
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorData -> AppContext ErrorData)
-> ErrorData -> AppContext ErrorData
forall a b. (a -> b) -> a -> b
$ ErrorData
"invalid file. not exists." ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ErrorData
f

-- |
--
isReadable :: FilePath -> AppContext FilePath
isReadable :: ErrorData -> AppContext ErrorData
isReadable ErrorData
f = IO Bool -> AppStateContext Bool
forall a. IO a -> AppStateContext a
liftIOE (Permissions -> Bool
readable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ErrorData -> IO Permissions
getPermissions ErrorData
f) AppStateContext Bool
-> (Bool -> AppContext ErrorData) -> AppContext ErrorData
forall a b.
StateT
  AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
-> (a
    -> StateT
         AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b)
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Bool
True  -> ErrorData -> AppContext ErrorData
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return ErrorData
f
  Bool
False -> ErrorData -> AppContext ErrorData
forall a.
ErrorData
-> StateT
     AppStateW (ReaderT DomainData (ExceptT ErrorData (LoggingT IO))) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ErrorData -> AppContext ErrorData)
-> ErrorData -> AppContext ErrorData
forall a b. (a -> b) -> a -> b
$ ErrorData
"invalid file. not readable." ErrorData -> ErrorData -> ErrorData
forall a. [a] -> [a] -> [a]
++ ErrorData
f

-- |
--
sendCompletionResponse :: DM.JsonRpcRequest -> AppContext ()
sendCompletionResponse :: JsonRpcRequest -> AppStateContext ()
sendCompletionResponse JsonRpcRequest
jsonRpc = do
  let result :: McpCompleteResponseResult
result = McpCompleteResponseResult
forall a. Default a => a
def
      resDat :: McpCompleteResponseData
resDat = JsonRpcRequest
-> McpCompleteResponseResult -> McpCompleteResponseData
DM.McpCompleteResponseData JsonRpcRequest
jsonRpc McpCompleteResponseResult
result
      res :: McpResponse
res = McpCompleteResponseData -> McpResponse
DM.McpCompleteResponse McpCompleteResponseData
resDat

  $Text -> Text -> AppStateContext ()
logDebugS Text
DM._LOGTAG (Text -> AppStateContext ()) -> Text -> AppStateContext ()
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 () -> AppStateContext ()
forall a. IO a -> AppStateContext a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> AppStateContext ()) -> IO () -> AppStateContext ()
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