module Control.ERNet.Foundations.Manager where
import Control.ERNet.Foundations.Protocol
import qualified Control.ERNet.Foundations.Event.Logger as LG
import qualified Control.ERNet.Foundations.Channel as CH
import Control.ERNet.Foundations.Process
import Control.Concurrent.STM as STM
class (CH.ChannelForScheduler lg sIn sOut sInAnyProt sOutAnyProt) =>
Manager man lg sIn sOut sInAnyProt sOutAnyProt
| man -> lg sIn sOut sInAnyProt sOutAnyProt
where
new :: ManagerName -> IO (man, ManagerID)
connectNeighbour :: man -> ManagerID -> IO Bool
runProcess ::
man ->
ERProcess sInAnyProt sOutAnyProt
->
IO lg
type ManagerName = String
type ManagerID = String
runDialogue ::
(Manager man lg sIn sOut sInAnyProt sOutAnyProt,
QAProtocol q a) =>
man ->
ERProcess sInAnyProt sOutAnyProt
->
Int ->
ChannelType ->
((q -> IO a) -> IO ())
->
Bool ->
IO lg
runDialogue manager process sockN sockT dialogue waitForEnd =
do
doneTV <- atomically $ newTVar False
logger <- runProcess manager (initProcess doneTV)
case waitForEnd of
True ->
atomically $
do
done <- readTVar doneTV
case done of
True -> return ()
False -> retry
False -> return ()
return logger
where
initProcess doneTV =
ERProcess "" (initDeploy doneTV) [] []
initDeploy doneTV _ _ _ expandProcess =
expandProcess
"ERNet.Foundations.Manager: runDialogue: initDeploy: "
[]
[]
[
(process, ([], processOutSockNs)),
(startProcess doneTV, ([sockN, startChN],[startChN]))
]
processOutSockNs =
snd $ unzip $ zip (erprocOutputTypes process) [0..]
startChN = length processOutSockNs
startProcess doneTV =
ERProcess "S" (startDeploy doneTV) [sockT, chTUnit] [chTUnit]
startDeploy doneTV _ [inCHA, startInCHA] [startOutCHA] _ =
do
dummyLogger <- LG.new
(_, dummyCHA) <- CH.new dummyLogger "S" 0 chTUnit
dummyCH <- CH.castOutIO "ERNet.Foundations.Manager: runDialogue: startDeploy: dummyCH: " dummyCHA
inCH <- CH.castInIO "ERNet.Foundations.Manager: runDialogue: startDeploy: inCH: " inCHA
startInCH <- CH.castInIO "ERNet.Foundations.Manager: runDialogue: startDeploy: startInCH: " startInCHA
startOutCH <- CH.castOutIO "ERNet.Foundations.Manager: runDialogue: startDeploy: startOutCH: " startOutCHA
let _ = [dummyCH, startOutCH]
startQryInId <- CH.makeQuery dummyCH 0 startInCH QAUnitQ
(startQryOutId, _) <- CH.waitForQuery startOutCH
let doQueryGetAnswer q = do
qryId <- CH.makeQuery startOutCH startQryOutId inCH q
CH.waitForAnswer startOutCH startQryOutId inCH qryId
dialogue doQueryGetAnswer
CH.answerQuery False startOutCH (startQryOutId, QAUnitA)
CH.waitForAnswer dummyCH 0 startInCH startQryInId
atomically $ writeTVar doneTV True