summaryrefslogtreecommitdiffhomepage
path: root/src/Plugins
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2012-01-31 02:32:53 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2012-01-31 02:32:53 +0100
commit7d32da7117f91c65bbc58c30648b60d767ebf8c3 (patch)
treed7bcf592906ffa7b52bdeb6732eb9dad9a2fef7f /src/Plugins
parent72d8fb3a4de6b15b6044254ae5e719fde09bdf9f (diff)
downloadxmobar-7d32da7117f91c65bbc58c30648b60d767ebf8c3.tar.gz
xmobar-7d32da7117f91c65bbc58c30648b60d767ebf8c3.tar.bz2
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).
Diffstat (limited to 'src/Plugins')
-rw-r--r--src/Plugins/Monitors/Disk.hs19
1 files changed, 11 insertions, 8 deletions
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