More accurate net monitor rates (issue 42)

3 files changed, 42 insertions, 25 deletions

diff --git a/NEWS b/NEWS
index 4ff68b4..39db886 100644
--- a/NEWS
+++ b/NEWS
@@ -25,6 +25,7 @@ _Bug fixes_
   - [issue 30]: `Mail` plugin can be specified anywhere in commands list.
   - [issue 36]: Battery monitor now supports non-standard locations of
     the `/sys/class/power_supply/AC/online` file.
+  - [issue 42]: More accurate net monitor rates.
   - Text is now correctly centered vertically.
   - `FullBM` border spec fixed.
 
@@ -34,6 +35,7 @@ _Bug fixes_
 [issue 30]: http://code.google.com/p/xmobar/issues/detail?id=30
 [issue 36]: http://code.google.com/p/xmobar/issues/detail?id=36
 [issue 38]: http://code.google.com/p/xmobar/issues/detail?id=38
+[issue 42]: http://code.google.com/p/xmobar/issues/detail?id=42
 
 ## Version 0.12 (Dec 24, 2010)
 
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