module Manatee.Extension.ProcessManager.ProcessBuffer where
import Control.Applicative
import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import DBus.Client hiding (Signal)
import Data.Ord
import Data.Typeable
import Graphics.UI.Gtk.General.Enums
import Graphics.UI.Gtk.General.General
import Graphics.UI.Gtk.ModelView.TreeSortable
import Manatee.Core.Types
import Manatee.Extension.ProcessManager.PageMode
import Manatee.Toolkit.General.List
import Manatee.Toolkit.General.Misc
import Manatee.Toolkit.General.STM
import System.Linux.Proc
data ProcessBuffer =
ProcessBuffer {processBufferName :: String
,processBufferClient :: Client
,processBufferPageId :: PageId
,processBufferMode :: PageMode
,processBufferStatus :: TVar [ProcStatus]
,processBufferOptions :: [(ProcOption, SortColumnId)]
,processBufferSortStatus :: TVar (ProcOption, SortType)
,processBufferBroadcastChannel :: TChan ProcTChanSignal
,processBufferDelay :: Int
,processBufferViewCounter :: TVar Int
}
deriving Typeable
data ProcTChanSignal = Empty
| UpdateProcesses
| KillProcess Int
deriving (Show, Eq, Ord)
class ProcStatusClass a where
getColumnTitle :: a -> String
getColumnMaxWidth :: a -> Maybe Int
getCellText :: a -> ProcStatus -> String
getCellXAlign :: a -> Float
compareRow :: a -> ProcStatus -> ProcStatus -> IO Ordering
data ProcOption = MProcessId
| MCommand
| MState
| MParentProcessId
| MProcessGroupId
| MSessionId
| MPriority
| MThreads
| MCPUPercent
| MVirtualMemory
| MResidentMemory
| MCmdline
| MUser
deriving (Eq, Show, Read)
instance ProcStatusClass ProcOption where
getColumnTitle MProcessId = "Process Id"
getColumnTitle MCommand = "Name"
getColumnTitle MState = "Status"
getColumnTitle MParentProcessId = "Parent Process Id"
getColumnTitle MProcessGroupId = "Group Id"
getColumnTitle MSessionId = "Session Id"
getColumnTitle MPriority = "Priority"
getColumnTitle MThreads = "Threads"
getColumnTitle MCPUPercent = "CPU"
getColumnTitle MVirtualMemory = "Virtual Memory"
getColumnTitle MResidentMemory = "Resident Memory"
getColumnTitle MCmdline = "Command line"
getColumnTitle MUser = "User"
getColumnMaxWidth MProcessId = Nothing
getColumnMaxWidth MCommand = Just 500
getColumnMaxWidth MState = Nothing
getColumnMaxWidth MParentProcessId = Nothing
getColumnMaxWidth MProcessGroupId = Nothing
getColumnMaxWidth MSessionId = Nothing
getColumnMaxWidth MPriority = Nothing
getColumnMaxWidth MThreads = Nothing
getColumnMaxWidth MCPUPercent = Nothing
getColumnMaxWidth MVirtualMemory = Nothing
getColumnMaxWidth MResidentMemory = Nothing
getColumnMaxWidth MCmdline = Nothing
getColumnMaxWidth MUser = Nothing
getCellText MProcessId info = show $ psProcessId info
getCellText MCommand info = psCommand info
getCellText MState info = show $ psState info
getCellText MParentProcessId info = show $ psParentProcessId info
getCellText MProcessGroupId info = show $ psProcessGroupId info
getCellText MSessionId info = show $ psSessionId info
getCellText MPriority info = showPriority $ psNice info
getCellText MThreads info = show $ psNumThreads info
getCellText MCPUPercent info = show (psCpuPercent info) ++ "%"
getCellText MVirtualMemory info = (formatFileSizeForDisplay . fromIntegral) $ psVirtualMem info
getCellText MResidentMemory info = (formatFileSizeForDisplay . fromIntegral) $ psResidentMem info
getCellText MCmdline info = psCmdline info
getCellText MUser info = psUsername info
getCellXAlign MProcessId = 1.0
getCellXAlign MCommand = 0.0
getCellXAlign MState = 0.0
getCellXAlign MParentProcessId = 1.0
getCellXAlign MProcessGroupId = 1.0
getCellXAlign MSessionId = 1.0
getCellXAlign MPriority = 1.0
getCellXAlign MThreads = 1.0
getCellXAlign MCPUPercent = 1.0
getCellXAlign MVirtualMemory = 1.0
getCellXAlign MResidentMemory = 1.0
getCellXAlign MCmdline = 0.0
getCellXAlign MUser = 1.0
compareRow MProcessId row1 row2 = return $ comparing psProcessId row1 row2
compareRow MCommand row1 row2 = return $ comparing psCommand row1 row2
compareRow MState row1 row2 = return $ comparing psState row1 row2
compareRow MParentProcessId row1 row2 = return $ comparing psParentProcessId row1 row2
compareRow MProcessGroupId row1 row2 = return $ comparing psProcessGroupId row1 row2
compareRow MSessionId row1 row2 = return $ comparing psSessionId row1 row2
compareRow MPriority row1 row2 = return $ comparing psNice row1 row2
compareRow MThreads row1 row2 = return $ comparing psNumThreads row1 row2
compareRow MCPUPercent row1 row2 = return $ comparing psCpuPercent row1 row2
compareRow MVirtualMemory row1 row2 = return $ comparing psVirtualMem row1 row2
compareRow MResidentMemory row1 row2 = return $ comparing psResidentMem row1 row2
compareRow MCmdline row1 row2 = return $ comparing psCmdline row1 row2
compareRow MUser row1 row2 = return $ comparing psUsername row1 row2
processBufferNew :: FilePath -> Client -> PageId -> IO ProcessBuffer
processBufferNew path client pageId = do
infos <- procGetAllProcessStatus
ProcessBuffer <$> pure path
<*> pure client
<*> pure pageId
<*> pure processManagerMode
<*> newTVarIO infos
<*> pure (pairPred [MCommand
,MProcessId
,MUser
,MState
,MResidentMemory
,MCPUPercent
,MPriority
,MThreads
,MCmdline
])
<*> newTVarIO (MResidentMemory, SortDescending)
<*> newTChanIO
<*> pure 3000
<*> newTVarIO 0
processBufferUpdate :: ProcessBuffer -> IO ()
processBufferUpdate buffer = do
timeoutAddFull (do
counter <- readTVarIO $ processBufferViewCounter buffer
when (counter > 0) $ do
forkIO $ do
infos <- procGetAllProcessStatus
writeTVarIO (processBufferStatus buffer) infos
writeTChanIO (processBufferBroadcastChannel buffer) UpdateProcesses
counter <- readTVarIO $ processBufferViewCounter buffer
when (counter > 0) $ processBufferUpdate buffer
return ()
return False)
priorityHigh
(processBufferDelay buffer)
return ()
showPriority :: Int -> String
showPriority priority
| priority > 5 = "Low"
| priority > 5 = "Normal"
| otherwise = "High"