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

module PMS.Domain.Service.DM.Type where

import Control.Monad.Trans.State.Lazy
import Control.Monad.Except
import Control.Monad.Logger
import Control.Monad.Reader
import qualified Data.Text as T

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

import Data.Aeson
import qualified Data.Aeson.KeyMap as KM
import Data.Aeson.Key (toText)
import Control.Monad (forM)

--------------------------------------------------------------------------------
-- |
--
newtype JsonObjectMap = JsonObjectMap { JsonObjectMap -> [(String, String)]
unJsonObjectMap :: [(String, String)] }
  deriving (Int -> JsonObjectMap -> ShowS
[JsonObjectMap] -> ShowS
JsonObjectMap -> String
(Int -> JsonObjectMap -> ShowS)
-> (JsonObjectMap -> String)
-> ([JsonObjectMap] -> ShowS)
-> Show JsonObjectMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonObjectMap -> ShowS
showsPrec :: Int -> JsonObjectMap -> ShowS
$cshow :: JsonObjectMap -> String
show :: JsonObjectMap -> String
$cshowList :: [JsonObjectMap] -> ShowS
showList :: [JsonObjectMap] -> ShowS
Show)

instance FromJSON JsonObjectMap where
  parseJSON :: Value -> Parser JsonObjectMap
parseJSON = String
-> (Object -> Parser JsonObjectMap)
-> Value
-> Parser JsonObjectMap
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JsonObjectMap" ((Object -> Parser JsonObjectMap) -> Value -> Parser JsonObjectMap)
-> (Object -> Parser JsonObjectMap)
-> Value
-> Parser JsonObjectMap
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    [(String, String)]
listPairs <- [(Key, Value)]
-> ((Key, Value) -> Parser (String, String))
-> Parser [(String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Object -> [(Key, Value)]
forall v. KeyMap v -> [(Key, v)]
KM.toList Object
o) (((Key, Value) -> Parser (String, String))
 -> Parser [(String, String)])
-> ((Key, Value) -> Parser (String, String))
-> Parser [(String, String)]
forall a b. (a -> b) -> a -> b
$ \(Key
k, Value
v) -> do
      Text
stringValue <- Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
      (String, String) -> Parser (String, String)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> String
T.unpack (Key -> Text
toText Key
k), Text -> String
T.unpack Text
stringValue)
    JsonObjectMap -> Parser JsonObjectMap
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (JsonObjectMap -> Parser JsonObjectMap)
-> JsonObjectMap -> Parser JsonObjectMap
forall a b. (a -> b) -> a -> b
$ [(String, String)] -> JsonObjectMap
JsonObjectMap [(String, String)]
listPairs

--------------------------------------------------------------------------------
-- |
--
data StateTransition =
    StartToRun
  | RunToStop
  deriving (Int -> StateTransition -> ShowS
[StateTransition] -> ShowS
StateTransition -> String
(Int -> StateTransition -> ShowS)
-> (StateTransition -> String)
-> ([StateTransition] -> ShowS)
-> Show StateTransition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateTransition -> ShowS
showsPrec :: Int -> StateTransition -> ShowS
$cshow :: StateTransition -> String
show :: StateTransition -> String
$cshowList :: [StateTransition] -> ShowS
showList :: [StateTransition] -> ShowS
Show, StateTransition -> StateTransition -> Bool
(StateTransition -> StateTransition -> Bool)
-> (StateTransition -> StateTransition -> Bool)
-> Eq StateTransition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateTransition -> StateTransition -> Bool
== :: StateTransition -> StateTransition -> Bool
$c/= :: StateTransition -> StateTransition -> Bool
/= :: StateTransition -> StateTransition -> Bool
Eq)

noStateTransition :: Maybe StateTransition
noStateTransition :: Maybe StateTransition
noStateTransition = Maybe StateTransition
forall a. Maybe a
Nothing

-- |
--
data EntryEventData       = EntryEventData deriving (Int -> EntryEventData -> ShowS
[EntryEventData] -> ShowS
EntryEventData -> String
(Int -> EntryEventData -> ShowS)
-> (EntryEventData -> String)
-> ([EntryEventData] -> ShowS)
-> Show EntryEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EntryEventData -> ShowS
showsPrec :: Int -> EntryEventData -> ShowS
$cshow :: EntryEventData -> String
show :: EntryEventData -> String
$cshowList :: [EntryEventData] -> ShowS
showList :: [EntryEventData] -> ShowS
Show)
data ExitEventData        = ExitEventData  deriving (Int -> ExitEventData -> ShowS
[ExitEventData] -> ShowS
ExitEventData -> String
(Int -> ExitEventData -> ShowS)
-> (ExitEventData -> String)
-> ([ExitEventData] -> ShowS)
-> Show ExitEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExitEventData -> ShowS
showsPrec :: Int -> ExitEventData -> ShowS
$cshow :: ExitEventData -> String
show :: ExitEventData -> String
$cshowList :: [ExitEventData] -> ShowS
showList :: [ExitEventData] -> ShowS
Show)
data TransitEventData     = TransitEventData StateTransition deriving (Int -> TransitEventData -> ShowS
[TransitEventData] -> ShowS
TransitEventData -> String
(Int -> TransitEventData -> ShowS)
-> (TransitEventData -> String)
-> ([TransitEventData] -> ShowS)
-> Show TransitEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransitEventData -> ShowS
showsPrec :: Int -> TransitEventData -> ShowS
$cshow :: TransitEventData -> String
show :: TransitEventData -> String
$cshowList :: [TransitEventData] -> ShowS
showList :: [TransitEventData] -> ShowS
Show)
-- doActibity
data InitializeEventData  = InitializeEventData DM.McpInitializeRequestData deriving (Int -> InitializeEventData -> ShowS
[InitializeEventData] -> ShowS
InitializeEventData -> String
(Int -> InitializeEventData -> ShowS)
-> (InitializeEventData -> String)
-> ([InitializeEventData] -> ShowS)
-> Show InitializeEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializeEventData -> ShowS
showsPrec :: Int -> InitializeEventData -> ShowS
$cshow :: InitializeEventData -> String
show :: InitializeEventData -> String
$cshowList :: [InitializeEventData] -> ShowS
showList :: [InitializeEventData] -> ShowS
Show)
data InitializedEventData = InitializedEventData DM.McpInitializedNotificationData deriving (Int -> InitializedEventData -> ShowS
[InitializedEventData] -> ShowS
InitializedEventData -> String
(Int -> InitializedEventData -> ShowS)
-> (InitializedEventData -> String)
-> ([InitializedEventData] -> ShowS)
-> Show InitializedEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InitializedEventData -> ShowS
showsPrec :: Int -> InitializedEventData -> ShowS
$cshow :: InitializedEventData -> String
show :: InitializedEventData -> String
$cshowList :: [InitializedEventData] -> ShowS
showList :: [InitializedEventData] -> ShowS
Show)
data ToolsListEventData   = ToolsListEventData DM.McpToolsListRequestData deriving (Int -> ToolsListEventData -> ShowS
[ToolsListEventData] -> ShowS
ToolsListEventData -> String
(Int -> ToolsListEventData -> ShowS)
-> (ToolsListEventData -> String)
-> ([ToolsListEventData] -> ShowS)
-> Show ToolsListEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolsListEventData -> ShowS
showsPrec :: Int -> ToolsListEventData -> ShowS
$cshow :: ToolsListEventData -> String
show :: ToolsListEventData -> String
$cshowList :: [ToolsListEventData] -> ShowS
showList :: [ToolsListEventData] -> ShowS
Show)
data ToolsCallEventData   = ToolsCallEventData DM.McpToolsCallRequestData deriving (Int -> ToolsCallEventData -> ShowS
[ToolsCallEventData] -> ShowS
ToolsCallEventData -> String
(Int -> ToolsCallEventData -> ShowS)
-> (ToolsCallEventData -> String)
-> ([ToolsCallEventData] -> ShowS)
-> Show ToolsCallEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToolsCallEventData -> ShowS
showsPrec :: Int -> ToolsCallEventData -> ShowS
$cshow :: ToolsCallEventData -> String
show :: ToolsCallEventData -> String
$cshowList :: [ToolsCallEventData] -> ShowS
showList :: [ToolsCallEventData] -> ShowS
Show)
data PromptsListEventData = PromptsListEventData DM.McpPromptsListRequestData deriving (Int -> PromptsListEventData -> ShowS
[PromptsListEventData] -> ShowS
PromptsListEventData -> String
(Int -> PromptsListEventData -> ShowS)
-> (PromptsListEventData -> String)
-> ([PromptsListEventData] -> ShowS)
-> Show PromptsListEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptsListEventData -> ShowS
showsPrec :: Int -> PromptsListEventData -> ShowS
$cshow :: PromptsListEventData -> String
show :: PromptsListEventData -> String
$cshowList :: [PromptsListEventData] -> ShowS
showList :: [PromptsListEventData] -> ShowS
Show)
data PromptsGetEventData  = PromptsGetEventData DM.McpPromptsGetRequestData deriving (Int -> PromptsGetEventData -> ShowS
[PromptsGetEventData] -> ShowS
PromptsGetEventData -> String
(Int -> PromptsGetEventData -> ShowS)
-> (PromptsGetEventData -> String)
-> ([PromptsGetEventData] -> ShowS)
-> Show PromptsGetEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PromptsGetEventData -> ShowS
showsPrec :: Int -> PromptsGetEventData -> ShowS
$cshow :: PromptsGetEventData -> String
show :: PromptsGetEventData -> String
$cshowList :: [PromptsGetEventData] -> ShowS
showList :: [PromptsGetEventData] -> ShowS
Show)
data ResourcesTemplatesListEventData = ResourcesTemplatesListEventData DM.McpResourcesTemplatesListRequestData deriving (Int -> ResourcesTemplatesListEventData -> ShowS
[ResourcesTemplatesListEventData] -> ShowS
ResourcesTemplatesListEventData -> String
(Int -> ResourcesTemplatesListEventData -> ShowS)
-> (ResourcesTemplatesListEventData -> String)
-> ([ResourcesTemplatesListEventData] -> ShowS)
-> Show ResourcesTemplatesListEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourcesTemplatesListEventData -> ShowS
showsPrec :: Int -> ResourcesTemplatesListEventData -> ShowS
$cshow :: ResourcesTemplatesListEventData -> String
show :: ResourcesTemplatesListEventData -> String
$cshowList :: [ResourcesTemplatesListEventData] -> ShowS
showList :: [ResourcesTemplatesListEventData] -> ShowS
Show)
data ResourcesListEventData = ResourcesListEventData DM.McpResourcesListRequestData deriving (Int -> ResourcesListEventData -> ShowS
[ResourcesListEventData] -> ShowS
ResourcesListEventData -> String
(Int -> ResourcesListEventData -> ShowS)
-> (ResourcesListEventData -> String)
-> ([ResourcesListEventData] -> ShowS)
-> Show ResourcesListEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourcesListEventData -> ShowS
showsPrec :: Int -> ResourcesListEventData -> ShowS
$cshow :: ResourcesListEventData -> String
show :: ResourcesListEventData -> String
$cshowList :: [ResourcesListEventData] -> ShowS
showList :: [ResourcesListEventData] -> ShowS
Show)
data ResourcesReadEventData = ResourcesReadEventData DM.McpResourcesReadRequestData deriving (Int -> ResourcesReadEventData -> ShowS
[ResourcesReadEventData] -> ShowS
ResourcesReadEventData -> String
(Int -> ResourcesReadEventData -> ShowS)
-> (ResourcesReadEventData -> String)
-> ([ResourcesReadEventData] -> ShowS)
-> Show ResourcesReadEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResourcesReadEventData -> ShowS
showsPrec :: Int -> ResourcesReadEventData -> ShowS
$cshow :: ResourcesReadEventData -> String
show :: ResourcesReadEventData -> String
$cshowList :: [ResourcesReadEventData] -> ShowS
showList :: [ResourcesReadEventData] -> ShowS
Show)
data CancelledEventData   = CancelledEventData DM.McpCancelledNotificationData deriving (Int -> CancelledEventData -> ShowS
[CancelledEventData] -> ShowS
CancelledEventData -> String
(Int -> CancelledEventData -> ShowS)
-> (CancelledEventData -> String)
-> ([CancelledEventData] -> ShowS)
-> Show CancelledEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelledEventData -> ShowS
showsPrec :: Int -> CancelledEventData -> ShowS
$cshow :: CancelledEventData -> String
show :: CancelledEventData -> String
$cshowList :: [CancelledEventData] -> ShowS
showList :: [CancelledEventData] -> ShowS
Show)
data CompletionCompleteEventData = CompletionCompleteEventData DM.McpCompletionCompleteRequestData deriving (Int -> CompletionCompleteEventData -> ShowS
[CompletionCompleteEventData] -> ShowS
CompletionCompleteEventData -> String
(Int -> CompletionCompleteEventData -> ShowS)
-> (CompletionCompleteEventData -> String)
-> ([CompletionCompleteEventData] -> ShowS)
-> Show CompletionCompleteEventData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompletionCompleteEventData -> ShowS
showsPrec :: Int -> CompletionCompleteEventData -> ShowS
$cshow :: CompletionCompleteEventData -> String
show :: CompletionCompleteEventData -> String
$cshowList :: [CompletionCompleteEventData] -> ShowS
showList :: [CompletionCompleteEventData] -> ShowS
Show)


-- |
--
data Event r where
  EntryEvent       :: Event EntryEventData
  ExitEvent        :: Event ExitEventData
  TransitEvent     :: TransitEventData     -> Event TransitEventData
  -- doActibity
  InitializeEvent  :: InitializeEventData  -> Event InitializeEventData
  InitializedEvent :: InitializedEventData -> Event InitializedEventData
  ToolsListEvent   :: ToolsListEventData   -> Event ToolsListEventData
  ToolsCallEvent   :: ToolsCallEventData   -> Event ToolsCallEventData
  PromptsListEvent :: PromptsListEventData -> Event PromptsListEventData
  PromptsGetEvent  :: PromptsGetEventData -> Event PromptsGetEventData
  ResourcesTemplatesListEvent :: ResourcesTemplatesListEventData -> Event ResourcesTemplatesListEventData
  ResourcesListEvent :: ResourcesListEventData -> Event ResourcesListEventData
  ResourcesReadEvent :: ResourcesReadEventData -> Event ResourcesReadEventData
  CancelledEvent   :: CancelledEventData   -> Event CancelledEventData
  CompletionCompleteEvent :: CompletionCompleteEventData -> Event CompletionCompleteEventData

deriving instance Show r => Show (Event r)

-- |
--
data EventW = forall r. EventW (Event r)




--------------------------------------------------------------------------------
-- Type for Domain Service.
--------------------------------------------------------------------------------
-- |
--
type AppStateContext = StateT AppStateW (ReaderT DM.DomainData (ExceptT DM.ErrorData (LoggingT IO)))
type AppContext = AppStateContext

-- type AppStateContext = StateT AppStateW IO

-- |
--
data StartStateData = StartStateData deriving (Int -> StartStateData -> ShowS
[StartStateData] -> ShowS
StartStateData -> String
(Int -> StartStateData -> ShowS)
-> (StartStateData -> String)
-> ([StartStateData] -> ShowS)
-> Show StartStateData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StartStateData -> ShowS
showsPrec :: Int -> StartStateData -> ShowS
$cshow :: StartStateData -> String
show :: StartStateData -> String
$cshowList :: [StartStateData] -> ShowS
showList :: [StartStateData] -> ShowS
Show)
data RunStateData  = RunStateData  deriving (Int -> RunStateData -> ShowS
[RunStateData] -> ShowS
RunStateData -> String
(Int -> RunStateData -> ShowS)
-> (RunStateData -> String)
-> ([RunStateData] -> ShowS)
-> Show RunStateData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RunStateData -> ShowS
showsPrec :: Int -> RunStateData -> ShowS
$cshow :: RunStateData -> String
show :: RunStateData -> String
$cshowList :: [RunStateData] -> ShowS
showList :: [RunStateData] -> ShowS
Show)
data StopStateData = StopStateData deriving (Int -> StopStateData -> ShowS
[StopStateData] -> ShowS
StopStateData -> String
(Int -> StopStateData -> ShowS)
-> (StopStateData -> String)
-> ([StopStateData] -> ShowS)
-> Show StopStateData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopStateData -> ShowS
showsPrec :: Int -> StopStateData -> ShowS
$cshow :: StopStateData -> String
show :: StopStateData -> String
$cshowList :: [StopStateData] -> ShowS
showList :: [StopStateData] -> ShowS
Show)
data AppState s where
  StartState :: AppState StartStateData
  RunState  :: AppState RunStateData
  StopState :: AppState StopStateData

deriving instance Show s => Show (AppState s)

-- |
--
data AppStateW = forall s. (IAppState s, Show s) => AppStateW (AppState s)


-- |
--
class (Show s, Show r) => IStateActivity s r where
  action :: (AppState s) -> (Event r) -> AppStateContext (Maybe StateTransition)
  action AppState s
s (TransitEvent (TransitEventData StateTransition
t)) = do
    $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ()
logDebugS Text
DM._LOGTAG (Text
 -> StateT
      AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ())
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AppState s -> String
forall a. Show a => a -> String
show AppState s
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StateTransition -> String
forall a. Show a => a -> String
show StateTransition
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" will transit."
    Maybe StateTransition -> AppStateContext (Maybe StateTransition)
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return (StateTransition -> Maybe StateTransition
forall a. a -> Maybe a
Just StateTransition
t)
  action AppState s
s Event r
r = do
    $Text
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ()
logDebugS Text
DM._LOGTAG (Text
 -> StateT
      AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ())
-> Text
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ AppState s -> String
forall a. Show a => a -> String
show AppState s
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Event r -> String
forall a. Show a => a -> String
show Event r
r String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" not supported. will do nothing."
    Maybe StateTransition -> AppStateContext (Maybe StateTransition)
forall a.
a
-> StateT
     AppStateW (ReaderT DomainData (ExceptT String (LoggingT IO))) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StateTransition
forall a. Maybe a
Nothing

-- |
--
class IAppState s where
  actionS  :: AppState s -> EventW -> AppStateContext (Maybe StateTransition)

-- |
--
class IAppStateW s where
  actionSW  :: s -> EventW -> AppStateContext (Maybe StateTransition)

instance IAppStateW AppStateW where
  actionSW :: AppStateW -> EventW -> AppStateContext (Maybe StateTransition)
actionSW (AppStateW AppState s
a) EventW
r = AppState s -> EventW -> AppStateContext (Maybe StateTransition)
forall s.
IAppState s =>
AppState s -> EventW -> AppStateContext (Maybe StateTransition)
actionS AppState s
a EventW
r