Permalink
Browse files

Add mechanism to initialize from data structure rather than from conf…

…ig file
  • Loading branch information...
1 parent 60c8c83 commit 0616f68337eafaa81f8c523ed678836210d41494 @jepst committed Mar 17, 2012
Showing with 23 additions and 19 deletions.
  1. +23 −19 Remote/Init.hs
View
42 Remote/Init.hs
@@ -1,18 +1,16 @@
-- | Exposes a high-level interface for starting a node of a distributed
-- program, taking into account a local configuration file, command
-- line arguments, and commonly-used system processes.
-module Remote.Init (remoteInit) where
-
-import qualified Prelude as Prelude
-import Prelude hiding (lookup)
+module Remote.Init (remoteInit,remoteInitFromConfig) where
import Remote.Peer (startDiscoveryService)
import Remote.Task (__remoteCallMetaData)
-import Remote.Process (startProcessRegistryService,suppressTransmitException,localRegistryRegisterNode,localRegistryHello,localRegistryUnregisterNode,
- startProcessMonitorService,startNodeMonitorService,startLoggingService,startSpawnerService,ProcessM,readConfig,initNode,startLocalRegistry,
+import Remote.Process (startProcessRegistryService,suppressTransmitException,pbracket,localRegistryRegisterNode,localRegistryHello,localRegistryUnregisterNode,
+ startProcessMonitorService,startNodeMonitorService,startLoggingService,startSpawnerService,ProcessM,Config(..),readConfig,initNode,startLocalRegistry,
forkAndListenAndDeliver,waitForThreads,roleDispatch,Node,runLocalProcess,performFinalization,startFinalizerService)
import Remote.Reg (registerCalls,RemoteCallMetaData)
+import System.FilePath (FilePath)
import System.Environment (getEnvironment)
import Control.Concurrent (threadDelay)
import Control.Monad.Trans (liftIO)
@@ -32,9 +30,25 @@ startServices =
dispatchServices :: MVar Node -> IO ()
dispatchServices node = do mv <- newEmptyMVar
- _ <- runLocalProcess node (startServices >> liftIO (putMVar mv ()))
+ runLocalProcess node (startServices >> liftIO (putMVar mv ()))
takeMVar mv
+
+remoteInitFromConfig :: Config -> [RemoteCallMetaData] -> (String -> ProcessM ()) -> IO ()
+remoteInitFromConfig cfg metadata f =
+ let
+ defaultMetaData = [Remote.Task.__remoteCallMetaData]
+ lookup = registerCalls (defaultMetaData ++ metadata)
+ in
+ do
+ node <- initNode cfg lookup
+ _ <- startLocalRegistry cfg False -- potentially fails silently
+ forkAndListenAndDeliver node cfg
+ dispatchServices node
+ (roleDispatch node userFunction >> waitForThreads node) `finally` (performFinalization node)
+ threadDelay 500000 -- TODO make configurable, or something
+ where userFunction s = localRegistryHello >> localRegistryRegisterNode >> f s
+
-- | This is the usual way create a single node of distributed program.
-- The intent is that 'remoteInit' be called in your program's 'Main.main'
-- function. A typical call takes this form:
@@ -52,21 +66,11 @@ dispatchServices node = do mv <- newEmptyMVar
-- 4. The function initialProcess will be called, given as a parameter a string indicating the value of the cfgRole setting of this node. initialProcess is provided by the user and provides an entrypoint for controlling node behavior on startup.
remoteInit :: Maybe FilePath -> [RemoteCallMetaData] -> (String -> ProcessM ()) -> IO ()
remoteInit defaultConfig metadata f =
- let
- defaultMetaData = [Remote.Task.__remoteCallMetaData]
- lookup = registerCalls (defaultMetaData ++ metadata)
- in
do
configFileName <- getConfigFileName
cfg <- readConfig True configFileName
-- TODO sanity-check cfg
- node <- initNode cfg lookup
- _ <- startLocalRegistry cfg False -- potentially fails silently
- forkAndListenAndDeliver node cfg
- dispatchServices node
- (roleDispatch node userFunction >> waitForThreads node) `finally` (performFinalization node)
- threadDelay 500000 -- TODO make configurable, or something
+ remoteInitFromConfig cfg metadata f
where getConfigFileName = do env <- getEnvironment
- return $ maybe defaultConfig Just (Prelude.lookup "RH_CONFIG" env)
- userFunction s = localRegistryHello >> localRegistryRegisterNode >> f s
+ return $ maybe defaultConfig Just (lookup "RH_CONFIG" env)

0 comments on commit 0616f68

Please sign in to comment.