Task.hs

-- -*- indent-tabs-mode: nil -*- --

-- | Creation and operations on 'Task's

module Control.Distributed.CCTools.WorkQueue.Internal.Task where

import Control.Distributed.CCTools.WorkQueue.Internal.Cast
import Control.Distributed.CCTools.WorkQueue.Internal.Types
import Control.Distributed.CCTools.WorkQueue.Internal.CastInstances ()

import Bindings.CCTools.WorkQueue

import Foreign.C
import Foreign.Storable

import Control.Applicative ((<$>))
import Control.Lens
import System.IO.Unsafe
import System.Exit (ExitCode (..) )

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS



-- * Task creation/deletion
task :: Command -> IO Task
task c = t'
    where
      t' = T <$> t
      t  = c'work_queue_task_create =<< newCString (view unC c)

delete :: Task -> IO ()
delete t = c'work_queue_task_delete t'
    where
      t' = view unT t

-- * File specifications

specifyFile :: Task -> Location Local -> Location Remote -> FileType -> Cached -> IO ()
specifyFile t l r k c = do
  l' <- newCString $ l^.unL
  r' <- newCString $ r^.unL
  c'work_queue_task_specify_file (t^.unT)
                                 l'
                                 r'
                                 (cast k)
                                 (cast c)


specifyBuffer :: Task -> ByteString -> Location Remote -> Cached -> IO ()
specifyBuffer t s r c =
  BS.useAsCStringLen s $ \(d,l) -> do
    r' <- newCString $ r^.unL
    c'work_queue_task_specify_buffer (t^.unT)
                                     d
                                     (cast l)
                                     r'
                                     (cast c)


specifyFileCommand :: Task -> Location Remote -> Command -> FileType -> Cached -> IO ()
specifyFileCommand t l e k c = do
  path <- newCString $ l^.unL
  cmd' <- newCString $ e^.unC
  c'work_queue_task_specify_file_command (t^.unT)
                                         path
                                         cmd'
                                         (cast k)
                                         (cast c)

specifyTag :: Task -> String -> IO ()
specifyTag t s = c'work_queue_task_specify_tag (t^.unT) =<< newCString s

specifyAlgorithm :: Task -> WorkerScheduleAlg -> IO ()
specifyAlgorithm t a = c'work_queue_task_specify_algorithm (t^.unT) (cast a)


-- * Task properties

withTask :: (a -> IO b) -> (C'work_queue_task -> a) -> Task -> IO b
withTask g f t = g =<< f <$> peek (t^.unT)

unsafeWithTask :: (a -> IO b) -> (C'work_queue_task -> a) -> Task -> b
unsafeWithTask g f = unsafeDupablePerformIO . withTask g f

tag :: Task -> String
tag = unsafeWithTask peekCString c'work_queue_task'tag

command :: Task -> Command
command = unsafeWithTask (fmap C . peekCString) c'work_queue_task'command_line

workerSelectionAlgorithm :: Task -> WorkerScheduleAlg
workerSelectionAlgorithm = unsafeWithTask (return . cast) c'work_queue_task'worker_selection_algorithm

output :: Task -> ByteString
output = unsafeWithTask BS.packCString c'work_queue_task'output

taskID :: Task -> TaskID
taskID = unsafeWithTask (return . TID . fromIntegral) c'work_queue_task'taskid

returnStatus :: Task -> ExitCode
returnStatus = unsafeWithTask mkExitCode c'work_queue_task'return_status
    where mkExitCode             = return . exitcode . fromIntegral
          exitcode c | c == 0    = ExitSuccess
                     | otherwise = ExitFailure c

result :: Task -> Maybe ()
result = unsafeWithTask mkMaybe c'work_queue_task'result
    where mkMaybe                = return . mkMaybe' . fromIntegral
          mkMaybe' s | s == 0    = Just ()
                     | otherwise = Nothing

host :: Task -> Hostname
host = unsafeWithTask (fmap H . peekCString) c'work_queue_task'hostname

taskTimeType :: Integral a => (a -> t) -> (C'work_queue_task -> a) -> Task -> t
taskTimeType c = unsafeWithTask (return . c)

taskEpochTime :: Integral a => (C'work_queue_task -> a) -> Task -> EpochTime MicroSeconds
taskEpochTime f = taskTimeType ET (fromIntegral . f)

taskTime :: Integral a => (C'work_queue_task -> a) -> Task -> DiffTime MicroSeconds
taskTime f = taskTimeType DT (fromIntegral . f)

submitTime :: Task -> EpochTime MicroSeconds
submitTime = taskEpochTime c'work_queue_task'time_task_submit

finishTime :: Task -> EpochTime MicroSeconds
finishTime = taskEpochTime c'work_queue_task'time_task_finish

appDelayTime :: Task -> EpochTime MicroSeconds
appDelayTime = taskEpochTime c'work_queue_task'time_app_delay

timeSendInputStart :: Task -> EpochTime MicroSeconds
timeSendInputStart = taskEpochTime c'work_queue_task'time_send_input_start

timeSendInputFinish :: Task -> EpochTime MicroSeconds
timeSendInputFinish = taskEpochTime c'work_queue_task'time_send_input_finish

sendTime :: Task -> DiffTime MicroSeconds
sendTime t = t1 `diffTime` t0
    where t0 = timeSendInputStart t
          t1 = timeSendInputFinish t

timeExecuteCmdStart :: Task -> EpochTime MicroSeconds
timeExecuteCmdStart = taskEpochTime c'work_queue_task'time_execute_cmd_start

timeExecuteCmdFinish :: Task -> EpochTime MicroSeconds
timeExecuteCmdFinish = taskEpochTime c'work_queue_task'time_execute_cmd_finish

timeExecuteCmd :: Task -> DiffTime MicroSeconds
timeExecuteCmd t = t1 `diffTime` t0
    where t0 = timeExecuteCmdStart  t
          t1 = timeExecuteCmdFinish t

timeReceiveOutputStart :: Task -> EpochTime MicroSeconds
timeReceiveOutputStart = taskEpochTime c'work_queue_task'time_receive_output_start

timeReceiveOutputFinish :: Task -> EpochTime MicroSeconds
timeReceiveOutputFinish = taskEpochTime c'work_queue_task'time_receive_output_finish

timeReceiveOutput :: Task -> DiffTime MicroSeconds
timeReceiveOutput t = t1 `diffTime` t0
    where t0 = timeReceiveOutputStart  t
          t1 = timeReceiveOutputFinish t

totalBytesTransferred :: Task -> DataSize Bytes
totalBytesTransferred = unsafeWithTask (return . DS . fromIntegral) c'work_queue_task'total_bytes_transferred

totalTransferTime :: Task -> DiffTime MicroSeconds
totalTransferTime = taskTime c'work_queue_task'total_transfer_time

totalCmdExecutionTime :: Task -> DiffTime MicroSeconds
totalCmdExecutionTime = taskTime c'work_queue_task'cmd_execution_time