AERN-Net-0.2.1: src/Control/ERNet/Foundations/Manager.hs

{-# 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