module Gauge.Source.RUsage
( Who
, pattern Self
, pattern Children
, RUsage(..)
, TimeVal(..)
, get
, with
, supported
) where
import Control.Applicative
import Foreign.C.Error (throwErrnoIfMinus1_)
import Foreign.Storable
import Foreign.Ptr
import Foreign.Marshal.Alloc
import Gauge.Time (MicroSeconds(..))
import Foreign.C.Types
import Data.Word
import Prelude
data RUsage = RUsage
{ userCpuTime :: !TimeVal
, systemCpuTime :: !TimeVal
, maxResidentSetSize :: !Word64
, iSharedMemorySize :: !Word64
, iUnsharedDataSize :: !Word64
, iUnsharedStackSize :: !Word64
, minorFault :: !Word64
, majorFault :: !Word64
, nSwap :: !Word64
, inBlock :: !Word64
, outBlock :: !Word64
, msgSend :: !Word64
, msgRecv :: !Word64
, nSignals :: !Word64
, nVoluntaryContextSwitch :: !Word64
, nInvoluntaryContextSwitch :: !Word64
} deriving (Show, Eq)
newtype TimeVal = TimeVal MicroSeconds
deriving (Show,Eq)
instance Storable RUsage where
alignment _ = 8
sizeOf _ = sizeRUsage
peek p = RUsage <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 64)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 72)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 80)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 88)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 96)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 104)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 112)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 120)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 128)) p) )
<*> (clongToW64 <$> ( ((\hsc_ptr -> peekByteOff hsc_ptr 136)) p) )
where
poke p (RUsage utime stime maxrss ixrss idrss isrss minflt majflt nswap
inblock oublock msgsnd msgrcv nsignals nvcsw nivcsw) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p utime
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p stime
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p (w64ToCLong maxrss)
((\hsc_ptr -> pokeByteOff hsc_ptr 40)) p (w64ToCLong ixrss)
((\hsc_ptr -> pokeByteOff hsc_ptr 48)) p (w64ToCLong idrss)
((\hsc_ptr -> pokeByteOff hsc_ptr 56)) p (w64ToCLong isrss)
((\hsc_ptr -> pokeByteOff hsc_ptr 64)) p (w64ToCLong minflt)
((\hsc_ptr -> pokeByteOff hsc_ptr 72)) p (w64ToCLong majflt)
((\hsc_ptr -> pokeByteOff hsc_ptr 80)) p (w64ToCLong nswap)
((\hsc_ptr -> pokeByteOff hsc_ptr 88)) p (w64ToCLong inblock)
((\hsc_ptr -> pokeByteOff hsc_ptr 96)) p (w64ToCLong oublock)
((\hsc_ptr -> pokeByteOff hsc_ptr 104)) p (w64ToCLong msgsnd)
((\hsc_ptr -> pokeByteOff hsc_ptr 112)) p (w64ToCLong msgrcv)
((\hsc_ptr -> pokeByteOff hsc_ptr 120)) p (w64ToCLong nsignals)
((\hsc_ptr -> pokeByteOff hsc_ptr 128)) p (w64ToCLong nvcsw)
((\hsc_ptr -> pokeByteOff hsc_ptr 136)) p (w64ToCLong nivcsw)
instance Storable TimeVal where
alignment _ = 8
sizeOf _ = 16
peek p = toTimeVal <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
<*> ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
where toTimeVal !s !us = TimeVal $! MicroSeconds $! (clongToW64 s * secondsToMicroScale) + clongToW64 us
poke p (TimeVal (MicroSeconds cus)) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p (w64ToCLong s)
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p (w64ToCLong us)
where (s, us) = cus `divMod` secondsToMicroScale
secondsToMicroScale :: Word64
secondsToMicroScale = 1000000
w64ToCLong :: Word64 -> CLong
w64ToCLong = fromIntegral
clongToW64 :: CLong -> Word64
clongToW64 = fromIntegral
sizeRUsage :: Int
sizeRUsage = 144
pattern Self :: Who
pattern Self = (0) :: Who
pattern Children :: Who
pattern Children = (1) :: Who
type Who = CInt
get :: Who -> IO RUsage
get who = alloca $ \ptr -> do
throwErrnoIfMinus1_ "getrusage" (binding_getrusage who ptr)
peek ptr
with :: Who -> IO a -> IO (a, RUsage, RUsage)
with who f = allocaBytes (sizeRUsage * 2) $ \ptr -> do
let ptr2 = ptr `plusPtr` sizeRUsage
throwErrnoIfMinus1_ "getrusage" (binding_getrusage who ptr)
a <- f
throwErrnoIfMinus1_ "getrusage" (binding_getrusage who ptr2)
(,,) <$> pure a <*> peek ptr <*> peek ptr2
foreign import ccall unsafe "getrusage"
binding_getrusage :: Who -> Ptr RUsage -> IO CInt
supported :: Bool
supported = True