module Hope.Module.RUsage (module_rusage) where

import Hope.Module

import Control.Monad
import Foreign
import Foreign.C

#include <sys/time.h>
#include <sys/resource.h>

data RUsage

foreign import ccall "sys/resource.h getrusage" getrusage 
    :: CInt -> Ptr RUsage -> IO CInt

module_rusage :: Module
module_rusage = 
    emptyModule { 
                 moduleName = "rusage",
                 moduleStatus = status
                }

-- * Status

status :: Hope [(String,String)]
status = liftIO rusage

-- * getrusage(2) interface

rusage :: IO [(String,String)]
rusage = allocaBytes #{size struct rusage} $ f
    where f ru = do getrusage_self ru
                    rusageFields ru

rusageFields :: Ptr RUsage -> IO [(String,String)]
rusageFields p = mapM ($ p) fs
    where fs = [rusageFieldLong "MAXRSS" #{peek struct rusage, ru_maxrss},
                rusageFieldLong "IXRSS"  #{peek struct rusage, ru_ixrss},
                rusageFieldLong "IDRSS"  #{peek struct rusage, ru_idrss},
                rusageFieldLong "ISRSS"  #{peek struct rusage, ru_isrss},
                rusageFieldLong "MINFLT"  #{peek struct rusage, ru_minflt},
                rusageFieldLong "MAJFLT"  #{peek struct rusage, ru_majflt},
                rusageFieldLong "NSWAP"  #{peek struct rusage, ru_nswap},
                rusageFieldLong "INBLOCK"  #{peek struct rusage, ru_inblock},
                rusageFieldLong "OUBLOCK"  #{peek struct rusage, ru_oublock},
                rusageFieldLong "MSGSND"  #{peek struct rusage, ru_msgsnd},
                rusageFieldLong "MSGRCV"  #{peek struct rusage, ru_msgrcv},
                rusageFieldLong "NSIGNALS"  #{peek struct rusage, ru_nsignals},
                rusageFieldLong "NVCSW"  #{peek struct rusage, ru_nvcsw},
                rusageFieldLong "NIVCSW"  #{peek struct rusage, ru_nivcsw}]

rusageFieldLong :: String -> (Ptr RUsage -> IO CLong) -> Ptr RUsage -> IO (String,String)
rusageFieldLong n p ru = liftM ((,) n . show) $ p ru

getrusage_self :: Ptr RUsage -> IO CInt
getrusage_self = throwErrnoIfMinus1 "getrusage" . getrusage #{const RUSAGE_SELF}