-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Disk
-- Copyright   :  (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
--  Disk usage and throughput monitors for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where

import Xmobar.Plugins.Monitors.Common
import Xmobar.System.StatFS

import Data.IORef (IORef, newIORef, readIORef, writeIORef)

import Control.Exception (SomeException, handle)
import Control.Monad (zipWithM)
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find)
import Data.Maybe (catMaybes)
import System.Directory (canonicalizePath, doesFileExist)
import System.Console.GetOpt

data DiskIOOpts = DiskIOOpts
  { DiskIOOpts -> Maybe IconPattern
totalIconPattern :: Maybe IconPattern
  , DiskIOOpts -> Maybe IconPattern
writeIconPattern :: Maybe IconPattern
  , DiskIOOpts -> Maybe IconPattern
readIconPattern :: Maybe IconPattern
  , DiskIOOpts -> Bool
contiguous :: Bool
  }

dioDefaultOpts :: DiskIOOpts
dioDefaultOpts :: DiskIOOpts
dioDefaultOpts = DiskIOOpts :: Maybe IconPattern
-> Maybe IconPattern -> Maybe IconPattern -> Bool -> DiskIOOpts
DiskIOOpts
   { totalIconPattern :: Maybe IconPattern
totalIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
   , writeIconPattern :: Maybe IconPattern
writeIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
   , readIconPattern :: Maybe IconPattern
readIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
   , contiguous :: Bool
contiguous = Bool
False
   }

dioOptions :: [OptDescr (DiskIOOpts -> DiskIOOpts)]
dioOptions :: [OptDescr (DiskIOOpts -> DiskIOOpts)]
dioOptions =
   [ DevName
-> [DevName]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> DevName
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"" [DevName
"total-icon-pattern"] ((DevName -> DiskIOOpts -> DiskIOOpts)
-> DevName -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. (DevName -> a) -> DevName -> ArgDescr a
ReqArg (\DevName
x DiskIOOpts
o ->
      DiskIOOpts
o { totalIconPattern :: Maybe IconPattern
totalIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ DevName -> IconPattern
parseIconPattern DevName
x}) DevName
"") DevName
""
   , DevName
-> [DevName]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> DevName
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"" [DevName
"write-icon-pattern"] ((DevName -> DiskIOOpts -> DiskIOOpts)
-> DevName -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. (DevName -> a) -> DevName -> ArgDescr a
ReqArg (\DevName
x DiskIOOpts
o ->
      DiskIOOpts
o { writeIconPattern :: Maybe IconPattern
writeIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ DevName -> IconPattern
parseIconPattern DevName
x}) DevName
"") DevName
""
   , DevName
-> [DevName]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> DevName
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"" [DevName
"read-icon-pattern"] ((DevName -> DiskIOOpts -> DiskIOOpts)
-> DevName -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. (DevName -> a) -> DevName -> ArgDescr a
ReqArg (\DevName
x DiskIOOpts
o ->
      DiskIOOpts
o { readIconPattern :: Maybe IconPattern
readIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ DevName -> IconPattern
parseIconPattern DevName
x}) DevName
"") DevName
""
   , DevName
-> [DevName]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> DevName
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"c" [DevName
"contiguous"] ((DiskIOOpts -> DiskIOOpts) -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. a -> ArgDescr a
NoArg (\DiskIOOpts
o -> DiskIOOpts
o {contiguous :: Bool
contiguous = Bool
True})) DevName
""
   ]

diskIOConfig :: IO MConfig
diskIOConfig :: IO MConfig
diskIOConfig = DevName -> [DevName] -> IO MConfig
mkMConfig DevName
"" [DevName
"total", DevName
"read", DevName
"write"
                            ,DevName
"totalb", DevName
"readb", DevName
"writeb"
                            ,DevName
"totalbar", DevName
"readbar", DevName
"writebar"
                            ,DevName
"totalbbar", DevName
"readbbar", DevName
"writebbar"
                            ,DevName
"totalvbar", DevName
"readvbar", DevName
"writevbar"
                            ,DevName
"totalbvbar", DevName
"readbvbar", DevName
"writebvbar"
                            ,DevName
"totalipat", DevName
"readipat", DevName
"writeipat"
                            ,DevName
"totalbipat", DevName
"readbipat", DevName
"writebipat"
                            ]

data DiskUOpts = DiskUOpts
  { DiskUOpts -> Maybe IconPattern
freeIconPattern :: Maybe IconPattern
  , DiskUOpts -> Maybe IconPattern
usedIconPattern :: Maybe IconPattern
  , DiskUOpts -> Bool
contiguousU :: Bool
  }

duDefaultOpts :: DiskUOpts
duDefaultOpts :: DiskUOpts
duDefaultOpts = DiskUOpts :: Maybe IconPattern -> Maybe IconPattern -> Bool -> DiskUOpts
DiskUOpts
   { freeIconPattern :: Maybe IconPattern
freeIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
   , usedIconPattern :: Maybe IconPattern
usedIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
   , contiguousU :: Bool
contiguousU = Bool
False
   }

duOptions :: [OptDescr (DiskUOpts -> DiskUOpts)]
duOptions :: [OptDescr (DiskUOpts -> DiskUOpts)]
duOptions =
   [ DevName
-> [DevName]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> DevName
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"" [DevName
"free-icon-pattern"] ((DevName -> DiskUOpts -> DiskUOpts)
-> DevName -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. (DevName -> a) -> DevName -> ArgDescr a
ReqArg (\DevName
x DiskUOpts
o ->
      DiskUOpts
o { freeIconPattern :: Maybe IconPattern
freeIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ DevName -> IconPattern
parseIconPattern DevName
x}) DevName
"") DevName
""
   , DevName
-> [DevName]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> DevName
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"" [DevName
"used-icon-pattern"] ((DevName -> DiskUOpts -> DiskUOpts)
-> DevName -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. (DevName -> a) -> DevName -> ArgDescr a
ReqArg (\DevName
x DiskUOpts
o ->
      DiskUOpts
o { usedIconPattern :: Maybe IconPattern
usedIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ DevName -> IconPattern
parseIconPattern DevName
x}) DevName
"") DevName
""
   , DevName
-> [DevName]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> DevName
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a.
DevName -> [DevName] -> ArgDescr a -> DevName -> OptDescr a
Option DevName
"c" [DevName
"contiguous"] ((DiskUOpts -> DiskUOpts) -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. a -> ArgDescr a
NoArg (\DiskUOpts
o -> DiskUOpts
o {contiguousU :: Bool
contiguousU = Bool
True})) DevName
""
   ]

diskUConfig :: IO MConfig
diskUConfig :: IO MConfig
diskUConfig = DevName -> [DevName] -> IO MConfig
mkMConfig DevName
""
              [ DevName
"size", DevName
"free", DevName
"used", DevName
"freep", DevName
"usedp"
              , DevName
"freebar", DevName
"freevbar", DevName
"freeipat"
              , DevName
"usedbar", DevName
"usedvbar", DevName
"usedipat"
              ]

type DevName = String
type Path = String
type DevDataRef = IORef [(DevName, [Float])]

mountedDevices :: [String] -> IO [(DevName, Path)]
mountedDevices :: [DevName] -> IO [(DevName, DevName)]
mountedDevices [DevName]
req = do
  ByteString
s <- DevName -> IO ByteString
B.readFile DevName
"/etc/mtab"
  [Maybe (DevName, DevName)] -> [(DevName, DevName)]
parse ([Maybe (DevName, DevName)] -> [(DevName, DevName)])
-> IO [Maybe (DevName, DevName)] -> IO [(DevName, DevName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((DevName, DevName) -> IO (Maybe (DevName, DevName)))
-> [(DevName, DevName)] -> IO [Maybe (DevName, DevName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DevName, DevName) -> IO (Maybe (DevName, DevName))
forall {b}. (DevName, b) -> IO (Maybe (DevName, b))
mbcanon (ByteString -> [(DevName, DevName)]
devs ByteString
s)
  where
    mbcanon :: (DevName, b) -> IO (Maybe (DevName, b))
mbcanon (DevName
d, b
p) = DevName -> IO Bool
doesFileExist DevName
d IO Bool
-> (Bool -> IO (Maybe (DevName, b))) -> IO (Maybe (DevName, b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
e ->
                     if Bool
e
                        then (DevName, b) -> Maybe (DevName, b)
forall a. a -> Maybe a
Just ((DevName, b) -> Maybe (DevName, b))
-> IO (DevName, b) -> IO (Maybe (DevName, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (DevName, b) -> IO (DevName, b)
forall {b}. (DevName, b) -> IO (DevName, b)
canon (DevName
d,b
p)
                        else Maybe (DevName, b) -> IO (Maybe (DevName, b))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DevName, b)
forall a. Maybe a
Nothing
    canon :: (DevName, b) -> IO (DevName, b)
canon (DevName
d, b
p) = do {DevName
d' <- DevName -> IO DevName
canonicalizePath DevName
d; (DevName, b) -> IO (DevName, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (DevName
d', b
p)}
    devs :: ByteString -> [(DevName, DevName)]
devs = ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
forall {b}. (DevName, b) -> Bool
isDev ([(DevName, DevName)] -> [(DevName, DevName)])
-> (ByteString -> [(DevName, DevName)])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> (DevName, DevName))
-> [ByteString] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> (DevName, DevName)
firstTwo ([ByteString] -> (DevName, DevName))
-> (ByteString -> [ByteString]) -> ByteString -> (DevName, DevName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) ([ByteString] -> [(DevName, DevName)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
    parse :: [Maybe (DevName, DevName)] -> [(DevName, DevName)]
parse = ((DevName, DevName) -> (DevName, DevName))
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> (DevName, DevName)
forall {a} {b}. ([a], b) -> ([a], b)
undev ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([Maybe (DevName, DevName)] -> [(DevName, DevName)])
-> [Maybe (DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
isReq ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([Maybe (DevName, DevName)] -> [(DevName, DevName)])
-> [Maybe (DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (DevName, DevName)] -> [(DevName, DevName)]
forall a. [Maybe a] -> [a]
catMaybes
    firstTwo :: [ByteString] -> (DevName, DevName)
firstTwo (ByteString
a:ByteString
b:[ByteString]
_) = (ByteString -> DevName
B.unpack ByteString
a, ByteString -> DevName
B.unpack ByteString
b)
    firstTwo [ByteString]
_ = (DevName
"", DevName
"")
    isDev :: (DevName, b) -> Bool
isDev (DevName
d, b
_) = DevName
"/dev/" DevName -> DevName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` DevName
d
    isReq :: (DevName, DevName) -> Bool
isReq (DevName
d, DevName
p) = DevName
p DevName -> [DevName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req Bool -> Bool -> Bool
|| Int -> DevName -> DevName
forall a. Int -> [a] -> [a]
drop Int
5 DevName
d DevName -> [DevName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req
    undev :: ([a], b) -> ([a], b)
undev ([a]
d, b
f) = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
5 [a]
d, b
f)

diskDevices :: [String] -> IO [(DevName, Path)]
diskDevices :: [DevName] -> IO [(DevName, DevName)]
diskDevices [DevName]
req = do
  ByteString
s <- DevName -> IO ByteString
B.readFile DevName
"/proc/diskstats"
  [(DevName, DevName)] -> [(DevName, DevName)]
parse ([(DevName, DevName)] -> [(DevName, DevName)])
-> IO [(DevName, DevName)] -> IO [(DevName, DevName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ((DevName, DevName) -> IO (DevName, DevName))
-> [(DevName, DevName)] -> IO [(DevName, DevName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DevName, DevName) -> IO (DevName, DevName)
forall {b}. (DevName, b) -> IO (DevName, b)
canon (ByteString -> [(DevName, DevName)]
devs ByteString
s)
  where
    canon :: (DevName, b) -> IO (DevName, b)
canon (DevName
d, b
p) = do {DevName
d' <- DevName -> IO DevName
canonicalizePath DevName
d; (DevName, b) -> IO (DevName, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (DevName
d', b
p)}
    devs :: ByteString -> [(DevName, DevName)]
devs = (ByteString -> (DevName, DevName))
-> [ByteString] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map ([ByteString] -> (DevName, DevName)
third ([ByteString] -> (DevName, DevName))
-> (ByteString -> [ByteString]) -> ByteString -> (DevName, DevName)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) ([ByteString] -> [(DevName, DevName)])
-> (ByteString -> [ByteString])
-> ByteString
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines
    parse :: [(DevName, DevName)] -> [(DevName, DevName)]
parse = ((DevName, DevName) -> (DevName, DevName))
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> (DevName, DevName)
forall {a} {b}. ([a], b) -> ([a], b)
undev ([(DevName, DevName)] -> [(DevName, DevName)])
-> ([(DevName, DevName)] -> [(DevName, DevName)])
-> [(DevName, DevName)]
-> [(DevName, DevName)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> [(DevName, DevName)]
forall a. (a -> Bool) -> [a] -> [a]
filter (DevName, DevName) -> Bool
isReq
    third :: [ByteString] -> (DevName, DevName)
third (ByteString
_:ByteString
_:ByteString
c:[ByteString]
_) = (DevName
"/dev/" DevName -> DevName -> DevName
forall a. [a] -> [a] -> [a]
++ ByteString -> DevName
B.unpack ByteString
c, ByteString -> DevName
B.unpack ByteString
c)
    third [ByteString]
_ = (DevName
"", DevName
"")
    isReq :: (DevName, DevName) -> Bool
isReq (DevName
d, DevName
p) = DevName
p DevName -> [DevName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req Bool -> Bool -> Bool
|| Int -> DevName -> DevName
forall a. Int -> [a] -> [a]
drop Int
5 DevName
d DevName -> [DevName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [DevName]
req
    undev :: ([a], b) -> ([a], b)
undev ([a]
d, b
f) = (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop Int
5 [a]
d, b
f)

mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]
mountedOrDiskDevices :: [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices [DevName]
req = do
  [(DevName, DevName)]
mnt <- [DevName] -> IO [(DevName, DevName)]
mountedDevices [DevName]
req
  case [(DevName, DevName)]
mnt of
       []    -> [DevName] -> IO [(DevName, DevName)]
diskDevices [DevName]
req
       [(DevName, DevName)]
other -> [(DevName, DevName)] -> IO [(DevName, DevName)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(DevName, DevName)]
other

diskData :: IO [(DevName, [Float])]
diskData :: IO [(DevName, [Float])]
diskData = do
  ByteString
s <- DevName -> IO ByteString
B.readFile DevName
"/proc/diskstats"
  let extract :: [DevName] -> (DevName, [b])
extract [DevName]
ws = ([DevName] -> DevName
forall a. [a] -> a
head [DevName]
ws, (DevName -> b) -> [DevName] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map DevName -> b
forall a. Read a => DevName -> a
read ([DevName] -> [DevName]
forall a. [a] -> [a]
tail [DevName]
ws))
  [(DevName, [Float])] -> IO [(DevName, [Float])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DevName, [Float])] -> IO [(DevName, [Float])])
-> [(DevName, [Float])] -> IO [(DevName, [Float])]
forall a b. (a -> b) -> a -> b
$ (ByteString -> (DevName, [Float]))
-> [ByteString] -> [(DevName, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map ([DevName] -> (DevName, [Float])
forall {b}. Read b => [DevName] -> (DevName, [b])
extract ([DevName] -> (DevName, [Float]))
-> (ByteString -> [DevName]) -> ByteString -> (DevName, [Float])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> DevName) -> [ByteString] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> DevName
B.unpack ([ByteString] -> [DevName])
-> (ByteString -> [ByteString]) -> ByteString -> [DevName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
2 ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words) (ByteString -> [ByteString]
B.lines ByteString
s)

mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData DevDataRef
dref [DevName]
devs = do
  [(DevName, [Float])]
dt <- DevDataRef -> IO [(DevName, [Float])]
forall a. IORef a -> IO a
readIORef DevDataRef
dref
  [(DevName, [Float])]
dt' <- IO [(DevName, [Float])]
diskData
  DevDataRef -> [(DevName, [Float])] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef DevDataRef
dref [(DevName, [Float])]
dt'
  [(DevName, [Float])] -> IO [(DevName, [Float])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(DevName, [Float])] -> IO [(DevName, [Float])])
-> [(DevName, [Float])] -> IO [(DevName, [Float])]
forall a b. (a -> b) -> a -> b
$ (DevName -> (DevName, [Float]))
-> [DevName] -> [(DevName, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map ([(DevName, [Float])] -> DevName -> (DevName, [Float])
parseDev (((DevName, [Float]) -> (DevName, [Float]) -> (DevName, [Float]))
-> [(DevName, [Float])]
-> [(DevName, [Float])]
-> [(DevName, [Float])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (DevName, [Float]) -> (DevName, [Float]) -> (DevName, [Float])
forall {c} {a} {a}. Num c => (a, [c]) -> (a, [c]) -> (a, [c])
diff [(DevName, [Float])]
dt' [(DevName, [Float])]
dt)) [DevName]
devs
  where diff :: (a, [c]) -> (a, [c]) -> (a, [c])
diff (a
dev, [c]
xs) (a
_, [c]
ys) = (a
dev, (c -> c -> c) -> [c] -> [c] -> [c]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [c]
xs [c]
ys)


parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])
parseDev [(DevName, [Float])]
dat DevName
dev =
  case ((DevName, [Float]) -> Bool)
-> [(DevName, [Float])] -> Maybe (DevName, [Float])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((DevName -> DevName -> Bool
forall a. Eq a => a -> a -> Bool
==DevName
dev) (DevName -> Bool)
-> ((DevName, [Float]) -> DevName) -> (DevName, [Float]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DevName, [Float]) -> DevName
forall a b. (a, b) -> a
fst) [(DevName, [Float])]
dat of
    Maybe (DevName, [Float])
Nothing -> (DevName
dev, [Float
0, Float
0, Float
0])
    Just (DevName
_, [Float]
xs) ->
      let r :: Float
r = Float
4096 Float -> Float -> Float
forall a. Num a => a -> a -> a
* [Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
2
          w :: Float
w = Float
4096 Float -> Float -> Float
forall a. Num a => a -> a -> a
* [Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
6
          t :: Float
t = Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w
          rSp :: Float
rSp = Float -> Float -> Float
forall {p}. (Eq p, Fractional p) => p -> p -> p
speed Float
r ([Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
3)
          wSp :: Float
wSp = Float -> Float -> Float
forall {p}. (Eq p, Fractional p) => p -> p -> p
speed Float
w ([Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
7)
          sp :: Float
sp =  Float -> Float -> Float
forall {p}. (Eq p, Fractional p) => p -> p -> p
speed Float
t ([Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ [Float]
xs [Float] -> Int -> Float
forall a. [a] -> Int -> a
!! Int
7)
          speed :: p -> p -> p
speed p
x p
d = if p
d p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0 then p
0 else p
x p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
d
          dat' :: [Float]
dat' = if [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6
                 then [Float
sp, Float
rSp, Float
wSp, Float
t, Float
r, Float
w]
                 else [Float
0, Float
0, Float
0, Float
0, Float
0, Float
0]
      in (DevName
dev, [Float]
dat')

speedToStr :: Float -> String
speedToStr :: Float -> DevName
speedToStr = Int -> Int -> Float -> DevName
showWithUnits Int
2 Int
1 (Float -> DevName) -> (Float -> Float) -> Float -> DevName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
1024)

sizeToStr :: Integer -> String
sizeToStr :: Integer -> DevName
sizeToStr = Int -> Int -> Float -> DevName
showWithUnits Int
3 Int
0 (Float -> DevName) -> (Integer -> Float) -> Integer -> DevName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

findTempl :: DevName -> Path -> [(String, String)] -> String
findTempl :: DevName -> DevName -> [(DevName, DevName)] -> DevName
findTempl DevName
dev DevName
path [(DevName, DevName)]
disks =
  case ((DevName, DevName) -> Bool)
-> [(DevName, DevName)] -> Maybe (DevName, DevName)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (DevName, DevName) -> Bool
forall {b}. (DevName, b) -> Bool
devOrPath [(DevName, DevName)]
disks of
    Just (DevName
_, DevName
t) -> DevName
t
    Maybe (DevName, DevName)
Nothing -> DevName
""
  where devOrPath :: (DevName, b) -> Bool
devOrPath (DevName
d, b
_) = DevName
d DevName -> DevName -> Bool
forall a. Eq a => a -> a -> Bool
== DevName
dev Bool -> Bool -> Bool
|| DevName
d DevName -> DevName -> Bool
forall a. Eq a => a -> a -> Bool
== DevName
path

devTemplates :: [(String, String)]
                -> [(DevName, Path)]
                -> [(DevName, [Float])]
                -> [(String, [Float])]
devTemplates :: [(DevName, DevName)]
-> [(DevName, DevName)]
-> [(DevName, [Float])]
-> [(DevName, [Float])]
devTemplates [(DevName, DevName)]
disks [(DevName, DevName)]
mounted [(DevName, [Float])]
dat =
  ((DevName, DevName) -> (DevName, [Float]))
-> [(DevName, DevName)] -> [(DevName, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map (\(DevName
d, DevName
p) -> (DevName -> DevName -> [(DevName, DevName)] -> DevName
findTempl DevName
d DevName
p [(DevName, DevName)]
disks, DevName -> [Float]
findData DevName
d)) [(DevName, DevName)]
mounted
  where findData :: DevName -> [Float]
findData DevName
dev = case ((DevName, [Float]) -> Bool)
-> [(DevName, [Float])] -> Maybe (DevName, [Float])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((DevName -> DevName -> Bool
forall a. Eq a => a -> a -> Bool
==DevName
dev) (DevName -> Bool)
-> ((DevName, [Float]) -> DevName) -> (DevName, [Float]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DevName, [Float]) -> DevName
forall a b. (a, b) -> a
fst) [(DevName, [Float])]
dat of
                         Maybe (DevName, [Float])
Nothing -> [Float
0, Float
0, Float
0]
                         Just (DevName
_, [Float]
xs) -> [Float]
xs

runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String
runDiskIO' :: DiskIOOpts -> (DevName, [Float]) -> Monitor DevName
runDiskIO' DiskIOOpts
opts (DevName
tmp, [Float]
xs) = do
  [DevName]
s <- (Float -> Monitor DevName)
-> [Float] -> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Float -> DevName) -> Float -> Monitor DevName
forall a. (Num a, Ord a) => (a -> DevName) -> a -> Monitor DevName
showWithColors Float -> DevName
speedToStr) [Float]
xs
  [DevName]
b <- (Float -> Monitor DevName)
-> [Float] -> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Float -> Float -> Monitor DevName
showLogBar Float
0.8) [Float]
xs
  [DevName]
vb <- (Float -> Monitor DevName)
-> [Float] -> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Float -> Float -> Monitor DevName
showLogVBar Float
0.8) [Float]
xs
  [DevName]
ipat <- ((DiskIOOpts -> Maybe IconPattern, Float) -> Monitor DevName)
-> [(DiskIOOpts -> Maybe IconPattern, Float)]
-> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(DiskIOOpts -> Maybe IconPattern
f,Float
v) -> Maybe IconPattern -> Float -> Float -> Monitor DevName
showLogIconPattern (DiskIOOpts -> Maybe IconPattern
f DiskIOOpts
opts) Float
0.8 Float
v)
        ([(DiskIOOpts -> Maybe IconPattern, Float)]
 -> ReaderT MConfig IO [DevName])
-> [(DiskIOOpts -> Maybe IconPattern, Float)]
-> ReaderT MConfig IO [DevName]
forall a b. (a -> b) -> a -> b
$ [DiskIOOpts -> Maybe IconPattern]
-> [Float] -> [(DiskIOOpts -> Maybe IconPattern, Float)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DiskIOOpts -> Maybe IconPattern
totalIconPattern, DiskIOOpts -> Maybe IconPattern
readIconPattern, DiskIOOpts -> Maybe IconPattern
writeIconPattern
              , DiskIOOpts -> Maybe IconPattern
totalIconPattern, DiskIOOpts -> Maybe IconPattern
readIconPattern, DiskIOOpts -> Maybe IconPattern
writeIconPattern]
              [Float]
xs
  DevName -> Selector DevName -> Monitor ()
forall a. a -> Selector a -> Monitor ()
setConfigValue DevName
tmp Selector DevName
template
  [DevName] -> Monitor DevName
parseTemplate ([DevName] -> Monitor DevName) -> [DevName] -> Monitor DevName
forall a b. (a -> b) -> a -> b
$ [DevName]
s [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName]
b [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName]
vb [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName]
ipat

runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
runDiskIO :: DevDataRef -> [(DevName, DevName)] -> [DevName] -> Monitor DevName
runDiskIO DevDataRef
dref [(DevName, DevName)]
disks [DevName]
argv = do
  DiskIOOpts
opts <- IO DiskIOOpts -> Monitor DiskIOOpts
forall a. IO a -> Monitor a
io (IO DiskIOOpts -> Monitor DiskIOOpts)
-> IO DiskIOOpts -> Monitor DiskIOOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (DiskIOOpts -> DiskIOOpts)]
-> DiskIOOpts -> [DevName] -> IO DiskIOOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [DevName] -> IO opts
parseOptsWith [OptDescr (DiskIOOpts -> DiskIOOpts)]
dioOptions DiskIOOpts
dioDefaultOpts [DevName]
argv
  [(DevName, DevName)]
dev <- IO [(DevName, DevName)] -> Monitor [(DevName, DevName)]
forall a. IO a -> Monitor a
io (IO [(DevName, DevName)] -> Monitor [(DevName, DevName)])
-> IO [(DevName, DevName)] -> Monitor [(DevName, DevName)]
forall a b. (a -> b) -> a -> b
$ [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
  [(DevName, [Float])]
dat <- IO [(DevName, [Float])] -> Monitor [(DevName, [Float])]
forall a. IO a -> Monitor a
io (IO [(DevName, [Float])] -> Monitor [(DevName, [Float])])
-> IO [(DevName, [Float])] -> Monitor [(DevName, [Float])]
forall a b. (a -> b) -> a -> b
$ DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData DevDataRef
dref (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
dev)
  [DevName]
strs <- ((DevName, [Float]) -> Monitor DevName)
-> [(DevName, [Float])] -> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DiskIOOpts -> (DevName, [Float]) -> Monitor DevName
runDiskIO' DiskIOOpts
opts) ([(DevName, [Float])] -> ReaderT MConfig IO [DevName])
-> [(DevName, [Float])] -> ReaderT MConfig IO [DevName]
forall a b. (a -> b) -> a -> b
$ [(DevName, DevName)]
-> [(DevName, DevName)]
-> [(DevName, [Float])]
-> [(DevName, [Float])]
devTemplates [(DevName, DevName)]
disks [(DevName, DevName)]
dev [(DevName, [Float])]
dat
  DevName -> Monitor DevName
forall (m :: * -> *) a. Monad m => a -> m a
return (DevName -> Monitor DevName) -> DevName -> Monitor DevName
forall a b. (a -> b) -> a -> b
$ (if DiskIOOpts -> Bool
contiguous DiskIOOpts
opts then [DevName] -> DevName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat else [DevName] -> DevName
unwords) [DevName]
strs

startDiskIO :: [(String, String)] ->
               [String] -> Int -> (String -> IO ()) -> IO ()
startDiskIO :: [(DevName, DevName)]
-> [DevName] -> Int -> (DevName -> IO ()) -> IO ()
startDiskIO [(DevName, DevName)]
disks [DevName]
args Int
rate DevName -> IO ()
cb = do
  [(DevName, DevName)]
dev <- [DevName] -> IO [(DevName, DevName)]
mountedOrDiskDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
  DevDataRef
dref <- [(DevName, [Float])] -> IO DevDataRef
forall a. a -> IO (IORef a)
newIORef (((DevName, DevName) -> (DevName, [Float]))
-> [(DevName, DevName)] -> [(DevName, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map (\(DevName, DevName)
d -> ((DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst (DevName, DevName)
d, Float -> [Float]
forall a. a -> [a]
repeat Float
0)) [(DevName, DevName)]
dev)
  [(DevName, [Float])]
_ <- DevDataRef -> [DevName] -> IO [(DevName, [Float])]
mountedData DevDataRef
dref (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
dev)
  [DevName]
-> IO MConfig
-> ([DevName] -> Monitor DevName)
-> Int
-> (DevName -> IO ())
-> IO ()
runM [DevName]
args IO MConfig
diskIOConfig (DevDataRef -> [(DevName, DevName)] -> [DevName] -> Monitor DevName
runDiskIO DevDataRef
dref [(DevName, DevName)]
disks) Int
rate DevName -> IO ()
cb

fsStats :: String -> IO [Integer]
fsStats :: DevName -> IO [Integer]
fsStats DevName
path = do
  Maybe FileSystemStats
stats <- DevName -> IO (Maybe FileSystemStats)
getFileSystemStats DevName
path
  case Maybe FileSystemStats
stats of
    Maybe FileSystemStats
Nothing -> [Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
0, Integer
0, Integer
0]
    Just FileSystemStats
f -> let tot :: Integer
tot = FileSystemStats -> Integer
fsStatByteCount FileSystemStats
f
                  free :: Integer
free = FileSystemStats -> Integer
fsStatBytesAvailable FileSystemStats
f
                  used :: Integer
used = FileSystemStats -> Integer
fsStatBytesUsed FileSystemStats
f
              in [Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
tot, Integer
free, Integer
used]

runDiskU' :: DiskUOpts -> String -> String -> Monitor String
runDiskU' :: DiskUOpts -> DevName -> DevName -> Monitor DevName
runDiskU' DiskUOpts
opts DevName
tmp DevName
path = do
  DevName -> Selector DevName -> Monitor ()
forall a. a -> Selector a -> Monitor ()
setConfigValue DevName
tmp Selector DevName
template
  [Integer
total, Integer
free, Integer
diff] <-  IO [Integer] -> Monitor [Integer]
forall a. IO a -> Monitor a
io ((SomeException -> IO [Integer]) -> IO [Integer] -> IO [Integer]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO [Integer]
ign (IO [Integer] -> IO [Integer]) -> IO [Integer] -> IO [Integer]
forall a b. (a -> b) -> a -> b
$ DevName -> IO [Integer]
fsStats DevName
path)
  let strs :: [DevName]
strs = (Integer -> DevName) -> [Integer] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> DevName
sizeToStr [Integer
free, Integer
diff]
      freep :: Integer
freep = if Integer
total Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0 then Integer
free Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
100 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
total else Integer
0
      fr :: Float
fr = Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
freep Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
100
  [DevName]
s <- (DevName -> Integer -> Monitor DevName)
-> [DevName] -> [Integer] -> ReaderT MConfig IO [DevName]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM DevName -> Integer -> Monitor DevName
forall a. (Num a, Ord a) => DevName -> a -> Monitor DevName
showWithColors' [DevName]
strs [Integer
freep, Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
freep]
  [DevName]
sp <- [Float] -> ReaderT MConfig IO [DevName]
showPercentsWithColors [Float
fr, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr]
  DevName
fb <- Float -> Float -> Monitor DevName
showPercentBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
freep) Float
fr
  DevName
fvb <- Float -> Float -> Monitor DevName
showVerticalBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
freep) Float
fr
  DevName
fipat <- Maybe IconPattern -> Float -> Monitor DevName
showIconPattern (DiskUOpts -> Maybe IconPattern
freeIconPattern DiskUOpts
opts) Float
fr
  DevName
ub <- Float -> Float -> Monitor DevName
showPercentBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
freep) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr)
  DevName
uvb <- Float -> Float -> Monitor DevName
showVerticalBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
freep) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr)
  DevName
uipat <- Maybe IconPattern -> Float -> Monitor DevName
showIconPattern (DiskUOpts -> Maybe IconPattern
usedIconPattern DiskUOpts
opts) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr)
  [DevName] -> Monitor DevName
parseTemplate ([DevName] -> Monitor DevName) -> [DevName] -> Monitor DevName
forall a b. (a -> b) -> a -> b
$ [Integer -> DevName
sizeToStr Integer
total] [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName]
s [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName]
sp [DevName] -> [DevName] -> [DevName]
forall a. [a] -> [a] -> [a]
++ [DevName
fb,DevName
fvb,DevName
fipat,DevName
ub,DevName
uvb,DevName
uipat]
  where ign :: SomeException -> IO [Integer]
ign = IO [Integer] -> SomeException -> IO [Integer]
forall a b. a -> b -> a
const ([Integer] -> IO [Integer]
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer
0, Integer
0, Integer
0]) :: SomeException -> IO [Integer]


runDiskU :: [(String, String)] -> [String] -> Monitor String
runDiskU :: [(DevName, DevName)] -> [DevName] -> Monitor DevName
runDiskU [(DevName, DevName)]
disks [DevName]
argv = do
  [(DevName, DevName)]
devs <- IO [(DevName, DevName)] -> Monitor [(DevName, DevName)]
forall a. IO a -> Monitor a
io (IO [(DevName, DevName)] -> Monitor [(DevName, DevName)])
-> IO [(DevName, DevName)] -> Monitor [(DevName, DevName)]
forall a b. (a -> b) -> a -> b
$ [DevName] -> IO [(DevName, DevName)]
mountedDevices (((DevName, DevName) -> DevName)
-> [(DevName, DevName)] -> [DevName]
forall a b. (a -> b) -> [a] -> [b]
map (DevName, DevName) -> DevName
forall a b. (a, b) -> a
fst [(DevName, DevName)]
disks)
  DiskUOpts
opts <- IO DiskUOpts -> Monitor DiskUOpts
forall a. IO a -> Monitor a
io (IO DiskUOpts -> Monitor DiskUOpts)
-> IO DiskUOpts -> Monitor DiskUOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (DiskUOpts -> DiskUOpts)]
-> DiskUOpts -> [DevName] -> IO DiskUOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [DevName] -> IO opts
parseOptsWith [OptDescr (DiskUOpts -> DiskUOpts)]
duOptions DiskUOpts
duDefaultOpts [DevName]
argv
  [DevName]
strs <- ((DevName, DevName) -> Monitor DevName)
-> [(DevName, DevName)] -> ReaderT MConfig IO [DevName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(DevName
d, DevName
p) -> DiskUOpts -> DevName -> DevName -> Monitor DevName
runDiskU' DiskUOpts
opts (DevName -> DevName -> [(DevName, DevName)] -> DevName
findTempl DevName
d DevName
p [(DevName, DevName)]
disks) DevName
p) [(DevName, DevName)]
devs
  DevName -> Monitor DevName
forall (m :: * -> *) a. Monad m => a -> m a
return (DevName -> Monitor DevName) -> DevName -> Monitor DevName
forall a b. (a -> b) -> a -> b
$ (if DiskUOpts -> Bool
contiguousU DiskUOpts
opts then [DevName] -> DevName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat else [DevName] -> DevName
unwords) [DevName]
strs