-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Disk.Linux
-- 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.Linux
  (
    fetchDataIO
  , fetchDataUsage
  , initializeDevDataRef
  , DevDataRef
  ) where

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

import Xmobar.System.StatFS (
  getFileSystemStats
  , fsStatByteCount
  , fsStatBytesAvailable
  , fsStatBytesUsed
  )
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, find)
import Data.Maybe (catMaybes)
import System.Directory (canonicalizePath, doesFileExist)
import Control.Exception (SomeException, handle)

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

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

fsStats :: String -> IO [Integer]
fsStats :: String -> IO [Integer]
fsStats String
path = do
  Maybe FileSystemStats
stats <- String -> IO (Maybe FileSystemStats)
getFileSystemStats String
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]

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

diskData :: IO [(DevName, [Float])]
diskData :: IO [(String, [Float])]
diskData = do
  ByteString
s <- String -> IO ByteString
B.readFile String
"/proc/diskstats"
  let extract :: [String] -> (String, [b])
extract [String]
ws = ([String] -> String
forall a. [a] -> a
head [String]
ws, (String -> b) -> [String] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map String -> b
forall a. Read a => String -> a
read ([String] -> [String]
forall a. [a] -> [a]
tail [String]
ws))
  [(String, [Float])] -> IO [(String, [Float])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, [Float])] -> IO [(String, [Float])])
-> [(String, [Float])] -> IO [(String, [Float])]
forall a b. (a -> b) -> a -> b
$ (ByteString -> (String, [Float]))
-> [ByteString] -> [(String, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> (String, [Float])
forall b. Read b => [String] -> (String, [b])
extract ([String] -> (String, [Float]))
-> (ByteString -> [String]) -> ByteString -> (String, [Float])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> String) -> [ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> String
B.unpack ([ByteString] -> [String])
-> (ByteString -> [ByteString]) -> ByteString -> [String]
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 -> [String] -> IO [(String, [Float])]
mountedData DevDataRef
dref [String]
devs = do
  [(String, [Float])]
dt <- DevDataRef -> IO [(String, [Float])]
forall a. IORef a -> IO a
readIORef DevDataRef
dref
  [(String, [Float])]
dt' <- IO [(String, [Float])]
diskData
  DevDataRef -> [(String, [Float])] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef DevDataRef
dref [(String, [Float])]
dt'
  [(String, [Float])] -> IO [(String, [Float])]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(String, [Float])] -> IO [(String, [Float])])
-> [(String, [Float])] -> IO [(String, [Float])]
forall a b. (a -> b) -> a -> b
$ (String -> (String, [Float])) -> [String] -> [(String, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map ([(String, [Float])] -> String -> (String, [Float])
parseDev (((String, [Float]) -> (String, [Float]) -> (String, [Float]))
-> [(String, [Float])]
-> [(String, [Float])]
-> [(String, [Float])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String, [Float]) -> (String, [Float]) -> (String, [Float])
forall c a a. Num c => (a, [c]) -> (a, [c]) -> (a, [c])
diff [(String, [Float])]
dt' [(String, [Float])]
dt)) [String]
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 :: [(String, [Float])] -> String -> (String, [Float])
parseDev [(String, [Float])]
dat String
dev =
  case ((String, [Float]) -> Bool)
-> [(String, [Float])] -> Maybe (String, [Float])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
dev) (String -> Bool)
-> ((String, [Float]) -> String) -> (String, [Float]) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [Float]) -> String
forall a b. (a, b) -> a
fst) [(String, [Float])]
dat of
    Maybe (String, [Float])
Nothing -> (String
dev, [Float
0, Float
0, Float
0])
    Just (String
_, [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 (String
dev, [Float]
dat')

fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])]
fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])]
fetchDataIO DevDataRef
dref [(String, String)]
disks = do
  [(String, String)]
dev <- [String] -> IO [(String, String)]
mountedOrDiskDevices (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
disks)
  DevDataRef -> [String] -> IO [(String, [Float])]
mountedData DevDataRef
dref (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
dev)

fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])]
fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])]
fetchDataUsage [(String, String)]
disks = do
  [(String, String)]
devs <- [String] -> IO [(String, String)]
mountedDevices (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
disks)
  ((String, String) -> IO ((String, String), [Integer]))
-> [(String, String)] -> IO [((String, String), [Integer])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, String) -> IO ((String, String), [Integer])
fetchStats [(String, String)]
devs
  where
    fetchStats :: (String, String) -> IO ((String, String), [Integer])
    fetchStats :: (String, String) -> IO ((String, String), [Integer])
fetchStats (String
dev, String
path) = do
      [Integer]
stats <- (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
$ String -> IO [Integer]
fsStats String
path
      ((String, String), [Integer]) -> IO ((String, String), [Integer])
forall (m :: * -> *) a. Monad m => a -> m a
return ((String
dev, String
path), [Integer]
stats)
    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]

initializeDevDataRef :: [(String, String)] -> IO DevDataRef
initializeDevDataRef :: [(String, String)] -> IO DevDataRef
initializeDevDataRef [(String, String)]
disks = do
  [(String, String)]
dev <- [String] -> IO [(String, String)]
mountedOrDiskDevices (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
disks)
  [(String, [Float])] -> IO DevDataRef
forall a. a -> IO (IORef a)
newIORef (((String, String) -> (String, [Float]))
-> [(String, String)] -> [(String, [Float])]
forall a b. (a -> b) -> [a] -> [b]
map (\(String, String)
d -> ((String, String) -> String
forall a b. (a, b) -> a
fst (String, String)
d, Float -> [Float]
forall a. a -> [a]
repeat Float
0)) [(String, String)]
dev)