statgrab 0.1.2 → 0.1.3
raw patch · 5 files changed
+352/−228 lines, 5 filesdep −MonadCatchIO-transformers
Dependencies removed: MonadCatchIO-transformers
Files
- README.md +3/−1
- src/System/Statgrab.hs +14/−9
- src/System/Statgrab/Base.hsc +207/−174
- src/System/Statgrab/Internal.hs +113/−24
- statgrab.cabal +15/−20
README.md view
@@ -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 ```
src/System/Statgrab.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- Module : System.Statgrab--- Copyright : (c) 2013 Brendan Hay <brendan.g.hay@gmail.com>+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com> -- 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
src/System/Statgrab/Base.hsc view
@@ -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 <brendan.g.hay@gmail.com>+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com> -- 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
src/System/Statgrab/Internal.hs view
@@ -1,8 +1,8 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE TypeFamilies #-} -- Module : System.Statgrab.Internal--- Copyright : (c) 2013 Brendan Hay <brendan.g.hay@gmail.com>+-- Copyright : (c) 2013-2014 Brendan Hay <brendan.g.hay@gmail.com> -- 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 <%>, <#>, <@>, <!>
statgrab.cabal view
@@ -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 <brendan.g.hay@gmail.com>-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 <http://brendanhay.github.io/statgrab/System-Statgrab.html>.+ /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