summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-13 03:09:43 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2011-02-13 03:09:43 +0100
commit2821ab1ad61d5fd4c8d15cab50c69503419cb892 (patch)
tree28749c7f158c674e6b165cb7904fbb9d521568d9 /src/Plugins
parent39bfcaa6ae265d59736d35f61f515b8cdd85fd3d (diff)
downloadxmobar-2821ab1ad61d5fd4c8d15cab50c69503419cb892.tar.gz
xmobar-2821ab1ad61d5fd4c8d15cab50c69503419cb892.tar.bz2
More accurate net monitor rates (issue 42)
Diffstat (limited to 'src/Plugins')
-rw-r--r--src/Plugins/Monitors.hs2
-rw-r--r--src/Plugins/Monitors/Net.hs63
2 files changed, 40 insertions, 25 deletions
diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs
index 14d97a2..616ae21 100644
--- a/src/Plugins/Monitors.hs
+++ b/src/Plugins/Monitors.hs
@@ -105,7 +105,7 @@ instance Exec Monitors where
alias (Volume m c _ _) = m ++ ":" ++ c
#endif
start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r
- start (Network i a r) = runM (a ++ [i]) netConfig runNet r
+ start (Network i a r) = startNet i a r
start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r
start (Memory a r) = runM a memConfig runMem r
start (Swap a r) = runM a swapConfig runSwap r
diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs
index d9cd534..500a753 100644
--- a/src/Plugins/Monitors/Net.hs
+++ b/src/Plugins/Monitors/Net.hs
@@ -12,9 +12,13 @@
--
-----------------------------------------------------------------------------
-module Plugins.Monitors.Net (netConfig, runNet) where
+module Plugins.Monitors.Net (netConfig, startNet) where
import Plugins.Monitors.Common
+
+import Data.IORef (IORef, newIORef, readIORef, writeIORef)
+import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
+
import qualified Data.ByteString.Lazy.Char8 as B
data NetDev = NA
@@ -23,8 +27,7 @@ data NetDev = NA
, netTx :: Float
} deriving (Eq,Show,Read)
-interval :: Int
-interval = 500000
+type NetDevRef = IORef (NetDev, UTCTime)
netConfig :: IO MConfig
netConfig = mkMConfig
@@ -49,14 +52,19 @@ wordsBy f s = case dropWhile f s of
readNetDev :: [String] -> NetDev
readNetDev [] = NA
readNetDev xs =
- ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2))
+ ND (head xs) (r (xs !! 1)) (r (xs !! 2))
where r s | s == "" = 0
| otherwise = read s / 1024
-fileNET :: IO [NetDev]
-fileNET =
- do f <- B.readFile "/proc/net/dev"
- return $ netParser f
+fileNet :: IO [NetDev]
+fileNet = netParser `fmap` B.readFile "/proc/net/dev"
+
+findNetDev :: String -> IO NetDev
+findNetDev dev = do
+ nds <- fileNet
+ case filter (\d -> netDev d == dev) nds of
+ x:_ -> return x
+ _ -> return NA
netParser :: B.ByteString -> [NetDev]
netParser =
@@ -78,19 +86,26 @@ printNet nd =
parseTemplate [d,rx,tx,rb,tb]
NA -> return "N/A"
-parseNET :: String -> IO [NetDev]
-parseNET nd =
- do (a,b) <- doActionTwiceWithDelay interval fileNET
- let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval)
- diffRate (da,db) = ND (netDev da)
- (netRate netRx da db)
- (netRate netTx da db)
- return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b
-
-runNet :: [String] -> Monitor String
-runNet nd =
- do pn <- io $ parseNET $ head nd
- n <- case pn of
- [x] -> return x
- _ -> return NA
- printNet n
+parseNet :: NetDevRef -> String -> IO NetDev
+parseNet nref nd = do
+ (n0, t0) <- readIORef nref
+ n1 <- findNetDev nd
+ t1 <- getCurrentTime
+ writeIORef nref (n1, t1)
+ let scx = realToFrac (diffUTCTime t1 t0)
+ scx' = if scx > 0 then scx else 1
+ netRate f da db = takeDigits 2 $ (f db - f da) / scx'
+ diffRate NA _ = NA
+ diffRate _ NA = NA
+ diffRate da db = ND nd (netRate netRx da db) (netRate netTx da db)
+ return $ diffRate n0 n1
+
+runNet :: NetDevRef -> String -> [String] -> Monitor String
+runNet nref i _ = io (parseNet nref i) >>= printNet
+
+startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
+startNet i a r cb = do
+ t0 <- getCurrentTime
+ nref <- newIORef (NA, t0)
+ _ <- parseNet nref i
+ runM a netConfig (runNet nref i) r cb