module Control.Distributed.Task.TaskSpawning.TaskSpawning (
processTasks, TasksExecutionResult,
fullBinarySerializationOnMaster, executeFullBinaryArg, executionWithinSlaveProcessForFullBinaryDeployment,
serializedThunkSerializationOnMaster, executeSerializedThunkArg, executionWithinSlaveProcessForThunkSerialization,
objectCodeSerializationOnMaster
) where
import qualified Data.ByteString.Lazy as BL
import Data.List (intersperse)
import qualified Control.Distributed.Task.TaskSpawning.BinaryStorage as RemoteStore
import qualified Control.Distributed.Task.TaskSpawning.DeployFullBinary as DFB
import qualified Control.Distributed.Task.TaskSpawning.DeploySerializedThunk as DST
import qualified Control.Distributed.Task.TaskSpawning.DeployObjectCodeRelinked as DOC
import Control.Distributed.Task.TaskSpawning.FunctionSerialization (serializeFunction, deserializeFunction)
import Control.Distributed.Task.TaskSpawning.SourceCodeExecution (processSourceCodeTasks)
import Control.Distributed.Task.TaskSpawning.TaskDefinition
import Control.Distributed.Task.TaskSpawning.TaskDescription
import Control.Distributed.Task.TaskSpawning.TaskSpawningTypes
import Control.Distributed.Task.Types.TaskTypes
import Control.Distributed.Task.Util.ErrorHandling
import Control.Distributed.Task.Util.Logging
executeFullBinaryArg, executeSerializedThunkArg :: String
executeFullBinaryArg = "executefullbinary"
executeSerializedThunkArg = "executeserializedthunk"
type TasksExecutionResult = DFB.ExternalExecutionResult
processTasks :: TaskDef -> [DataDef] -> ResultDef -> IO TasksExecutionResult
processTasks (SourceCodeModule moduleName moduleContent) dataDefs _ = processSourceCodeTasks moduleName moduleContent dataDefs
processTasks taskDef dataDefs resultDef = do
logInfo $ "spawning task for: "++(concat $ intersperse ", " $ map describe dataDefs)
spawnExternalTask taskDef dataDefs resultDef
spawnExternalTask :: TaskDef -> [DataDef] -> ResultDef -> IO DFB.ExternalExecutionResult
spawnExternalTask (SourceCodeModule _ _) _ _ = error "source code distribution is handled differently"
spawnExternalTask (DeployFullBinary program) dataDefs resultDef =
DFB.deployAndRunFullBinary executeFullBinaryArg (IOHandling dataDefs resultDef) program
spawnExternalTask (PreparedDeployFullBinary hash) dataDefs resultDef = do
filePath_ <- RemoteStore.get hash
maybe (error $ "no such program: "++show hash) (DFB.runExternalBinary [executeFullBinaryArg] (IOHandling dataDefs resultDef)) filePath_
spawnExternalTask (UnevaluatedThunk function program) dataDefs resultDef =
DST.deployAndRunSerializedThunk executeSerializedThunkArg function (IOHandling dataDefs resultDef) program
spawnExternalTask (ObjectCodeModule objectCode) dataDefs resultDef =
DOC.deployAndRunObjectCodeRelinked objectCode (IOHandling dataDefs resultDef)
fullBinarySerializationOnMaster :: FilePath -> IO TaskDef
fullBinarySerializationOnMaster programPath = do
currentExecutable <- BL.readFile programPath
return $ DeployFullBinary currentExecutable
serializedThunkSerializationOnMaster :: FilePath -> (TaskInput -> TaskResult) -> IO TaskDef
serializedThunkSerializationOnMaster programPath function = do
program <- BL.readFile programPath
taskFn <- serializeFunction function
return $ UnevaluatedThunk taskFn program
executionWithinSlaveProcessForFullBinaryDeployment :: IOHandling -> (TaskInput -> TaskResult) -> IO ()
executionWithinSlaveProcessForFullBinaryDeployment = DFB.fullBinaryExecution
executionWithinSlaveProcessForThunkSerialization :: IOHandling -> String -> IO ()
executionWithinSlaveProcessForThunkSerialization ioHandling taskFnArg = do
taskFn <- withErrorAction logError ("Could not read task logic: " ++(show taskFnArg)) $ return $ (read taskFnArg :: BL.ByteString)
logInfo "slave: deserializing task logic"
logDebug $ "slave: got this task function: " ++ (show taskFn)
function <- deserializeFunction taskFn :: IO (TaskInput -> TaskResult)
serializeFunction function >>= \s -> logDebug $ "task deserialization done for: " ++ (show $ BL.unpack s)
DST.serializedThunkExecution ioHandling function
objectCodeSerializationOnMaster :: IO TaskDef
objectCodeSerializationOnMaster = DOC.loadObjectCode >>= \objectCode -> return $ ObjectCodeModule objectCode