{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-| Module : Control.ERNet.Foundations.Manager Description : Abstraction of a distributed network manager. Copyright : (c) Michal Konecny License : BSD3 Maintainer : mik@konecny.aow.cz Stability : experimental Portability : portable Abstraction of a distributed manager for networked ER processes. Its functions comprise: * initial process deployment * expansion of a process into a sub-network To be imported qualified, usually with the prefix MAN. -} 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 {-^ a manager that will deploy the process -} -> ERProcess sInAnyProt sOutAnyProt {-^ a process to be deployed; it cannot have input channels -} -> IO lg {-| A name given to a ditributed node by a programmer. -} type ManagerName = String {-| A globally unique name as a URL. eg ernet://localhost:4176/miks-ivp-solver-master ernet-local:/ivp-solver-master ernet-mpi:/ivp-solver-master The port 4176 was unassigned when checked on http://www.iana.org/assignments/port-numbers on 2nd November 2008. -} type ManagerID = String {-| Run a process together with some queries on one of its output sockets. -} runDialogue :: (Manager man lg sIn sOut sInAnyProt sOutAnyProt, QAProtocol q a) => man -> ERProcess sInAnyProt sOutAnyProt {-^ a process to be deployed and enquired; it cannot have input sockets -} -> Int {-^ the output socket in the above process to use, numbered from 0 -} -> ChannelType {-^ type of the above output socket -} -> ((q -> IO a) -> IO ()) {-^ Dialogue action that makes queries into this channel. The parameter is a query function that waits for the answer and returns it. -} -> Bool {-^ whether or not to wait until the dialogue is finished -} -> IO lg runDialogue manager process sockN sockT dialogue waitForEnd = do doneTV <- atomically $ newTVar False -- deploy a new process that contains the supplied dialogue: 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: " [] -- input sockets [] -- output sockets [ (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 -- create a dummy output socket that we pretend "initiated" the start query dummyLogger <- LG.new (_, dummyCHA) <- CH.new dummyLogger "S" 0 chTUnit dummyCH <- CH.castOutIO "ERNet.Foundations.Manager: runDialogue: startDeploy: dummyCH: " dummyCHA -- cast the sockets: 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] -- make a dummy query to itself on the start channel -- (which formally causes all dialogue queries): startQryInId <- CH.makeQuery dummyCH 0 startInCH QAUnitQ (startQryOutId, _) <- CH.waitForQuery startOutCH -- execute the dialogue: let doQueryGetAnswer q = do qryId <- CH.makeQuery startOutCH startQryOutId inCH q CH.waitForAnswer startOutCH startQryOutId inCH qryId dialogue doQueryGetAnswer -- answer the start query to itself CH.answerQuery False startOutCH (startQryOutId, QAUnitA) CH.waitForAnswer dummyCH 0 startInCH startQryInId -- signal that dialogue is finished atomically $ writeTVar doneTV True