summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-13 05:31:52 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-13 05:31:52 +0100
commita8eae67582f67ddee277a8a03d2f2d02fc136011 (patch)
treed8859ef43430481ab55461332519b6d91f7f1f69
parent31715e3db637702d1289819909131a32abb3777a (diff)
downloadxmobar-a8eae67582f67ddee277a8a03d2f2d02fc136011.tar.gz
xmobar-a8eae67582f67ddee277a8a03d2f2d02fc136011.tar.bz2
Same medicine for DiskIO (no doActionTwiceWithDelay left)
-rw-r--r--NEWS2
-rw-r--r--src/Plugins/Monitors.hs2
-rw-r--r--src/Plugins/Monitors/Disk.hs31
3 files changed, 23 insertions, 12 deletions
diff --git a/NEWS b/NEWS
index 499731e..59accbd 100644
--- a/NEWS
+++ b/NEWS
@@ -28,7 +28,7 @@ _Bug fixes_
- [issue 40]: Battery monitor now supports the new power_now, that
replaces current_now in linux kernels for v. 2.36 and above.
- [issue 42]: More accurate net monitor rates.
- - Cpu and MultiCpu monitors are also more accurate now.
+ - DiskIO, Cpu and MultiCpu monitors are also more accurate now.
- Text is now correctly centered vertically.
- `FullBM` border spec fixed.
diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs
index 0007bec..4f1795b 100644
--- a/src/Plugins/Monitors.hs
+++ b/src/Plugins/Monitors.hs
@@ -118,7 +118,7 @@ instance Exec Monitors where
start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r
start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r
start (DiskU s a r) = runM a diskUConfig (runDiskU s) r
- start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r
+ start (DiskIO s a r) = startDiskIO s a r
start (Uptime a r) = runM a uptimeConfig runUptime r
#ifdef IWLIB
start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r
diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs
index f3a7a2a..33b3f5d 100644
--- a/src/Plugins/Monitors/Disk.hs
+++ b/src/Plugins/Monitors/Disk.hs
@@ -1,7 +1,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Disk
--- Copyright : (c) Jose A Ortega Ruiz
+-- Copyright : (c) 2010, 2011 Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
@@ -12,13 +12,13 @@
--
-----------------------------------------------------------------------------
-module Plugins.Monitors.Disk ( diskUConfig, runDiskU
- , diskIOConfig, runDiskIO
- ) where
+module Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where
import Plugins.Monitors.Common
import StatFS
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+
import Control.Monad (zipWithM)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find, intercalate)
@@ -33,6 +33,7 @@ diskUConfig = mkMConfig ""
type DevName = String
type Path = String
+type DevDataRef = IORef [(DevName, [Float])]
mountedDevices :: [String] -> IO [(DevName, Path)]
mountedDevices req = do
@@ -52,9 +53,11 @@ diskData = do
let extract ws = (head ws, map read (tail ws))
return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)
-mountedData :: [DevName] -> IO [(DevName, [Float])]
-mountedData devs = do
- (dt, dt') <- doActionTwiceWithDelay 750000 diskData
+mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
+mountedData dref devs = do
+ dt <- readIORef dref
+ dt' <- diskData
+ writeIORef dref dt'
return $ map (parseDev (zipWith diff dt' dt)) devs
where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)
@@ -110,13 +113,21 @@ runDiskIO' (tmp, xs) = do
setConfigValue tmp template
parseTemplate $ s ++ b
-runDiskIO :: [(String, String)] -> [String] -> Monitor String
-runDiskIO disks _ = do
+runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
+runDiskIO dref disks _ = do
mounted <- io $ mountedDevices (map fst disks)
- dat <- io $ mountedData (map fst mounted)
+ dat <- io $ mountedData dref (map fst mounted)
strs <- mapM runDiskIO' $ devTemplates disks mounted dat
return $ intercalate " " strs
+startDiskIO :: [(String, String)] ->
+ [String] -> Int -> (String -> IO ()) -> IO ()
+startDiskIO disks args rate cb = do
+ mounted <- mountedDevices (map fst disks)
+ dref <- newIORef (map (\d -> (fst d, repeat 0)) mounted)
+ _ <- mountedData dref (map fst mounted)
+ runM args diskIOConfig (runDiskIO dref disks) rate cb
+
runDiskU' :: String -> String -> Monitor String
runDiskU' tmp path = do
setConfigValue tmp template