-----------------------------------------------------------------------------
-- |
-- 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
--
-----------------------------------------------------------------------------

{-# LANGUAGE CPP #-}

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

import Xmobar.Plugins.Monitors.Common
#if defined(freebsd_HOST_OS)
import qualified Xmobar.Plugins.Monitors.Disk.FreeBSD as MD
#else
import qualified Xmobar.Plugins.Monitors.Disk.Linux as MD
#endif

import Control.Monad (zipWithM)
import System.Console.GetOpt
import Data.List (find)

import Xmobar.Plugins.Monitors.Disk.Common (
  DevName
  , Path
  )

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 =
   [ [Char]
-> [[Char]]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> [Char]
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"total-icon-pattern"] (([Char] -> DiskIOOpts -> DiskIOOpts)
-> [Char] -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
x}) [Char]
"") [Char]
""
   , [Char]
-> [[Char]]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> [Char]
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"write-icon-pattern"] (([Char] -> DiskIOOpts -> DiskIOOpts)
-> [Char] -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
x}) [Char]
"") [Char]
""
   , [Char]
-> [[Char]]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> [Char]
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"read-icon-pattern"] (([Char] -> DiskIOOpts -> DiskIOOpts)
-> [Char] -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
x}) [Char]
"") [Char]
""
   , [Char]
-> [[Char]]
-> ArgDescr (DiskIOOpts -> DiskIOOpts)
-> [Char]
-> OptDescr (DiskIOOpts -> DiskIOOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"c" [[Char]
"contiguous"] ((DiskIOOpts -> DiskIOOpts) -> ArgDescr (DiskIOOpts -> DiskIOOpts)
forall a. a -> ArgDescr a
NoArg (\DiskIOOpts
o -> DiskIOOpts
o {contiguous :: Bool
contiguous = Bool
True})) [Char]
""
   ]

diskIOConfig :: IO MConfig
diskIOConfig :: IO MConfig
diskIOConfig = [Char] -> [[Char]] -> IO MConfig
mkMConfig [Char]
"" [[Char]
"total", [Char]
"read", [Char]
"write"
                            ,[Char]
"totalb", [Char]
"readb", [Char]
"writeb"
                            ,[Char]
"totalbar", [Char]
"readbar", [Char]
"writebar"
                            ,[Char]
"totalbbar", [Char]
"readbbar", [Char]
"writebbar"
                            ,[Char]
"totalvbar", [Char]
"readvbar", [Char]
"writevbar"
                            ,[Char]
"totalbvbar", [Char]
"readbvbar", [Char]
"writebvbar"
                            ,[Char]
"totalipat", [Char]
"readipat", [Char]
"writeipat"
                            ,[Char]
"totalbipat", [Char]
"readbipat", [Char]
"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 =
   [ [Char]
-> [[Char]]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> [Char]
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"free-icon-pattern"] (([Char] -> DiskUOpts -> DiskUOpts)
-> [Char] -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
x}) [Char]
"") [Char]
""
   , [Char]
-> [[Char]]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> [Char]
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"used-icon-pattern"] (([Char] -> DiskUOpts -> DiskUOpts)
-> [Char] -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
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
$ [Char] -> IconPattern
parseIconPattern [Char]
x}) [Char]
"") [Char]
""
   , [Char]
-> [[Char]]
-> ArgDescr (DiskUOpts -> DiskUOpts)
-> [Char]
-> OptDescr (DiskUOpts -> DiskUOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"c" [[Char]
"contiguous"] ((DiskUOpts -> DiskUOpts) -> ArgDescr (DiskUOpts -> DiskUOpts)
forall a. a -> ArgDescr a
NoArg (\DiskUOpts
o -> DiskUOpts
o {contiguousU :: Bool
contiguousU = Bool
True})) [Char]
""
   ]

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

speedToStr :: Float -> String
speedToStr :: Float -> [Char]
speedToStr = Int -> Int -> Float -> [Char]
showWithUnits Int
2 Int
1 (Float -> [Char]) -> (Float -> Float) -> Float -> [Char]
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 -> [Char]
sizeToStr = Int -> Int -> Float -> [Char]
showWithUnits Int
3 Int
0 (Float -> [Char]) -> (Integer -> Float) -> Integer -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral

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

runDiskIO :: MD.DevDataRef -> [(String, String)] -> [String] -> Monitor String
runDiskIO :: DevDataRef -> [([Char], [Char])] -> [[Char]] -> Monitor [Char]
runDiskIO DevDataRef
dref [([Char], [Char])]
disks [[Char]]
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 -> [[Char]] -> IO DiskIOOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (DiskIOOpts -> DiskIOOpts)]
dioOptions DiskIOOpts
dioDefaultOpts [[Char]]
argv
  [([Char], [Float])]
stats <- IO [([Char], [Float])] -> Monitor [([Char], [Float])]
forall a. IO a -> Monitor a
io (IO [([Char], [Float])] -> Monitor [([Char], [Float])])
-> IO [([Char], [Float])] -> Monitor [([Char], [Float])]
forall a b. (a -> b) -> a -> b
$ DevDataRef -> [([Char], [Char])] -> IO [([Char], [Float])]
MD.fetchDataIO DevDataRef
dref [([Char], [Char])]
disks
  [(([Char], [Char]), [Integer])]
mounted <- IO [(([Char], [Char]), [Integer])]
-> Monitor [(([Char], [Char]), [Integer])]
forall a. IO a -> Monitor a
io (IO [(([Char], [Char]), [Integer])]
 -> Monitor [(([Char], [Char]), [Integer])])
-> IO [(([Char], [Char]), [Integer])]
-> Monitor [(([Char], [Char]), [Integer])]
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> IO [(([Char], [Char]), [Integer])]
MD.fetchDataUsage [([Char], [Char])]
disks
  [[Char]]
strs <- (([Char], [Float]) -> Monitor [Char])
-> [([Char], [Float])] -> ReaderT MConfig IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DiskIOOpts -> ([Char], [Float]) -> Monitor [Char]
runDiskIO' DiskIOOpts
opts) ([([Char], [Float])] -> ReaderT MConfig IO [[Char]])
-> [([Char], [Float])] -> ReaderT MConfig IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])]
-> [([Char], [Char])] -> [([Char], [Float])] -> [([Char], [Float])]
devTemplates [([Char], [Char])]
disks (((([Char], [Char]), [Integer]) -> ([Char], [Char]))
-> [(([Char], [Char]), [Integer])] -> [([Char], [Char])]
forall a b. (a -> b) -> [a] -> [b]
map (([Char], [Char]), [Integer]) -> ([Char], [Char])
forall a b. (a, b) -> a
fst [(([Char], [Char]), [Integer])]
mounted) [([Char], [Float])]
stats
  [Char] -> Monitor [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Monitor [Char]) -> [Char] -> Monitor [Char]
forall a b. (a -> b) -> a -> b
$ (if DiskIOOpts -> Bool
contiguous DiskIOOpts
opts then [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat else [[Char]] -> [Char]
unwords) [[Char]]
strs

startDiskIO :: [(String, String)] ->
               [String] -> Int -> (String -> IO ()) -> IO ()
startDiskIO :: [([Char], [Char])] -> [[Char]] -> Int -> ([Char] -> IO ()) -> IO ()
startDiskIO [([Char], [Char])]
disks [[Char]]
args Int
rate [Char] -> IO ()
cb = do
  DevDataRef
dref <- [([Char], [Char])] -> IO DevDataRef
MD.initializeDevDataRef [([Char], [Char])]
disks
  [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> Int
-> ([Char] -> IO ())
-> IO ()
runM [[Char]]
args IO MConfig
diskIOConfig (DevDataRef -> [([Char], [Char])] -> [[Char]] -> Monitor [Char]
runDiskIO DevDataRef
dref [([Char], [Char])]
disks) Int
rate [Char] -> IO ()
cb

runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String
runDiskU' :: DiskUOpts -> [Char] -> [Integer] -> Monitor [Char]
runDiskU' DiskUOpts
opts [Char]
tmp [Integer]
stat = do
  [Char] -> Selector [Char] -> Monitor ()
forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
tmp Selector [Char]
template
  let [Integer
total, Integer
free, Integer
diff] = [Integer]
stat
      strs :: [[Char]]
strs = (Integer -> [Char]) -> [Integer] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> [Char]
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
  [[Char]]
s <- ([Char] -> Integer -> Monitor [Char])
-> [[Char]] -> [Integer] -> ReaderT MConfig IO [[Char]]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM [Char] -> Integer -> Monitor [Char]
forall a. (Num a, Ord a) => [Char] -> a -> Monitor [Char]
showWithColors' [[Char]]
strs [Integer
freep, Integer
100 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
freep]
  [[Char]]
sp <- [Float] -> ReaderT MConfig IO [[Char]]
showPercentsWithColors [Float
fr, Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr]
  [Char]
fb <- Float -> Float -> Monitor [Char]
showPercentBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
freep) Float
fr
  [Char]
fvb <- Float -> Float -> Monitor [Char]
showVerticalBar (Integer -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
freep) Float
fr
  [Char]
fipat <- Maybe IconPattern -> Float -> Monitor [Char]
showIconPattern (DiskUOpts -> Maybe IconPattern
freeIconPattern DiskUOpts
opts) Float
fr
  [Char]
ub <- Float -> Float -> Monitor [Char]
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)
  [Char]
uvb <- Float -> Float -> Monitor [Char]
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)
  [Char]
uipat <- Maybe IconPattern -> Float -> Monitor [Char]
showIconPattern (DiskUOpts -> Maybe IconPattern
usedIconPattern DiskUOpts
opts) (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
fr)
  [[Char]] -> Monitor [Char]
parseTemplate ([[Char]] -> Monitor [Char]) -> [[Char]] -> Monitor [Char]
forall a b. (a -> b) -> a -> b
$ [Integer -> [Char]
sizeToStr Integer
total] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
s [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
sp [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
fb,[Char]
fvb,[Char]
fipat,[Char]
ub,[Char]
uvb,[Char]
uipat]

runDiskU :: [(String, String)] -> [String] -> Monitor String
runDiskU :: [([Char], [Char])] -> [[Char]] -> Monitor [Char]
runDiskU [([Char], [Char])]
disks [[Char]]
argv = do
  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 -> [[Char]] -> IO DiskUOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (DiskUOpts -> DiskUOpts)]
duOptions DiskUOpts
duDefaultOpts [[Char]]
argv
  [(([Char], [Char]), [Integer])]
stats <- IO [(([Char], [Char]), [Integer])]
-> Monitor [(([Char], [Char]), [Integer])]
forall a. IO a -> Monitor a
io (IO [(([Char], [Char]), [Integer])]
 -> Monitor [(([Char], [Char]), [Integer])])
-> IO [(([Char], [Char]), [Integer])]
-> Monitor [(([Char], [Char]), [Integer])]
forall a b. (a -> b) -> a -> b
$ [([Char], [Char])] -> IO [(([Char], [Char]), [Integer])]
MD.fetchDataUsage [([Char], [Char])]
disks
  [[Char]]
strs <- ((([Char], [Char]), [Integer]) -> Monitor [Char])
-> [(([Char], [Char]), [Integer])] -> ReaderT MConfig IO [[Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(([Char]
d, [Char]
p), [Integer]
stat) -> DiskUOpts -> [Char] -> [Integer] -> Monitor [Char]
runDiskU' DiskUOpts
opts ([Char] -> [Char] -> [([Char], [Char])] -> [Char]
findTempl [Char]
d [Char]
p [([Char], [Char])]
disks) [Integer]
stat) [(([Char], [Char]), [Integer])]
stats
  [Char] -> Monitor [Char]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Monitor [Char]) -> [Char] -> Monitor [Char]
forall a b. (a -> b) -> a -> b
$ (if DiskUOpts -> Bool
contiguousU DiskUOpts
opts then [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat else [[Char]] -> [Char]
unwords) [[Char]]
strs

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

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