diff --git a/drmaa.cabal b/drmaa.cabal --- a/drmaa.cabal +++ b/drmaa.cabal @@ -1,12 +1,12 @@ name: drmaa -version: 0.2.0 -synopsis: A minimal Haskell bindings to DRMAA C library. -description: A minimal Haskell bindings to DRMAA C library. +version: 0.3.0 +synopsis: A Haskell bindings to the DRMAA C library. +description: A Haskell bindings to the DRMAA C library. license: BSD3 license-file: LICENSE author: Kai Zhang maintainer: kai@kzhang.org -copyright: (c) 2016-2017 Kai Zhang +copyright: (c) 2016-2018 Kai Zhang category: Language build-type: Simple extra-source-files: ChangeLog.md @@ -16,13 +16,15 @@ ghc-options: -Wall exposed-modules: DRMAA + DRMAA.Types + DRMAA.Bindings build-depends: base >=4.7 && <5.0 - , inline-c , directory + , exceptions hs-source-dirs: src - c-sources: src/DRMAA.c + build-tools: c2hs >=0.25.0 extra-libraries: drmaa default-language: Haskell2010 diff --git a/src/DRMAA.c b/src/DRMAA.c deleted file mode 100644 --- a/src/DRMAA.c +++ /dev/null @@ -1,148 +0,0 @@ - -#include "stddef.h" - -#include "stdio.h" - -#include "drmaa.h" - -int inline_c_DRMAA_0_54e600eaaa1f15b2d247a7799eeb2c2626774aa9(char * ptr_inline_c_0) { - - int errnum = 0; - errnum = drmaa_init (NULL, ptr_inline_c_0, DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - return 1; - } - return 0; - -} - - -int inline_c_DRMAA_1_df791815daa185d543e0513c42f96dbbd8b8b214() { - - char error[DRMAA_ERROR_STRING_BUFFER]; - int errnum = 0; - errnum = drmaa_exit (error, DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not shut down the DRMAA library: %s\n", error); - return 1; - } - return 0; - -} - - -int inline_c_DRMAA_2_f3edb2a436e7c708ac077181355a61d0a274be4a(char * wd_inline_c_0, const char ** envPtr_inline_c_1, char * native_inline_c_2, char * c_exec_inline_c_3, const char ** aptr_inline_c_4) { - - int exception = 0; - char error[DRMAA_ERROR_STRING_BUFFER]; - int errnum = 0; - drmaa_job_template_t *jt = NULL; - - errnum = drmaa_allocate_job_template (&jt, error, DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not create job template: %s\n", error); - } else { - /* set options */ - errnum = drmaa_set_attribute (jt, DRMAA_WD, wd_inline_c_0, - error, DRMAA_ERROR_STRING_BUFFER); - errnum = drmaa_set_vector_attribute (jt, DRMAA_V_ENV, envPtr_inline_c_1, - error, DRMAA_ERROR_STRING_BUFFER); - errnum = drmaa_set_attribute (jt, DRMAA_NATIVE_SPECIFICATION, native_inline_c_2, - error, DRMAA_ERROR_STRING_BUFFER); - - errnum = drmaa_set_attribute (jt, DRMAA_REMOTE_COMMAND, c_exec_inline_c_3, - error, DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not set attribute \"%s\": %s\n", - DRMAA_REMOTE_COMMAND, error); - } else { - errnum = drmaa_set_vector_attribute (jt, DRMAA_V_ARGV, aptr_inline_c_4, error, - DRMAA_ERROR_STRING_BUFFER); - } - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not set attribute \"%s\": %s\n", - DRMAA_REMOTE_COMMAND, error); - } else { - char jobid[DRMAA_JOBNAME_BUFFER]; - char jobid_out[DRMAA_JOBNAME_BUFFER]; - int status = 0; - drmaa_attr_values_t *rusage = NULL; - - errnum = drmaa_run_job (jobid, DRMAA_JOBNAME_BUFFER, jt, error, - DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not submit job: %s\n", error); - exception = 1; - } else { - printf ("Your job has been submitted with id %s\n", jobid); - - errnum = drmaa_wait (jobid, jobid_out, DRMAA_JOBNAME_BUFFER, &status, - DRMAA_TIMEOUT_WAIT_FOREVER, &rusage, error, - DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not wait for job: %s\n", error); - exception = 1; - } else { - char usage[DRMAA_ERROR_STRING_BUFFER]; - int aborted = 0; - - drmaa_wifaborted(&aborted, status, NULL, 0); - - if (aborted == 1) { - printf("Job %s never ran\n", jobid); - exception = 1; - } else { - int exited = 0; - - drmaa_wifexited(&exited, status, NULL, 0); - - if (exited == 1) { - int exit_status = 0; - - drmaa_wexitstatus(&exit_status, status, NULL, 0); - printf("Job %s finished regularly with exit status %d\n", jobid, exit_status); - exception = exit_status; - } else { - int signaled = 0; - - drmaa_wifsignaled(&signaled, status, NULL, 0); - - if (signaled == 1) { - char termsig[DRMAA_SIGNAL_BUFFER+1]; - - drmaa_wtermsig(termsig, DRMAA_SIGNAL_BUFFER, status, NULL, 0); - printf("Job %s finished due to signal %s\n", jobid, termsig); - } else { - printf("Job %s finished with unclear conditions\n", jobid); - } - } /* else */ - } /* else */ - - /* - printf ("Job Usage:\n"); - - while (drmaa_get_next_attr_value (rusage, usage, DRMAA_ERROR_STRING_BUFFER) == DRMAA_ERRNO_SUCCESS) { - printf (" %s\n", usage); - } - */ - - drmaa_release_attr_values (rusage); - } /* else */ - } /* else */ - } /* else */ - - errnum = drmaa_delete_job_template (jt, error, DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not delete job template: %s\n", error); - } - } /* else */ - - return exception; - -} - diff --git a/src/DRMAA.hs b/src/DRMAA.hs --- a/src/DRMAA.hs +++ b/src/DRMAA.hs @@ -1,215 +1,177 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE LambdaCase #-} module DRMAA ( withSession - , initSession - , exitSession - , DrmaaAttribute(..) - , defaultDrmaaConfig - , drmaaRun + , JobAttributes(..) + , JobId(..) + , JobResult(..) + , RUsage(..) + , ExitStatus(..) + , defaultJobAttributes + , runAndWait + , runJob + , waitJob + , version ) where -import Control.Exception (bracket_) -import Control.Monad (when) -import Foreign.C.String -import Foreign.Marshal.Alloc -import Foreign.Marshal.Array -import Foreign.Ptr -import qualified Language.C.Inline as C +import Control.Monad (when, unless) +import Control.Monad.Catch (MonadMask, bracket, bracket_) +import Control.Monad.IO.Class (liftIO, MonadIO) import System.Directory (getCurrentDirectory) -import Text.Printf (printf) - -C.include "stddef.h" -C.include "stdio.h" -C.include "drmaa.h" +import Data.Maybe +import Data.List (break) +import Control.Arrow (second) +import Foreign +import Foreign.C.String -withSession :: IO a -> IO a -withSession = bracket_ initSession exitSession +import DRMAA.Bindings +import DRMAA.Types -{- -drmaaScript :: String -> DrmaaAttribute -> IO () -drmaaScript script config = bracket - (shelly $ fmap (T.unpack . head . T.lines) $ silently $ run "mktemp" [template]) - (shelly . rm . fromText . T.pack) - $ \tmpFl -> do - writeFile tmpFl $ "#!/bin/sh\n" ++ script - shelly $ run_ "chmod" ["+x", T.pack tmpFl] - drmaaRun tmpFl [] config +withSession :: (MonadIO m, MonadMask m) => m a -> m a +withSession = bracket_ start quit where - template = T.pack $ drmaa_wd config ++ "/drmaa_script.XXXXXXXX.delete.me.sh" - -} - --- | Initialize a session -initSession :: IO () -initSession = alloca $ \ptr -> do - status <- [C.block| int { - int errnum = 0; - errnum = drmaa_init (NULL, $(char* ptr), DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - return 1; - } - return 0; - }|] - when (status /= 0) $ peekCString ptr >>= error -{-# INLINE initSession #-} - -exitSession :: IO () -exitSession = do - r <- [C.block| int { - char error[DRMAA_ERROR_STRING_BUFFER]; - int errnum = 0; - errnum = drmaa_exit (error, DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not shut down the DRMAA library: %s\n", error); - return 1; - } - return 0; - }|] - when (r /= 0) $ error "Exit 1" -{-# INLINE exitSession #-} - -data DrmaaAttribute = DrmaaAttribute - { drmaa_wd :: !(Maybe FilePath) - , drmaa_env :: ![(String, String)] - , drmaa_native :: !String - } deriving (Show, Read) - -defaultDrmaaConfig :: DrmaaAttribute -defaultDrmaaConfig = DrmaaAttribute - { drmaa_wd = Nothing - , drmaa_env = [ ("DRMAA_ENV_HAS_SET", "True") ] - , drmaa_native = "" - } - -drmaaRun :: FilePath -> [String] -> DrmaaAttribute -> IO () -drmaaRun exec args config = do - c_exec <- newCString exec - c_args <- mapM newCString args - - -- options - wd <- get_wd (drmaa_wd config) >>= newCString - env <- mapM (\(a,b) -> newCString $ a ++ "=" ++ b) $ drmaa_env config - native <- newCString $ drmaa_native config - - e <- withArray (c_args++[nullPtr]) $ \aptr -> - withArray (env ++ [nullPtr]) $ \envPtr -> do - [C.block| int { - int exception = 0; - char error[DRMAA_ERROR_STRING_BUFFER]; - int errnum = 0; - drmaa_job_template_t *jt = NULL; - - errnum = drmaa_allocate_job_template (&jt, error, DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not create job template: %s\n", error); - } else { - /* set options */ - errnum = drmaa_set_attribute (jt, DRMAA_WD, $(char* wd), - error, DRMAA_ERROR_STRING_BUFFER); - errnum = drmaa_set_vector_attribute (jt, DRMAA_V_ENV, $(const char** envPtr), - error, DRMAA_ERROR_STRING_BUFFER); - errnum = drmaa_set_attribute (jt, DRMAA_NATIVE_SPECIFICATION, $(char* native), - error, DRMAA_ERROR_STRING_BUFFER); - - errnum = drmaa_set_attribute (jt, DRMAA_REMOTE_COMMAND, $(char* c_exec), - error, DRMAA_ERROR_STRING_BUFFER); - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not set attribute \"%s\": %s\n", - DRMAA_REMOTE_COMMAND, error); - } else { - errnum = drmaa_set_vector_attribute (jt, DRMAA_V_ARGV, $(const char** aptr), error, - DRMAA_ERROR_STRING_BUFFER); - } - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not set attribute \"%s\": %s\n", - DRMAA_REMOTE_COMMAND, error); - } else { - char jobid[DRMAA_JOBNAME_BUFFER]; - char jobid_out[DRMAA_JOBNAME_BUFFER]; - int status = 0; - drmaa_attr_values_t *rusage = NULL; - - errnum = drmaa_run_job (jobid, DRMAA_JOBNAME_BUFFER, jt, error, - DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not submit job: %s\n", error); - exception = 1; - } else { - printf ("Your job has been submitted with id %s\n", jobid); - - errnum = drmaa_wait (jobid, jobid_out, DRMAA_JOBNAME_BUFFER, &status, - DRMAA_TIMEOUT_WAIT_FOREVER, &rusage, error, - DRMAA_ERROR_STRING_BUFFER); - - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not wait for job: %s\n", error); - exception = 1; - } else { - char usage[DRMAA_ERROR_STRING_BUFFER]; - int aborted = 0; - - drmaa_wifaborted(&aborted, status, NULL, 0); - - if (aborted == 1) { - printf("Job %s never ran\n", jobid); - exception = 1; - } else { - int exited = 0; + start = liftIO $ allocaBytes 1000 $ \errMsg -> do + exitCode <- drmaaInit nullPtr errMsg 1000 + unless (exitCode == 0) $ peekCString errMsg >>= error + quit = liftIO $ allocaBytes 1000 $ \errMsg -> do + exitCode <- drmaaExit errMsg 1000 + unless (exitCode == 0) $ peekCString errMsg >>= error - drmaa_wifexited(&exited, status, NULL, 0); +data JobAttributes = JobAttributes + { _wd :: Maybe FilePath -- ^ specifies the directory name where the job will be executed. + , _job_name :: String -- ^ A job name SHALL contain only alphanumeric and '_' characters. + , _native_specification :: Maybe String + , _env :: [(String, String)] + } deriving (Show) - if (exited == 1) { - int exit_status = 0; +defaultJobAttributes :: JobAttributes +defaultJobAttributes = JobAttributes + { _wd = Nothing + , _job_name = "drmaa" + , _native_specification = Nothing + , _env = [] } - drmaa_wexitstatus(&exit_status, status, NULL, 0); - printf("Job %s finished regularly with exit status %d\n", jobid, exit_status); - exception = exit_status; - } else { - int signaled = 0; +setJobAttributes :: JobAttributes -> JobTemplate -> IO () +setJobAttributes JobAttributes{..} jt = do + setAttribute jt "drmaa_job_name" _job_name + setAttribute jt "drmaa_wd" =<< get_wd _wd + when (isJust _native_specification) $ + setAttribute jt "drmaa_native_specification" $ fromJust _native_specification + unless (null _env) $ + setVectorAttribute jt "drmaa_v_env" $ map (\(a,b) -> a ++ "=" ++ b) _env +{-# INLINE setJobAttributes #-} - drmaa_wifsignaled(&signaled, status, NULL, 0); +setAttribute :: JobTemplate -> String -> String -> IO () +setAttribute jt name value = allocaBytes 200 $ \errMsg -> do + exitCode <- drmaaSetAttribute jt name value errMsg 200 + unless (exitCode == 0) $ peekCString errMsg >>= error +{-# INLINE setAttribute #-} - if (signaled == 1) { - char termsig[DRMAA_SIGNAL_BUFFER+1]; +setVectorAttribute :: JobTemplate -> String -> [String] -> IO () +setVectorAttribute jt name value = allocaBytes 200 $ \errMsg -> + bracket (mapM newCString value) (mapM_ free) $ \strings -> + withArray0 nullPtr strings $ \vec -> do + exitCode <- drmaaSetVectorAttribute jt name vec errMsg 200 + unless (exitCode == 0) $ peekCString errMsg >>= error +{-# INLINE setVectorAttribute #-} - drmaa_wtermsig(termsig, DRMAA_SIGNAL_BUFFER, status, NULL, 0); - printf("Job %s finished due to signal %s\n", jobid, termsig); - } else { - printf("Job %s finished with unclear conditions\n", jobid); - } - } /* else */ - } /* else */ +withJobAttributes :: JobAttributes -> (JobTemplate -> IO a) -> IO a +withJobAttributes ja fun = allocaJobTemplate $ \jt -> do + setJobAttributes ja jt + fun jt +{-# INLINE withJobAttributes #-} - /* - printf ("Job Usage:\n"); +newtype JobId = JobId { getJobId :: String } - while (drmaa_get_next_attr_value (rusage, usage, DRMAA_ERROR_STRING_BUFFER) == DRMAA_ERRNO_SUCCESS) { - printf (" %s\n", usage); - } - */ +-- | Submit a job and wait for the result. +runAndWait :: FilePath -- ^ command + -> [String] -- ^ arguments + -> JobAttributes -- ^ attributes + -> IO (JobResult, RUsage) +runAndWait cmd args ja = runJob cmd args ja >>= \case + Left err -> error err + Right jid -> waitJob jid - drmaa_release_attr_values (rusage); - } /* else */ - } /* else */ - } /* else */ +-- | Submit a job. The thread won't block. +runJob :: FilePath -- ^ command + -> [String] -- ^ arguments + -> JobAttributes -- ^ attributes + -> IO (Either String JobId) +runJob cmd args ja = withJobAttributes ja $ \jt -> allocaBytes 100 $ \jobId -> + allocaBytes 200 $ \errMsg -> do + setAttribute jt "drmaa_remote_command" cmd + setVectorAttribute jt "drmaa_v_argv" args + exitCode <- drmaaRunJob jobId 100 jt errMsg 200 + if exitCode == 0 + then Right . JobId <$> peekCString jobId + else Left <$> peekCString errMsg +{-# INLINE runJob #-} - errnum = drmaa_delete_job_template (jt, error, DRMAA_ERROR_STRING_BUFFER); +data RUsage = RUsage [(String, String)] deriving (Show) - if (errnum != DRMAA_ERRNO_SUCCESS) { - fprintf (stderr, "Could not delete job template: %s\n", error); - } - } /* else */ +-- | Wait for a job to finish. +waitJob :: JobId -> IO (JobResult, RUsage) +waitJob (JobId jid) = allocaBytes 100 $ \finished -> alloca $ \status -> + alloca $ \attr -> allocaBytes 100 $ \errMsg -> do + exitCode <- drmaaWait jid finished 100 status (-1) attr errMsg 100 + case getExitStatus exitCode of + Success -> do + result <- peek status >>= getJobResult + usage <- consumeAttrValues =<< peek attr + return (result, RUsage $ map (second tail . break (=='=')) usage) + e -> error $ "Could not wait job: " ++ show e + where + getJobResult st = alloca $ \tmp -> do + let aborted next = drmaaWifaborted tmp st nullPtr 0 >> peek tmp >>= + (\x -> if x == 1 then return Aborted else next) + exited next = drmaaWifexited tmp st nullPtr 0 >> peek tmp >>= ( \x -> + if x == 1 + then drmaaWexitstatus tmp st nullPtr 0 >> + peek tmp >>= return . Exit . getExitStatus + else next ) + signaled next = drmaaWifsignaled tmp st nullPtr 0 >> peek tmp >>= ( \x -> + if x == 1 + then allocaBytes 100 $ \buf -> + drmaaWtermsig buf 100 st nullPtr 0 >> + peekCString buf >>= return . Signaled + else next ) + aborted $ exited $ signaled $ error "Job finished with unclear conditions" +{-# INLINE waitJob #-} - return exception; - }|] - when (e/=0) $ error $ printf - "Job failed (status=%d). Please see SGE log for details" - (fromIntegral e :: Int) +consumeAttrValues :: Ptr AttrValues -> IO [String] +consumeAttrValues ptr = allocaBytes 1024 $ \tmp -> do + result <- loop tmp + drmaaReleaseAttrValues ptr + return result + where + loop tmp = do + exitCode <- drmaaGetNextAttrValue ptr tmp 1024 + if (exitCode == 0) + then do + x <- peekCString tmp + xs <- loop tmp + return $ x : xs + else return [] +{-# INLINE consumeAttrValues #-} get_wd :: Maybe FilePath -> IO FilePath get_wd Nothing = getCurrentDirectory get_wd (Just x) = return x {-# INLINE get_wd #-} + +version :: IO String +version = alloca $ \major -> alloca $ \minor -> allocaBytes 100 $ \impl -> + allocaBytes 200 $ \errMsg -> do + exitCode <- drmaaVersion major minor errMsg 200 + v <- if (exitCode == 0) + then do + x <- peek major + y <- peek minor + return $ show x ++"." ++ show y + else error =<< peekCString errMsg + + exitCode' <- drmaaGetDRMAAImplementation impl 100 errMsg 200 + i <- if (exitCode' == 0) + then peekCString impl + else error =<< peekCString errMsg + return $ "DRMAA v" ++ v ++ "; Implementation: " ++ i diff --git a/src/DRMAA/Bindings.chs b/src/DRMAA/Bindings.chs new file mode 100644 --- /dev/null +++ b/src/DRMAA/Bindings.chs @@ -0,0 +1,250 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module DRMAA.Bindings + ( -- * Opaque data types + JobTemplate + , AttrValues + + -- * String Vector Helper Functions + , drmaaGetNextAttrValue + , drmaaGetNumAttrValues + , drmaaReleaseAttrValues + + -- * Session management + , drmaaInit + , drmaaExit + + + -- * Job template + , allocaJobTemplate + , drmaaSetAttribute + , drmaaSetVectorAttribute + , drmaaGetAttribute + + -- * Job submission + , drmaaRunJob + + -- * Job status and control + , drmaaJobPs + , drmaaWait + , drmaaWifexited + , drmaaWexitstatus + , drmaaWifsignaled + , drmaaWtermsig + , drmaaWcoredump + , drmaaWifaborted + + , drmaaVersion + , drmaaGetDRMAAImplementation + ) where + +import Foreign +import Foreign.C.Types +import Foreign.C.String +import Control.Exception (bracket_) + +#include "drmaa.h" + +------------------------------------------------------------------------------- +-- Opaque Data Types +------------------------------------------------------------------------------- + +newtype JobTemplate = JobTemplate (Ptr JobTemplate) + +unJobTempate :: JobTemplate -> Ptr a +unJobTempate (JobTemplate ptr) = castPtr ptr + +data AttrValues + +------------------------------------------------------------------------------- +-- String Vector Helper Functions +------------------------------------------------------------------------------- + +{#fun drmaa_get_next_attr_value as ^ + { castPtr `Ptr AttrValues' + , `CString' + , `CInt' + } -> `CInt' #} + +{#fun drmaa_get_num_attr_values as ^ + { castPtr `Ptr AttrValues' + , castPtr `Ptr CULong' + } -> `CInt' #} + +{#fun drmaa_release_attr_values as ^ + { castPtr `Ptr AttrValues' + } -> `()' #} + + +------------------------------------------------------------------------------- +-- Session Management +------------------------------------------------------------------------------- + +{#fun drmaa_init as ^ + { `CString' -- ^ A string indicating to which DRMS the DRMAA + -- session should bind during initialization. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_exit as ^ + { `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +------------------------------------------------------------------------------- +-- Job template +------------------------------------------------------------------------------- + +allocaJobTemplate :: (JobTemplate -> IO a) -> IO a +allocaJobTemplate fun = alloca $ \jt_ptr -> bracket_ + (drmaaAllocateJobTemplate jt_ptr nullPtr 0) + ( do p <- peek jt_ptr + drmaaDeleteJobTemplate p nullPtr 0 ) + (peek jt_ptr >>= fun . JobTemplate . castPtr) + +{#fun drmaa_allocate_job_template as ^ + { id `Ptr (Ptr ())', `CString', `CInt' + } -> `CInt' #} + +{#fun drmaa_delete_job_template as ^ + { id `Ptr ()', `CString', `CInt' + } -> `CInt' #} + +{#fun drmaa_set_attribute as ^ + { unJobTempate `JobTemplate' -- ^ The job template in which the + -- attribute is to be set. + , `String' -- ^ The name of the attribute to set. + , `String' -- ^ The value to which to set the attribute. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_get_attribute as ^ + { unJobTempate `JobTemplate' -- ^ The job template from which to get the + -- attribute value. + , `String' -- ^ The name of the attribute whose value will be retrieved. + , `CString' -- ^ A buffer into which the attribute's value will be written. + , `CInt' -- ^ The size in characters of the attribute value buffer. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_set_vector_attribute as ^ + { unJobTempate `JobTemplate' -- ^ The job template in which the + -- attribute is to be set. + , `String' -- ^ The name of the attribute to set. + , id `Ptr CString' -- ^ The value array to which to set the attribute. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{- +int drmaa_get_vector_attribute(drmaa_job_template_t *jt, + const char *name, + drmaa_attr_values_t **values, + char *error_diagnosis, + size_t error_diag_len); +int drmaa_get_attribute_names(drmaa_attr_names_t **values, + char *error_diagnosis, + size_t error_diag_len); +int drmaa_get_vector_attribute_names(drmaa_attr_names_t **values, + char *error_diagnosis, + size_t error_diag_len); + -} + + +------------------------------------------------------------------------------- +-- Job Submission +------------------------------------------------------------------------------- + +{#fun drmaa_run_job as ^ + { `CString' -- ^ A buffer into which the submitted + -- job's job identifier will be written. + , `CInt' -- ^ The size in characters of the job identifier buffer. + , unJobTempate `JobTemplate' -- ^ The job template in which the + -- attribute is to be set. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + + +------------------------------------------------------------------------------- +-- Job Status and Control +------------------------------------------------------------------------------- + +{#fun drmaa_job_ps as ^ + { `String' -- ^ The job identifier of the job to be queried. + , id `Ptr CInt' -- ^ Space to write the job's status information. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wait as ^ + { `String' -- ^ The job identifier of the job for which to wait. + , `CString' -- ^ A buffer into which the finished job identifier will be written. + , `CULong' -- ^ The size in characters of the job identifier buffer. + , id `Ptr CInt' -- ^ Space to write the status code of the finished job. + , `CLong' -- ^ The number of seconds to remain blocked waiting for a result + , castPtr `Ptr (Ptr AttrValues)' -- ^ Space to write the resouce usage information of the finished job. + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wifexited as ^ + { id `Ptr CInt' -- ^ Space to write whether the job has an exit status available. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wexitstatus as ^ + { id `Ptr CInt' -- ^ Space to write job's exit status. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wifsignaled as ^ + { id `Ptr CInt' -- ^ Space to write whether the job terminated on a signal. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wtermsig as ^ + { `CString' -- ^ A buffer in which to write the name of the signal. + , `CULong' -- ^ The size in characters of the signal buffer. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wcoredump as ^ + { id `Ptr CInt' -- ^ Space in which to write whether the job produce a core image. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_wifaborted as ^ + { id `Ptr CInt' -- ^ Space in which to write whether the job aborted before running. + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + + +{#fun drmaa_version as ^ + { id `Ptr CUInt' + , id `Ptr CUInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} + +{#fun drmaa_get_DRMAA_implementation as ^ + { `CString' + , `CInt' + , `CString' -- ^ A buffer into which error diagnosis information will be written. + , `CInt' -- ^ The size in characters of the error diagnosis string buffer. + } -> `CInt' #} diff --git a/src/DRMAA/Types.hs b/src/DRMAA/Types.hs new file mode 100644 --- /dev/null +++ b/src/DRMAA/Types.hs @@ -0,0 +1,66 @@ +module DRMAA.Types + ( ExitStatus(..) + , JobResult(..) + , getExitStatus + ) where + +import Foreign.C.Types + +data JobResult = Exit ExitStatus + | Aborted + | Signaled String + deriving (Show, Eq) + +data ExitStatus = Success + | InternalError + | DrmCommunicationFailure + | AuthFailure + | InValidArgument + | NoActiveSession + | NoMemory + | InvalidContactString + | DefaultContactStringError + | DrmsInitFailed + | AlreadyActiveSession + | DrmsExitError + | InvalidAttribureFormat + | InvalidAttribureValue + | ConflictingAttributeValues + | TryLater + | DeniedByDrm + | InvalidJob + | ResumeInconsistentState + | SuspendInconsistentState + | HoldInconsistentState + | ReleaseInconsistentState + | ExitTimeout + | NoRusage + deriving (Show, Eq) + +getExitStatus :: CInt -> ExitStatus +getExitStatus code = case code of + 0 -> Success + 1 -> InternalError + 2 -> DrmCommunicationFailure + 3 -> AuthFailure + 4 -> InValidArgument + 5 -> NoActiveSession + 6 -> NoMemory + 7 -> InvalidContactString + 8 -> DefaultContactStringError + 9 -> DrmsInitFailed + 10 -> AlreadyActiveSession + 11 -> DrmsExitError + 12 -> InvalidAttribureFormat + 13 -> InvalidAttribureValue + 14 -> ConflictingAttributeValues + 15 -> TryLater + 16 -> DeniedByDrm + 17 -> InvalidJob + 18 -> ResumeInconsistentState + 19 -> SuspendInconsistentState + 20 -> HoldInconsistentState + 21 -> ReleaseInconsistentState + 22 -> ExitTimeout + 23 -> NoRusage + _ -> error "Unknown status code"