diff options
author | John Soros <johnny@r0x0r.me> | 2012-10-11 15:01:10 +0200 |
---|---|---|
committer | John Soros <johnny@r0x0r.me> | 2012-10-11 15:01:10 +0200 |
commit | b683b474fa5b8cbb29704f88f7a43f8084dd8070 (patch) | |
tree | cd1f81dac311a5fbc3e568bad3e1831c16901096 /src | |
parent | ae61c95ee8e4ff85ee6c39f610b670401b6e8d53 (diff) | |
download | xmobar-b683b474fa5b8cbb29704f88f7a43f8084dd8070.tar.gz xmobar-b683b474fa5b8cbb29704f88f7a43f8084dd8070.tar.bz2 |
Second try at fixing #73 and #74: enable io monitoring for non-mounted disks
Diffstat (limited to 'src')
-rw-r--r-- | src/Plugins/Monitors/Disk.hs | 36 |
1 files changed, 16 insertions, 20 deletions
diff --git a/src/Plugins/Monitors/Disk.hs b/src/Plugins/Monitors/Disk.hs index d52dce2..3c8ea04 100644 --- a/src/Plugins/Monitors/Disk.hs +++ b/src/Plugins/Monitors/Disk.hs @@ -39,31 +39,27 @@ type DevDataRef = IORef [(DevName, [Float])] mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do - s <- B.readFile "/etc/mtab" - parse `fmap` mapM canon (devs s) + sm <- B.readFile "/etc/mtab" + sd <- B.readFile "/proc/diskstats" + parse `fmap` mapM canon (devs [sm, sd]) where canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} - devs = filter isDev . map (firstTwo . B.words) . B.lines + devs fs = concatMap devs' fs + where + devs' f = case (devsm f) of + [] -> devsd f + d -> d + firstTwo (a:b:_) = (B.unpack a, B.unpack b) + firstTwo _ = ("", "") + third (_:_:c:_) = ("/dev/"++(B.unpack c), B.unpack c) + third _ = ("", "") + devsm = filter isDev . map (firstTwo . B.words) . B.lines + devsd = filter isDev . map (third . B.words) . B.lines parse = map undev . filter isReq - firstTwo (a:b:_) = (B.unpack a, B.unpack b) - firstTwo _ = ("", "") isDev (d, _) = "/dev/" `isPrefixOf` d isReq (d, p) = p `elem` req || drop 5 d `elem` req undev (d, f) = (drop 5 d, f) -availDevices :: [String] -> IO [(DevName, Path)] -availDevices req = do - s <- B.readFile "/proc/diskstats" - parse `fmap` mapM canon (devs s) - where - canon (d, p) = do {d' <- canonicalizePath ("/dev/"++d); return (d', p)} - devs = map (third . B.words) . B.lines - parse = map undev . filter isReq - third (_:_:c:_) = (B.unpack c, B.unpack c) - third _ = ("", "") - isReq (d, p) = p `elem` req || drop 5 d `elem` req - undev (d, f) = (drop 5 d, f) - diskData :: IO [(DevName, [Float])] diskData = do @@ -123,7 +119,7 @@ runDiskIO' (tmp, xs) = do runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks _ = do - mounted <- io $ availDevices (map fst disks) + mounted <- io $ mountedDevices (map fst disks) dat <- io $ mountedData dref (map fst mounted) strs <- mapM runDiskIO' $ devTemplates disks mounted dat return $ unwords strs @@ -131,7 +127,7 @@ runDiskIO dref disks _ = do startDiskIO :: [(String, String)] -> [String] -> Int -> (String -> IO ()) -> IO () startDiskIO disks args rate cb = do - mounted <- availDevices (map fst disks) + 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 |