-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Swap
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A  swap usage monitor for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Swap where

import Xmobar.Plugins.Monitors.Common

import qualified Data.ByteString.Lazy.Char8 as B

swapConfig :: IO MConfig
swapConfig :: IO MConfig
swapConfig = String -> [String] -> IO MConfig
mkMConfig
        String
"Swap: <usedratio>%"                    -- template
        [String
"usedratio", String
"total", String
"used", String
"free"] -- available replacements

fileMEM :: IO B.ByteString
fileMEM :: IO ByteString
fileMEM = String -> IO ByteString
B.readFile String
"/proc/meminfo"

parseMEM :: IO [Float]
parseMEM :: IO [Float]
parseMEM =
    do ByteString
file <- IO ByteString
fileMEM
       let li :: Int -> [[ByteString]] -> ByteString
li Int
i [[ByteString]]
l
               | [[ByteString]]
l [[ByteString]] -> [[ByteString]] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = [[ByteString]] -> [ByteString]
forall a. [a] -> a
head [[ByteString]]
l [ByteString] -> Int -> ByteString
forall a. [a] -> Int -> a
!! Int
i
               | Bool
otherwise = ByteString
B.empty
           fs :: String -> [ByteString] -> Bool
fs String
s [ByteString]
l
               | [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
l    = Bool
False
               | Bool
otherwise = [ByteString] -> ByteString
forall a. [a] -> a
head [ByteString]
l ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
B.pack String
s
           get_data :: String -> [[ByteString]] -> c
get_data String
s = (c -> c -> c) -> c -> c -> c
forall a b c. (a -> b -> c) -> b -> a -> c
flip c -> c -> c
forall a. Fractional a => a -> a -> a
(/) c
1024 (c -> c) -> ([[ByteString]] -> c) -> [[ByteString]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> c
forall a. Read a => String -> a
read (String -> c) -> ([[ByteString]] -> String) -> [[ByteString]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> String)
-> ([[ByteString]] -> ByteString) -> [[ByteString]] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[ByteString]] -> ByteString
li Int
1 ([[ByteString]] -> ByteString)
-> ([[ByteString]] -> [[ByteString]])
-> [[ByteString]]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Bool) -> [[ByteString]] -> [[ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [ByteString] -> Bool
fs String
s)
           st :: [[ByteString]]
st   = (ByteString -> [ByteString]) -> [ByteString] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> [ByteString]
B.words ([ByteString] -> [[ByteString]])
-> (ByteString -> [ByteString]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines (ByteString -> [[ByteString]]) -> ByteString -> [[ByteString]]
forall a b. (a -> b) -> a -> b
$ ByteString
file
           tot :: Float
tot  = String -> [[ByteString]] -> Float
forall c. (Fractional c, Read c) => String -> [[ByteString]] -> c
get_data String
"SwapTotal:" [[ByteString]]
st
           free :: Float
free = String -> [[ByteString]] -> Float
forall c. (Fractional c, Read c) => String -> [[ByteString]] -> c
get_data String
"SwapFree:" [[ByteString]]
st
       [Float] -> IO [Float]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Float
tot Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
free) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
tot, Float
tot, Float
tot Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
free, Float
free]

formatSwap :: [Float] -> Monitor [String]
formatSwap :: [Float] -> Monitor [String]
formatSwap (Float
r:[Float]
xs) = do
  Int
d <- Selector Int -> Monitor Int
forall a. Selector a -> Monitor a
getConfigValue Selector Int
decDigits
  [String]
other <- (Float -> ReaderT MConfig IO String) -> [Float] -> Monitor [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Float -> String) -> Float -> ReaderT MConfig IO String
forall a.
(Num a, Ord a) =>
(a -> String) -> a -> ReaderT MConfig IO String
showWithColors (Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
d)) [Float]
xs
  String
ratio <- Float -> ReaderT MConfig IO String
showPercentWithColors Float
r
  [String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Monitor [String]) -> [String] -> Monitor [String]
forall a b. (a -> b) -> a -> b
$ String
ratioString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
other
formatSwap [Float]
_ = [String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Monitor [String]) -> [String] -> Monitor [String]
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String]
forall a. Int -> a -> [a]
replicate Int
4 String
"N/A"

runSwap :: [String] -> Monitor String
runSwap :: [String] -> ReaderT MConfig IO String
runSwap [String]
_ =
    do [Float]
m <- IO [Float] -> Monitor [Float]
forall a. IO a -> Monitor a
io IO [Float]
parseMEM
       [String]
l <- [Float] -> Monitor [String]
formatSwap [Float]
m
       [String] -> ReaderT MConfig IO String
parseTemplate [String]
l