DiskIO working with /dev entries which are symlinks

We were getting confused by devices appearing in mtab by their
symbolic path (such as an entry in /dev/disk/by-uuid and the like).

2 files changed, 13 insertions, 8 deletions

diff --git a/NEWS b/NEWS
index 0e15b82..c68b90e 100644
--- a/NEWS
+++ b/NEWS
@@ -20,6 +20,8 @@ _Bug fixes_
   - [issue 56]: vertical alignment of text improved.
   - [issue 64]: display of `watts` in `Batt` monitor fixed.
   - [issue 67]: compilation in DragonFly.
+  - DiskIO works also when device path in mtab are symbolic links
+    to the real device file.
 
 [issue 56]: http://code.google.com/p/xmobar/issues/detail?id=56
 [issue 58]: http://code.google.com/p/xmobar/issues/detail?id=58
diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs
index 33b3f5d..461663d 100644
--- a/src/Plugins/Monitors/Disk.hs
+++ b/src/Plugins/Monitors/Disk.hs
@@ -1,7 +1,7 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Plugins.Monitors.Disk
--- Copyright   :  (c) 2010, 2011 Jose A Ortega Ruiz
+-- Copyright   :  (c) 2010, 2011, 2012 Jose A Ortega Ruiz
 -- License     :  BSD-style (see LICENSE)
 --
 -- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
@@ -21,7 +21,8 @@ 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)
+import Data.List (isPrefixOf, find)
+import System.Directory (canonicalizePath)
 
 diskIOConfig :: IO MConfig
 diskIOConfig = mkMConfig "" ["total", "read", "write",
@@ -38,13 +39,15 @@ type DevDataRef = IORef [(DevName, [Float])]
 mountedDevices :: [String] -> IO [(DevName, Path)]
 mountedDevices req = do
   s <- B.readFile "/etc/mtab"
-  return (parse s)
+  parse `fmap` mapM canon (devs s)
   where
-    parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines
+    canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
+    devs =  filter isDev . map (firstTwo . B.words) . B.lines
+    parse = map undev . filter isReq
     firstTwo (a:b:_) = (B.unpack a, B.unpack b)
     firstTwo _ = ("", "")
-    isDev (d, p) = "/dev/" `isPrefixOf` d &&
-                   (p `elem` req || drop 5 d `elem` req)
+    isDev (d, _) = "/dev/" `isPrefixOf` d
+    isReq (d, p) = p `elem` req || drop 5 d `elem` req
     undev (d, f) = (drop 5 d, f)
 
 diskData :: IO [(DevName, [Float])]
@@ -118,7 +121,7 @@ runDiskIO dref disks _ = do
   mounted <- io $ mountedDevices (map fst disks)
   dat <- io $ mountedData dref (map fst mounted)
   strs <- mapM runDiskIO' $ devTemplates disks mounted dat
-  return $ intercalate " " strs
+  return $ unwords strs
 
 startDiskIO :: [(String, String)] ->
                [String] -> Int -> (String -> IO ()) -> IO ()
@@ -145,4 +148,4 @@ runDiskU :: [(String, String)] -> [String] -> Monitor String
 runDiskU disks _ = do
   devs <- io $ mountedDevices (map fst disks)
   strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs
-  return $ intercalate " " strs
+  return $ unwords strs