module System.Mesos.Executor (
ToExecutor(..),
ExecutorDriver,
withExecutorDriver,
start,
stop,
abort,
await,
run,
sendStatusUpdate,
sendFrameworkMessage,
Executor,
createExecutor,
destroyExecutor,
withExecutor,
createDriver,
destroyDriver
) where
import Control.Monad.Managed
import Data.ByteString (ByteString, packCStringLen)
import Data.ByteString.Unsafe (unsafeUseAsCStringLen)
import Foreign.C
import Foreign.Marshal.Safe hiding (with)
import Foreign.Ptr
import Foreign.Storable
import System.Mesos.Internal
import System.Mesos.Raw
import System.Mesos.Raw.Executor
import System.Mesos.Types
withExecutor :: ToExecutor a => a -> (Executor -> IO b) -> IO b
withExecutor e f = do
executor <- createExecutor e
result <- f executor
destroyExecutor executor
return result
withExecutorDriver :: ToExecutor a => a -> (ExecutorDriver -> IO b) -> IO b
withExecutorDriver e f = withExecutor e $ \executor -> do
driver <- createDriver executor
result <- f driver
destroyDriver driver
return result
class ToExecutor a where
registered :: a -> ExecutorDriver -> ExecutorInfo -> FrameworkInfo -> SlaveInfo -> IO ()
registered _ _ _ _ _ = return ()
reRegistered :: a -> ExecutorDriver -> SlaveInfo -> IO ()
reRegistered _ _ _ = return ()
disconnected :: a -> ExecutorDriver -> IO ()
disconnected _ _ = return ()
launchTask :: a -> ExecutorDriver -> TaskInfo -> IO ()
launchTask _ _ _ = return ()
taskKilled :: a -> ExecutorDriver -> TaskID -> IO ()
taskKilled _ _ _ = return ()
frameworkMessage :: a -> ExecutorDriver -> ByteString -> IO ()
frameworkMessage _ _ _ = return ()
shutdown :: a -> ExecutorDriver -> IO ()
shutdown _ _ = return ()
errorMessage :: a
-> ExecutorDriver
-> ByteString
-> IO ()
errorMessage _ _ _ = return ()
createExecutor :: ToExecutor a => a -> IO Executor
createExecutor c = do
registeredFun <- wrapExecutorRegistered $ \edp eip fip sip -> runManaged $ do
ei <- unmarshal eip
fi <- unmarshal fip
si <- unmarshal sip
liftIO $ registered c (ExecutorDriver edp) ei fi si
reRegisteredFun <- wrapExecutorReRegistered $ \edp sip -> runManaged $ do
si <- unmarshal sip
liftIO $ reRegistered c (ExecutorDriver edp) si
disconnectedFun <- wrapExecutorDisconnected $ \edp -> disconnected c (ExecutorDriver edp)
launchTaskFun <- wrapExecutorLaunchTask $ \edp tip -> runManaged $ do
ti <- unmarshal tip
liftIO $ launchTask c (ExecutorDriver edp) ti
taskKilledFun <- wrapExecutorTaskKilled $ \edp tip -> runManaged $ do
ti <- unmarshal tip
liftIO $ taskKilled c (ExecutorDriver edp) ti
frameworkMessageFun <- wrapExecutorFrameworkMessage $ \edp mcp mlp -> do
bs <- packCStringLen (mcp, fromIntegral mlp)
frameworkMessage c (ExecutorDriver edp) bs
shutdownFun <- wrapExecutorShutdown $ \edp -> shutdown c (ExecutorDriver edp)
errorCallback <- wrapExecutorError $ \edp mcp mlp -> do
bs <- packCStringLen (mcp, fromIntegral mlp)
errorMessage c (ExecutorDriver edp) bs
e <- c_createExecutor registeredFun reRegisteredFun disconnectedFun launchTaskFun taskKilledFun frameworkMessageFun shutdownFun errorCallback
return $ Executor e registeredFun reRegisteredFun disconnectedFun launchTaskFun taskKilledFun frameworkMessageFun shutdownFun errorCallback
destroyExecutor :: Executor -> IO ()
destroyExecutor e = do
c_destroyExecutor $ executorImpl e
freeHaskellFunPtr $ rawExecutorRegistered e
freeHaskellFunPtr $ rawExecutorReRegistered e
freeHaskellFunPtr $ rawExecutorDisconnected e
freeHaskellFunPtr $ rawExecutorLaunchTask e
freeHaskellFunPtr $ rawExecutorTaskKilled e
freeHaskellFunPtr $ rawExecutorFrameworkMessage e
freeHaskellFunPtr $ rawExecutorShutdown e
freeHaskellFunPtr $ rawExecutorErrorCallback e
createDriver :: Executor -> IO ExecutorDriver
createDriver = fmap ExecutorDriver . c_createExecutorDriver . executorImpl
destroyDriver :: ExecutorDriver -> IO ()
destroyDriver = c_destroyExecutorDriver . fromExecutorDriver
start :: ExecutorDriver -> IO Status
start = fmap toStatus . c_startExecutorDriver . fromExecutorDriver
stop :: ExecutorDriver -> IO Status
stop = fmap toStatus . c_stopExecutorDriver . fromExecutorDriver
abort :: ExecutorDriver -> IO Status
abort = fmap toStatus . c_abortExecutorDriver . fromExecutorDriver
await :: ExecutorDriver -> IO Status
await = fmap toStatus . c_joinExecutorDriver . fromExecutorDriver
run :: ExecutorDriver -> IO Status
run = fmap toStatus . c_runExecutorDriver . fromExecutorDriver
sendStatusUpdate :: ExecutorDriver -> TaskStatus -> IO Status
sendStatusUpdate (ExecutorDriver d) s = with (cppValue s) $ \sp -> do
result <- c_sendExecutorDriverStatusUpdate d sp
return $ toStatus result
sendFrameworkMessage :: ExecutorDriver
-> ByteString
-> IO Status
sendFrameworkMessage (ExecutorDriver d) s = with (cstring s) $ \(sp, sl) -> do
result <- c_sendExecutorDriverFrameworkMessage d sp (fromIntegral sl)
return $ toStatus result