module Control.ERNet.Deployment.Local.Manager
(
ManagerLocal()
)
where
import Control.ERNet.Deployment.Local.Logger
import Control.ERNet.Deployment.Local.Channel
import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Event
import qualified Control.ERNet.Foundations.Event.Logger as LG
import qualified Control.ERNet.Foundations.Channel as CH
import Control.ERNet.Foundations.Process
import Control.ERNet.Foundations.Manager
import Control.Concurrent as Concurrent
import qualified Data.Map as Map
newtype ManagerLocal =
ManagerLocal ManagerName
instance
Manager
ManagerLocal LoggerLocal
ChannelLocal ChannelLocal
ChannelLocalAnyProt ChannelLocalAnyProt
where
new name =
do
putStrLn $ "simulating the creation of network manager " ++ name
return (ManagerLocal name, "ernet-local:/" ++ name)
connectNeighbour (ManagerLocal name) neighbourID =
do
putStrLn $
"simulating the connection of neighbour "
++ neighbourID ++ " to the manager " ++ name
return True
runProcess (ManagerLocal name) process =
do
logger <- LG.new
forkIO $ (erprocDeploy process) (erprocName process) [] [] (startNet logger)
return logger
startNet
logger
locationDescr
[] _ processesMappings =
do
deployProcesses logger locationDescr "" [] [] processesMappings
return ()
startNet _ _ _ _ _ =
error $
"Control.ERNet.Deployment.ManagerLocal: startNet: Illegal attempt to kick-start a network: outermost network cannot have input sockets"
expandProcess
logger processNamePrefix inCHAs outCHAs
locationDescr inputTypesNames outputTypesNames processesMappings =
do
dispatcher Nothing
where
(outChTs, outChNs) = unzip outputTypesNames
(inChTs, inChNs) = unzip inputTypesNames
dispatcher maybeN2channel =
do
(chN, qryData) <- CH.waitForQueryMulti outCHAs
n2channel <-
case maybeN2channel of
Nothing ->
deployProcesses
logger locationDescr processNamePrefix
inCHAs inChNs processesMappings
Just n2channel -> return n2channel
let fwdCHA = fst $ n2channel $ outChNs !! chN
let outCHA = outCHAs !! chN
let chT = outChTs !! chN
forkIO $ forwardQueryAnswer outCHA fwdCHA chT qryData
dispatcher (Just n2channel)
forwardQueryAnswer causeCHA fwdCHA chT (causeQryId, qryAnyProt) =
do
argQryId <-
CH.makeQueryAnyProt locationDescr causeCHA causeQryId fwdCHA qryAnyProt
(_, ansAnyProt) <- CH.waitForAnswerMulti causeCHA causeQryId [(fwdCHA, argQryId)]
CH.answerQueryAnyProt locationDescr False causeCHA (causeQryId, ansAnyProt)
deployProcesses ::
(CH.ChannelForScheduler lg sIn sOut sInAnyProt sOutAnyProt) =>
lg ->
String ->
String ->
[sInAnyProt] ->
[Int] ->
[(ERProcess sInAnyProt sOutAnyProt, ([Int], [Int]))] ->
IO (Int -> (sInAnyProt, sOutAnyProt))
deployProcesses logger locationDescr namePrefix inCHAs inChNs processesMappings =
do
internalCHAs <-
mapM makeNewChannel internalTypesNamesProcesses
let n2channel = makeChannelMap internalCHAs
mapM (deployProcess n2channel) $ processesMappings
return n2channel
where
makeNewChannel (((chN, chT), (procName, outChN))) =
CH.new logger (namePrefix ++ procName) outChN chT
internalTypesNamesProcesses =
concat $ map getProcessChanTypesNames processesMappings
where
getProcessChanTypesNames (process, (inNs, outNs)) =
(zip (zip outNs (erprocOutputTypes process)) $
zip (repeat $ erprocName process) [0..])
makeChannelMap internalCHAs n =
case Map.lookup n n2chMap of
Nothing ->
error $ locationDescr ++ " deployProcess: unknown channel number: " ++ show n
Just ch -> ch
where
n2chMap =
Map.fromList $
(zip internalChNs internalCHAs) ++
(zip inChNs $ zip inCHAs (repeat errorOUT))
errorOUT =
error "ManagerLocal: makeChannelMap: input channel treated as output channel"
internalChNs =
concat $ map (snd . snd) processesMappings
deployProcess n2channel (process, (processInChNs, processOutChNs)) =
do
forkIO $
(erprocDeploy process)
name
processInCHAs processOutCHAs
(expandProcess logger (name ++ ".") processInCHAs processOutCHAs)
where
name = namePrefix ++ erprocName process
processInCHAs = map (fst . n2channel) processInChNs
processOutCHAs = map (snd . n2channel) processOutChNs