diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -52,7 +52,9 @@ import System.Statgrab main :: IO () -main = runStats $ (snapshot :: Stats Host) >>= liftIO . print +main = do + runStats $ (snapshot :: Stats Host) >>= liftIO . print + runStats $ (snapshots :: Stats [NetworkInterface]) >>= liftIO . print ``` diff --git a/src/System/Statgrab.hs b/src/System/Statgrab.hs --- a/src/System/Statgrab.hs +++ b/src/System/Statgrab.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- Module : System.Statgrab --- Copyright : (c) 2013 Brendan Hay +-- Copyright : (c) 2013-2014 Brendan Hay -- License : This Source Code Form is subject to the terms of -- the Mozilla Public License, v. 2.0. -- A copy of the MPL can be found in the LICENSE file or @@ -22,6 +22,7 @@ -- * Retrieving Statistics , snapshot + , snapshots , Stat , Struct @@ -60,7 +61,6 @@ import qualified Control.Concurrent.Async as Async import qualified Control.Exception as E import Control.Monad -import Control.Monad.CatchIO import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Data.IORef @@ -69,13 +69,13 @@ import System.Statgrab.Internal newtype Stats a = Stats { unwrap :: ReaderT (IORef Word) IO a } - deriving (Applicative, Functor, Monad, MonadIO, MonadCatchIO) + deriving (Applicative, Functor, Monad, MonadIO) -- | Run the 'Stats' Monad, bracketing libstatgrab's sg_init and sg_shutdown -- calls via reference counting to ensure reentrancy. -runStats :: MonadCatchIO m => Stats a -> m a +runStats :: MonadIO m => Stats a -> m a runStats = liftIO - . bracket (sg_init 0 >> sg_drop_privileges >> newIORef 1) destroy + . E.bracket (sg_init 0 >> sg_drop_privileges >> newIORef 1) destroy . runReaderT . unwrap @@ -94,13 +94,18 @@ -- The *_r variants of the libstatgrab functions are used and -- the deallocation strategy is bracketed. snapshot :: (Stat (Struct a), Copy a) => Stats a -snapshot = liftIO $ bracket acquire release copy +snapshot = liftIO (E.bracket acquireN releaseN copy) +{-# INLINE snapshot #-} --- --- Internal +-- | Retrieve a list of statistics from the underlying operating system. -- +-- /See:/ 'snapshot'. +snapshots :: (Stat (Struct a), Copy a) => Stats [a] +snapshots = liftIO (E.bracket acquireN releaseN copyBatch) +{-# INLINE snapshots #-} destroy :: IORef Word -> IO () destroy ref = do n <- atomicModifyIORef' ref $ \n -> (pred n, n) - when (n == 1) $ void sg_shutdown + when (n == 1) $ + void sg_shutdown diff --git a/src/System/Statgrab/Base.hsc b/src/System/Statgrab/Base.hsc --- a/src/System/Statgrab/Base.hsc +++ b/src/System/Statgrab/Base.hsc @@ -1,11 +1,12 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} -- Module : System.Statgrab.Base --- Copyright : (c) 2013 Brendan Hay +-- Copyright : (c) 2013-2014 Brendan Hay -- License : This Source Code Form is subject to the terms of -- the Mozilla Public License, v. 2.0. -- A copy of the MPL can be found in the LICENSE file or @@ -26,13 +27,45 @@ data family Struct a +-- | A wrapper around @Ptr a@ which keeps track of the result @Entries@, +-- needed for 'copyBatch'. +data PtrN a = PtrN + { ptrUnwrap :: Ptr a + , ptrEntries :: !Int + } + +-- | Copy routines to marshall and unmarshall Storable @Stat a@ structures. class Copy a where - copy :: Ptr (Struct a) -> IO a + copyAt :: Ptr (Struct a) -> Int -> IO a + copyBatch :: PtrN (Struct a) -> IO [a] + copy :: PtrN (Struct a) -> IO a + copy PtrN{..} = copyAt ptrUnwrap 0 + copyBatch PtrN{..} = mapM (copyAt ptrUnwrap) entries + where + entries + | ptrEntries > 1 = [0..ptrEntries - 1] + | otherwise = [0] + + {-# MINIMAL copyAt #-} + {-# INLINE copy #-} + {-# INLINE copyBatch #-} + +-- | Bracket routines for acquiring and releasing @Ptr a@s. class Stat a where - acquire :: IO (Ptr a) - release :: Ptr a -> IO Error + acquire :: Entries -> IO (Ptr a) + release :: Ptr a -> IO Error +-- | A wrapper for 'acquire'. This allows tracking the number of @Entries@ +-- contained in a @Ptr a@. +acquireN :: Stat a => IO (PtrN a) +acquireN = alloca $ \x -> PtrN <$> acquire x <*> (fromIntegral <$> peek x) +{-# INLINE acquireN #-} + +releaseN :: Stat a => PtrN a -> IO Error +releaseN = release . ptrUnwrap +{-# INLINE releaseN #-} + type ErrorDetailsPtr = Ptr ErrorDetails type HostPtr = Ptr (Struct Host) type CPUPtr = Ptr (Struct CPU) @@ -102,9 +135,9 @@ } data ErrorDetails = ErrorDetails - { erError :: {-# UNPACK #-} !Error - , erValue :: {-# UNPACK #-} !CInt - , erArg :: {-# UNPACK #-} !CString + { erError :: !Error + , erValue :: !CInt + , erArg :: !CString } foreign import ccall safe "statgrab.h sg_get_error" @@ -158,22 +191,22 @@ } data instance Struct Host = CHost - { hostOsName :: {-# UNPACK #-} !CString - , hostOsRelease :: {-# UNPACK #-} !CString - , hostOsVersion :: {-# UNPACK #-} !CString - , hostPlatform :: {-# UNPACK #-} !CString - , hostName :: {-# UNPACK #-} !CString - , hostBitWidth :: {-# UNPACK #-} !CUInt - , hostState :: {-# UNPACK #-} !HostState - , hostNCPU :: {-# UNPACK #-} !CUInt - , hostMaxCPU :: {-# UNPACK #-} !CUInt - , hostUptime :: {-# UNPACK #-} !CTime - , hostSystime :: {-# UNPACK #-} !CTime + { hostOsName :: !CString + , hostOsRelease :: !CString + , hostOsVersion :: !CString + , hostPlatform :: !CString + , hostName :: !CString + , hostBitWidth :: !CUInt + , hostState :: !HostState + , hostNCPU :: !CUInt + , hostMaxCPU :: !CUInt + , hostUptime :: !CTime + , hostSystime :: !CTime } instance Copy Host where - copy ptr = do - CHost{..} <- peek ptr + copyAt ptr i = do + CHost{..} <- peekElemOff ptr i Host <$> packCString hostOsName <*> packCString hostOsRelease <*> packCString hostOsVersion @@ -217,7 +250,7 @@ #{poke sg_host_info, systime} p hostSystime instance Stat (Struct Host) where - acquire = alloca sg_get_host_info_r + acquire = sg_get_host_info_r release = sg_free_host_info foreign import ccall safe "statgrab.h sg_get_host_info" @@ -230,25 +263,25 @@ sg_free_host_info :: HostPtr -> IO Error data instance Struct CPU = CCPU - { cpuUser :: {-# UNPACK #-} !CLLong - , cpuKernel :: {-# UNPACK #-} !CLLong - , cpuIdle :: {-# UNPACK #-} !CLLong - , cpuIOWait :: {-# UNPACK #-} !CLLong - , cpuSwap :: {-# UNPACK #-} !CLLong - , cpuNice :: {-# UNPACK #-} !CLLong - , cpuTotal :: {-# UNPACK #-} !CLLong - , cpuCtxSwitches :: {-# UNPACK #-} !CLLong - , cpuVoluntaryCtxSwitches :: {-# UNPACK #-} !CLLong - , cpuInvoluntaryCtxSwitches :: {-# UNPACK #-} !CLLong - , cpuSyscalls :: {-# UNPACK #-} !CLLong - , cpuInterrupts :: {-# UNPACK #-} !CLLong - , cpuSoftInterrupts :: {-# UNPACK #-} !CLLong - , cpuSystime :: {-# UNPACK #-} !CTime + { cpuUser :: !CLLong + , cpuKernel :: !CLLong + , cpuIdle :: !CLLong + , cpuIOWait :: !CLLong + , cpuSwap :: !CLLong + , cpuNice :: !CLLong + , cpuTotal :: !CLLong + , cpuCtxSwitches :: !CLLong + , cpuVoluntaryCtxSwitches :: !CLLong + , cpuInvoluntaryCtxSwitches :: !CLLong + , cpuSyscalls :: !CLLong + , cpuInterrupts :: !CLLong + , cpuSoftInterrupts :: !CLLong + , cpuSystime :: !CTime } instance Copy CPU where - copy ptr = do - CCPU{..} <- peek ptr + copyAt ptr i = do + CCPU{..} <- peekElemOff ptr i CPU <%> cpuUser <#> cpuKernel <#> cpuIdle @@ -301,7 +334,7 @@ #{poke sg_cpu_stats, systime} p cpuSystime instance Stat (Struct CPU) where - acquire = alloca sg_get_cpu_stats_r + acquire = sg_get_cpu_stats_r release = sg_free_cpu_stats foreign import ccall safe "statgrab.h sg_get_cpu_stats" @@ -320,18 +353,18 @@ sg_free_cpu_stats :: CPUPtr -> IO Error data instance Struct CPUPercent = CCPUPercent - { cpuPctUser :: {-# UNPACK #-} !CDouble - , cpuPctKernel :: {-# UNPACK #-} !CDouble - , cpuPctIdle :: {-# UNPACK #-} !CDouble - , cpuPctIOWait :: {-# UNPACK #-} !CDouble - , cpuPctSwap :: {-# UNPACK #-} !CDouble - , cpuPctNice :: {-# UNPACK #-} !CDouble - , cpuPctTimeTaken :: {-# UNPACK #-} !CTime + { cpuPctUser :: !CDouble + , cpuPctKernel :: !CDouble + , cpuPctIdle :: !CDouble + , cpuPctIOWait :: !CDouble + , cpuPctSwap :: !CDouble + , cpuPctNice :: !CDouble + , cpuPctTimeTaken :: !CTime } instance Copy CPUPercent where - copy ptr = do - CCPUPercent{..} <- peek ptr + copyAt ptr i = do + CCPUPercent{..} <- peekElemOff ptr i CPUPercent <$> pure (realToFrac cpuPctUser) <@> cpuPctKernel <@> cpuPctIdle @@ -378,16 +411,16 @@ sg_free_cpu_percents :: CPUPercentPtr -> IO Error data instance Struct Memory = CMemory - { memTotal :: {-# UNPACK #-} !CULLong - , memFree :: {-# UNPACK #-} !CULLong - , memUsed :: {-# UNPACK #-} !CULLong - , memCache :: {-# UNPACK #-} !CULLong - , memSystime :: {-# UNPACK #-} !CTime + { memTotal :: !CULLong + , memFree :: !CULLong + , memUsed :: !CULLong + , memCache :: !CULLong + , memSystime :: !CTime } instance Copy Memory where - copy ptr = do - CMemory{..} <- peek ptr + copyAt ptr i = do + CMemory{..} <- peekElemOff ptr i Memory <%> memTotal <#> memFree <#> memUsed @@ -412,7 +445,7 @@ #{poke sg_mem_stats, systime} p memSystime instance Stat (Struct Memory) where - acquire = alloca sg_get_mem_stats_r + acquire = sg_get_mem_stats_r release = sg_free_mem_stats foreign import ccall safe "statgrab.h sg_get_mem_stats" @@ -425,15 +458,15 @@ sg_free_mem_stats :: MemoryPtr -> IO Error data instance Struct Load = CLoad - { load1 :: {-# UNPACK #-} !CDouble - , load5 :: {-# UNPACK #-} !CDouble - , load15 :: {-# UNPACK #-} !CDouble - , loadSystime :: {-# UNPACK #-} !CTime + { load1 :: !CDouble + , load5 :: !CDouble + , load15 :: !CDouble + , loadSystime :: !CTime } instance Copy Load where - copy ptr = do - CLoad{..} <- peek ptr + copyAt ptr i = do + CLoad{..} <- peekElemOff ptr i Load <$> pure (realToFrac load1) <@> load5 <@> load15 @@ -456,7 +489,7 @@ #{poke sg_load_stats, systime} p loadSystime instance Stat (Struct Load) where - acquire = alloca sg_get_load_stats_r + acquire = sg_get_load_stats_r release = sg_free_load_stats foreign import ccall safe "statgrab.h sg_get_load_stats" @@ -469,19 +502,19 @@ sg_free_load_stats :: LoadPtr -> IO Error data instance Struct User = CUser - { userLoginName :: {-# UNPACK #-} !CString - , userRecordId :: {-# UNPACK #-} !CString - , userRecordIdSize :: {-# UNPACK #-} !CSize - , userDevice :: {-# UNPACK #-} !CString - , userHostName :: {-# UNPACK #-} !CString - , userPid :: {-# UNPACK #-} !CInt - , userLoginTime :: {-# UNPACK #-} !CTime - , userSystime :: {-# UNPACK #-} !CTime + { userLoginName :: !CString + , userRecordId :: !CString + , userRecordIdSize :: !CSize + , userDevice :: !CString + , userHostName :: !CString + , userPid :: !CInt + , userLoginTime :: !CTime + , userSystime :: !CTime } instance Copy User where - copy ptr = do - CUser{..} <- peek ptr + copyAt ptr i = do + CUser{..} <- peekElemOff ptr i User <$> packCString userLoginName <*> packCString userRecordId <#> userRecordIdSize @@ -516,7 +549,7 @@ #{poke sg_user_stats, systime} p userSystime instance Stat (Struct User) where - acquire = alloca sg_get_user_stats_r + acquire = sg_get_user_stats_r release = sg_free_user_stats foreign import ccall safe "statgrab.h sg_get_user_stats" @@ -529,15 +562,15 @@ sg_free_user_stats :: UserPtr -> IO Error data instance Struct Swap = CSwap - { swapTotal :: {-# UNPACK #-} !CULLong - , swapUsed :: {-# UNPACK #-} !CULLong - , swapFree :: {-# UNPACK #-} !CULLong - , swapSystime :: {-# UNPACK #-} !CTime + { swapTotal :: !CULLong + , swapUsed :: !CULLong + , swapFree :: !CULLong + , swapSystime :: !CTime } instance Copy Swap where - copy ptr = do - CSwap{..} <- peek ptr + copyAt ptr i = do + CSwap{..} <- peekElemOff ptr i Swap <%> swapTotal <#> swapUsed <#> swapFree @@ -560,7 +593,7 @@ #{poke sg_swap_stats, systime} p swapSystime instance Stat (Struct Swap) where - acquire = alloca sg_get_swap_stats_r + acquire = sg_get_swap_stats_r release = sg_free_swap_stats foreign import ccall safe "statgrab.h sg_get_swap_stats" @@ -583,30 +616,30 @@ } data instance Struct FileSystem = CFileSystem - { fsDeviceName :: {-# UNPACK #-} !CString - , fsType :: {-# UNPACK #-} !CString - , fsMountPoint :: {-# UNPACK #-} !CString - , fsDeviceType :: {-# UNPACK #-} !DeviceType - , fsSize :: {-# UNPACK #-} !CULLong - , fsUsed :: {-# UNPACK #-} !CULLong - , fsFree :: {-# UNPACK #-} !CULLong - , fsAvail :: {-# UNPACK #-} !CULLong - , fsTotalInodes :: {-# UNPACK #-} !CULLong - , fsUsedInodes :: {-# UNPACK #-} !CULLong - , fsFreeInodes :: {-# UNPACK #-} !CULLong - , fsAvailInodes :: {-# UNPACK #-} !CULLong - , fsIOSize :: {-# UNPACK #-} !CULLong - , fsBlockSize :: {-# UNPACK #-} !CULLong - , fsTotalBlocks :: {-# UNPACK #-} !CULLong - , fsFreeBlocks :: {-# UNPACK #-} !CULLong - , fsUsedBlocks :: {-# UNPACK #-} !CULLong - , fsAvailBlocks :: {-# UNPACK #-} !CULLong - , fsSystime :: {-# UNPACK #-} !CTime + { fsDeviceName :: !CString + , fsType :: !CString + , fsMountPoint :: !CString + , fsDeviceType :: !DeviceType + , fsSize :: !CULLong + , fsUsed :: !CULLong + , fsFree :: !CULLong + , fsAvail :: !CULLong + , fsTotalInodes :: !CULLong + , fsUsedInodes :: !CULLong + , fsFreeInodes :: !CULLong + , fsAvailInodes :: !CULLong + , fsIOSize :: !CULLong + , fsBlockSize :: !CULLong + , fsTotalBlocks :: !CULLong + , fsFreeBlocks :: !CULLong + , fsUsedBlocks :: !CULLong + , fsAvailBlocks :: !CULLong + , fsSystime :: !CTime } instance Copy FileSystem where - copy ptr = do - CFileSystem{..} <- peek ptr + copyAt ptr i = do + CFileSystem{..} <- peekElemOff ptr i FileSystem <$> packCString fsDeviceName <*> packCString fsType <*> packCString fsMountPoint @@ -674,7 +707,7 @@ #{poke sg_fs_stats, systime} p fsSystime instance Stat (Struct FileSystem) where - acquire = alloca sg_get_fs_stats_r + acquire = sg_get_fs_stats_r release = sg_free_fs_stats foreign import ccall safe "statgrab.h sg_get_valid_filesystems" @@ -710,15 +743,15 @@ sg_free_fs_stats :: FileSystemPtr -> IO Error data instance Struct DiskIO = CDiskIO - { diskName :: {-# UNPACK #-} !CString - , diskRead :: {-# UNPACK #-} !CULLong - , diskWrite :: {-# UNPACK #-} !CULLong - , diskSystime :: {-# UNPACK #-} !CTime + { diskName :: !CString + , diskRead :: !CULLong + , diskWrite :: !CULLong + , diskSystime :: !CTime } instance Copy DiskIO where - copy ptr = do - CDiskIO{..} <- peek ptr + copyAt ptr i = do + CDiskIO{..} <- peekElemOff ptr i DiskIO <$> packCString diskName <#> diskRead <#> diskWrite @@ -741,7 +774,7 @@ #{poke sg_disk_io_stats, systime} p diskSystime instance Stat (Struct DiskIO) where - acquire = alloca sg_get_disk_io_stats_r + acquire = sg_get_disk_io_stats_r release = sg_free_disk_io_stats foreign import ccall safe "statgrab.h sg_get_disk_io_stats" @@ -769,20 +802,20 @@ sg_free_disk_io_stats :: DiskIOPtr -> IO Error data instance Struct NetworkIO = CNetworkIO - { ifaceIOName :: {-# UNPACK #-} !CString - , ifaceTX :: {-# UNPACK #-} !CULLong - , ifaceRX :: {-# UNPACK #-} !CULLong - , ifaceIPackets :: {-# UNPACK #-} !CULLong - , ifaceOPackets :: {-# UNPACK #-} !CULLong - , ifaceIErrors :: {-# UNPACK #-} !CULLong - , ifaceOErrors :: {-# UNPACK #-} !CULLong - , ifaceCollisions :: {-# UNPACK #-} !CULLong - , ifaceSystem :: {-# UNPACK #-} !CTime + { ifaceIOName :: !CString + , ifaceTX :: !CULLong + , ifaceRX :: !CULLong + , ifaceIPackets :: !CULLong + , ifaceOPackets :: !CULLong + , ifaceIErrors :: !CULLong + , ifaceOErrors :: !CULLong + , ifaceCollisions :: !CULLong + , ifaceSystem :: !CTime } instance Copy NetworkIO where - copy ptr = do - CNetworkIO{..} <- peek ptr + copyAt ptr i = do + CNetworkIO{..} <- peekElemOff ptr i NetworkIO <$> packCString ifaceIOName <#> ifaceTX <#> ifaceRX @@ -820,7 +853,7 @@ #{poke sg_network_io_stats, systime} p ifaceSystem instance Stat (Struct NetworkIO) where - acquire = alloca sg_get_network_io_stats_r + acquire = sg_get_network_io_stats_r release = sg_free_network_io_stats foreign import ccall safe "statgrab.h sg_get_network_io_stats" @@ -856,17 +889,17 @@ } data instance Struct NetworkInterface = CNetworkInterface - { ifaceName :: {-# UNPACK #-} !CString - , ifaceSpeed :: {-# UNPACK #-} !CULLong - , ifaceFactor :: {-# UNPACK #-} !CULLong - , ifaceDuplex :: {-# UNPACK #-} !InterfaceMode - , ifaceUp :: {-# UNPACK #-} !InterfaceStatus - , ifaceSystime :: {-# UNPACK #-} !CTime + { ifaceName :: !CString + , ifaceSpeed :: !CULLong + , ifaceFactor :: !CULLong + , ifaceDuplex :: !InterfaceMode + , ifaceUp :: !InterfaceStatus + , ifaceSystime :: !CTime } instance Copy NetworkInterface where - copy ptr = do - CNetworkInterface{..} <- peek ptr + copyAt ptr i = do + CNetworkInterface{..} <- peekElemOff ptr i NetworkInterface <$> packCString ifaceName <#> ifaceSpeed <#> ifaceFactor @@ -895,7 +928,7 @@ #{poke sg_network_iface_stats, systime} p ifaceSystime instance Stat (Struct NetworkInterface) where - acquire = alloca sg_get_network_iface_stats_r + acquire = sg_get_network_iface_stats_r release = sg_free_network_iface_stats foreign import ccall safe "statgrab.h sg_get_network_iface_stats" @@ -911,14 +944,14 @@ sg_free_network_iface_stats :: NetworkInterfacePtr -> IO Error data instance Struct Page = CPage - { pagesIn :: {-# UNPACK #-} !CULLong - , pagesOut :: {-# UNPACK #-} !CULLong - , pagesSysTime :: {-# UNPACK #-} !CTime + { pagesIn :: !CULLong + , pagesOut :: !CULLong + , pagesSysTime :: !CTime } instance Copy Page where - copy ptr = do - CPage{..} <- peek ptr + copyAt ptr i = do + CPage{..} <- peekElemOff ptr i Page <%> pagesIn <#> pagesOut <@> pagesSysTime @@ -938,7 +971,7 @@ #{poke sg_page_stats, systime} p pagesSysTime instance Stat (Struct Page) where - acquire = alloca sg_get_page_stats_r + acquire = sg_get_page_stats_r release = sg_free_page_stats foreign import ccall safe "statgrab.h sg_get_page_stats" @@ -968,32 +1001,32 @@ } data instance Struct Process = CProcess - { procName :: {-# UNPACK #-} !CString - , procTitle :: {-# UNPACK #-} !CString - , procPid :: {-# UNPACK #-} !CInt - , procParent :: {-# UNPACK #-} !CInt - , procPGid :: {-# UNPACK #-} !CInt - , procSessId :: {-# UNPACK #-} !CInt - , procUid :: {-# UNPACK #-} !CUInt - , procEUid :: {-# UNPACK #-} !CUInt - , procGid :: {-# UNPACK #-} !CUInt - , procEGid :: {-# UNPACK #-} !CUInt - , procSwitches :: {-# UNPACK #-} !CULLong - , procVoluntary :: {-# UNPACK #-} !CULLong - , procInvoluntary :: {-# UNPACK #-} !CULLong - , procSize :: {-# UNPACK #-} !CULLong - , procResident :: {-# UNPACK #-} !CULLong - , procStart :: {-# UNPACK #-} !CTime - , procSpent :: {-# UNPACK #-} !CTime - , procCPUPercent :: {-# UNPACK #-} !CDouble - , procNice :: {-# UNPACK #-} !CInt - , procState :: {-# UNPACK #-} !ProcessState - , procSystime :: {-# UNPACK #-} !CTime + { procName :: !CString + , procTitle :: !CString + , procPid :: !CInt + , procParent :: !CInt + , procPGid :: !CInt + , procSessId :: !CInt + , procUid :: !CUInt + , procEUid :: !CUInt + , procGid :: !CUInt + , procEGid :: !CUInt + , procSwitches :: !CULLong + , procVoluntary :: !CULLong + , procInvoluntary :: !CULLong + , procSize :: !CULLong + , procResident :: !CULLong + , procStart :: !CTime + , procSpent :: !CTime + , procCPUPercent :: !CDouble + , procNice :: !CInt + , procState :: !ProcessState + , procSystime :: !CTime } instance Copy Process where - copy ptr = do - CProcess{..} <- peek ptr + copyAt ptr i = do + CProcess{..} <- peekElemOff ptr i Process <$> packCString procName <*> packCString procTitle <#> procPid @@ -1067,7 +1100,7 @@ #{poke sg_process_stats, systime} p procSystime instance Stat (Struct Process) where - acquire = alloca sg_get_process_stats_r + acquire = sg_get_process_stats_r release = sg_free_process_stats foreign import ccall safe "statgrab.h sg_get_process_stats" @@ -1109,18 +1142,18 @@ } data instance Struct ProcessCount = CProcessCount - { countTotal :: {-# UNPACK #-} !CULLong - , countRunning :: {-# UNPACK #-} !CULLong - , countSleeping :: {-# UNPACK #-} !CULLong - , countStopped :: {-# UNPACK #-} !CULLong - , countZombie :: {-# UNPACK #-} !CULLong - , countUnknown :: {-# UNPACK #-} !CULLong - , countSystime :: {-# UNPACK #-} !CTime + { countTotal :: !CULLong + , countRunning :: !CULLong + , countSleeping :: !CULLong + , countStopped :: !CULLong + , countZombie :: !CULLong + , countUnknown :: !CULLong + , countSystime :: !CTime } instance Copy ProcessCount where - copy ptr = do - CProcessCount{..} <- peek ptr + copyAt ptr i = do + CProcessCount{..} <- peekElemOff ptr i ProcessCount <%> countTotal <#> countRunning <#> countSleeping diff --git a/src/System/Statgrab/Internal.hs b/src/System/Statgrab/Internal.hs --- a/src/System/Statgrab/Internal.hs +++ b/src/System/Statgrab/Internal.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE TypeFamilies #-} -- Module : System.Statgrab.Internal --- Copyright : (c) 2013 Brendan Hay +-- Copyright : (c) 2013-2014 Brendan Hay -- License : This Source Code Form is subject to the terms of -- the Mozilla Public License, v. 2.0. -- A copy of the MPL can be found in the LICENSE file or @@ -20,14 +20,37 @@ import Data.Time.Clock.POSIX import Foreign import Foreign.C.Types +import GHC.Generics (Generic) type Entries = Ptr CSize newtype Error = Error CInt - deriving (Eq, Show) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) newtype HostState = HostState CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data Host = Host { hostOsName :: !ByteString @@ -41,7 +64,7 @@ , hostMaxCPU :: !Integer , hostUptime :: !POSIXTime , hostSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data CPU = CPU { cpuUser :: !Integer @@ -58,10 +81,21 @@ , cpuInterrupts :: !Integer , cpuSoftInterrupts :: !Integer , cpuSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) newtype CPUPercentSource = CPUPercentSource CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data CPUPercent = CPUPercent { cpuPctUser :: !Double @@ -71,7 +105,7 @@ , cpuPctSwap :: !Double , cpuPctNice :: !Double , cpuPctTimeTaken :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data Memory = Memory { memTotal :: !Integer @@ -79,14 +113,14 @@ , memUsed :: !Integer , memCache :: !Integer , memSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data Load = Load { load1 :: !Double , load5 :: !Double , load15 :: !Double , loadSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data User = User { userLoginName :: !ByteString @@ -97,17 +131,28 @@ , userPid :: !Integer , userLoginTime :: !POSIXTime , userSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data Swap = Swap { swapTotal :: !Integer , swapUsed :: !Integer , swapFree :: !Integer , swapSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) newtype DeviceType = DeviceType CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data FileSystem = FileSystem { fsDeviceName :: !ByteString @@ -129,14 +174,14 @@ , fsUsedBlocks :: !Integer , fsAvailBlocks :: !Integer , fsSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data DiskIO = DiskIO { diskName :: !ByteString , diskRead :: !Integer , diskWrite :: !Integer , diskSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data NetworkIO = NetworkIO { ifaceIOName :: !ByteString @@ -148,13 +193,35 @@ , ifaceOErrors :: !Integer , ifaceCollisions :: !Integer , ifaceSystem :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) newtype InterfaceMode = InterfaceMode CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) newtype InterfaceStatus = InterfaceStatus CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data NetworkInterface = NetworkInterface { ifaceName :: !ByteString @@ -163,16 +230,27 @@ , ifaceDuplex :: !InterfaceMode , ifaceUp :: !InterfaceStatus , ifaceSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) data Page = Page { pagesIn :: !Integer , pagesOut :: !Integer , pagesSysTime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) newtype ProcessState = ProcessState CInt - deriving (Eq, Show, Storable) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data Process = Process { procName :: !ByteString @@ -196,10 +274,21 @@ , procNice :: !Integer , procState :: !ProcessState , procSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) newtype ProcessSource = ProcessSource CInt - deriving (Eq, Show) + deriving + ( Eq + , Ord + , Enum + , Bounded + , Integral + , Num + , Real + , Show + , Storable + , Generic + ) data ProcessCount = ProcessCount { countTotal :: !Integer @@ -209,7 +298,7 @@ , countZombie :: !Integer , countUnknown :: !Integer , countSystime :: !POSIXTime - } deriving (Eq, Show) + } deriving (Eq, Ord, Show, Generic) infixl 4 <%>, <#>, <@>, diff --git a/statgrab.cabal b/statgrab.cabal --- a/statgrab.cabal +++ b/statgrab.cabal @@ -1,34 +1,31 @@ name: statgrab -version: 0.1.2 +version: 0.1.3 synopsis: Collect system level metrics and statistics homepage: http://github.com/brendanhay/statgrab license: OtherLicense license-file: LICENSE author: Brendan Hay maintainer: Brendan Hay -copyright: Copyright (c) 2013 Brendan Hay +copyright: Copyright (c) 2013-2014 Brendan Hay stability: Experimental category: System, FFI, Monitoring build-type: Simple cabal-version: >= 1.10 description: - Provides an interface to the cross platform system statistics C library libstatgrab. + Provides an interface to the cross platform system statistics C library, 'libstatgrab'. . It supports a wide range of system statistics including CPU usage, memory utilisation, disk usage, process counts, network traffic, disk I/O, and more. . The current list of supported and tested platforms for the underlying library - includes OSX, FreeBSD, Linux, NetBSD, OpenBSD, Solaris, DragonFly BSD, HP-UX and AIX. + include OSX, FreeBSD, Linux, NetBSD, OpenBSD, Solaris, DragonFly BSD, HP-UX and AIX. . /Requirements:/ . - * libstatgrab @0.9.0@ must be installed on the target system. - . - * Be aware that currently these bindings have been developed and tested - only on OSX/Linux. + * 'libstatgrab' @0.9.0@ must be installed on the target system. . - Haddock documentation can also be found on . + /Note:/ Currently these bindings have only been developed and tested on OSX and Linux. extra-source-files: README.md @@ -42,22 +39,20 @@ hs-source-dirs: src exposed-modules: - System.Statgrab + System.Statgrab other-modules: - System.Statgrab.Base - , System.Statgrab.Internal + System.Statgrab.Base + , System.Statgrab.Internal - ghc-options: - -Wall -O2 + ghc-options: -Wall -funbox-strict-fields -O2 build-depends: - async - , base >= 4 && < 5 - , bytestring - , MonadCatchIO-transformers - , time - , transformers + async + , base >= 4 && < 5 + , bytestring + , time + , transformers extra-libraries: statgrab