-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Information.DiskIO
-- Copyright   : (c) José A. Romero L.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : José A. Romero L. <escherdragon@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Provides information about read/write operations in a given disk or
-- partition, obtained from parsing the @\/proc\/diskstats@ file with some
-- of the facilities included in the "System.Taffybar.Information.StreamInfo" module.
-----------------------------------------------------------------------------

module System.Taffybar.Information.DiskIO ( getDiskTransfer ) where

import Data.Maybe ( mapMaybe )
import Safe ( atMay, headMay, readDef )
import System.Taffybar.Information.StreamInfo ( getParsedInfo, getTransfer )

-- | Returns a two-element list containing the speed of transfer for read and
-- write operations performed in the given disk\/partition (e.g. \"sda\",
-- \"sda1\").
getDiskTransfer :: String -> IO [Double]
getDiskTransfer :: String -> IO [Double]
getDiskTransfer String
disk = Double -> IO [Int] -> IO [Double]
forall a b. (Integral a, RealFloat b) => b -> IO [a] -> IO [b]
getTransfer Double
0.05 (IO [Int] -> IO [Double]) -> IO [Int] -> IO [Double]
forall a b. (a -> b) -> a -> b
$ String -> IO [Int]
getDiskInfo String
disk

-- | Returns the list of all the values available in @\/proc\/diskstats@
-- for the given disk or partition.
getDiskInfo :: String -> IO [Int]
getDiskInfo :: String -> IO [Int]
getDiskInfo = String -> (String -> [(String, [Int])]) -> String -> IO [Int]
forall a. String -> (String -> [(String, [a])]) -> String -> IO [a]
getParsedInfo String
"/proc/diskstats" String -> [(String, [Int])]
parse

parse :: String -> [(String, [Int])]
parse :: String -> [(String, [Int])]
parse = (String -> Maybe (String, [Int])) -> [String] -> [(String, [Int])]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([String] -> Maybe (String, [Int])
tuplize ([String] -> Maybe (String, [Int]))
-> (String -> [String]) -> String -> Maybe (String, [Int])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
2 ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words) ([String] -> [(String, [Int])])
-> (String -> [String]) -> String -> [(String, [Int])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

tuplize :: [String] -> Maybe (String, [Int])
tuplize :: [String] -> Maybe (String, [Int])
tuplize [String]
s = do
  String
device <- [String] -> Maybe String
forall a. [a] -> Maybe a
headMay [String]
s
  String
used <- [String]
s [String] -> Int -> Maybe String
forall a. [a] -> Int -> Maybe a
`atMay` Int
3
  String
capacity <- [String]
s [String] -> Int -> Maybe String
forall a. [a] -> Int -> Maybe a
`atMay` Int
7
  (String, [Int]) -> Maybe (String, [Int])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
device, [Int -> String -> Int
forall a. Read a => a -> String -> a
readDef (-Int
1) String
used, Int -> String -> Int
forall a. Read a => a -> String -> a
readDef (-Int
1) String
capacity])