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

module Xmobar.Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where

import Xmobar.Plugins.Monitors.Common
import qualified Data.Map as M
import System.Console.GetOpt

data MemOpts = MemOpts
  { MemOpts -> Maybe IconPattern
usedIconPattern :: Maybe IconPattern
  , MemOpts -> Maybe IconPattern
freeIconPattern :: Maybe IconPattern
  , MemOpts -> Maybe IconPattern
availableIconPattern :: Maybe IconPattern
  }

defaultOpts :: MemOpts
defaultOpts :: MemOpts
defaultOpts = MemOpts :: Maybe IconPattern
-> Maybe IconPattern -> Maybe IconPattern -> MemOpts
MemOpts
  { usedIconPattern :: Maybe IconPattern
usedIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  , freeIconPattern :: Maybe IconPattern
freeIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  , availableIconPattern :: Maybe IconPattern
availableIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  }

options :: [OptDescr (MemOpts -> MemOpts)]
options :: [OptDescr (MemOpts -> MemOpts)]
options =
  [ [Char]
-> [[Char]]
-> ArgDescr (MemOpts -> MemOpts)
-> [Char]
-> OptDescr (MemOpts -> MemOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option "" ["used-icon-pattern"] (([Char] -> MemOpts -> MemOpts)
-> [Char] -> ArgDescr (MemOpts -> MemOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\x :: [Char]
x o :: MemOpts
o ->
     MemOpts
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]]
-> ArgDescr (MemOpts -> MemOpts)
-> [Char]
-> OptDescr (MemOpts -> MemOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option "" ["free-icon-pattern"] (([Char] -> MemOpts -> MemOpts)
-> [Char] -> ArgDescr (MemOpts -> MemOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\x :: [Char]
x o :: MemOpts
o ->
     MemOpts
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]]
-> ArgDescr (MemOpts -> MemOpts)
-> [Char]
-> OptDescr (MemOpts -> MemOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option "" ["available-icon-pattern"] (([Char] -> MemOpts -> MemOpts)
-> [Char] -> ArgDescr (MemOpts -> MemOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\x :: [Char]
x o :: MemOpts
o ->
     MemOpts
o { availableIconPattern :: Maybe IconPattern
availableIconPattern = 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 }) "") ""
  ]

memConfig :: IO MConfig
memConfig :: IO MConfig
memConfig = [Char] -> [[Char]] -> IO MConfig
mkMConfig
       "Mem: <usedratio>% (<cache>M)" -- template
       ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat",
        "availablebar", "availablevbar", "availableipat",
        "usedratio", "freeratio", "availableratio",
        "total", "free", "buffer", "cache", "available", "used"] -- available replacements

fileMEM :: IO String
fileMEM :: IO [Char]
fileMEM = [Char] -> IO [Char]
readFile "/proc/meminfo"

parseMEM :: IO [Float]
parseMEM :: IO [Float]
parseMEM =
    do [Char]
file <- IO [Char]
fileMEM
       let content :: [[[Char]]]
content = ([Char] -> [[Char]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [[Char]]
words ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
forall a b. (a -> b) -> a -> b
$ Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take 8 ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
file
           info :: Map [Char] Float
info = [([Char], Float)] -> Map [Char] Float
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([([Char], Float)] -> Map [Char] Float)
-> [([Char], Float)] -> Map [Char] Float
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> ([Char], Float)) -> [[[Char]]] -> [([Char], Float)]
forall a b. (a -> b) -> [a] -> [b]
map (\line :: [[Char]]
line -> ([[Char]] -> [Char]
forall a. [a] -> a
head [[Char]]
line, ([Char] -> Float
forall a. Read a => [Char] -> a
read ([Char] -> Float) -> [Char] -> Float
forall a b. (a -> b) -> a -> b
$ [[Char]]
line [[Char]] -> IconPattern
forall a. [a] -> Int -> a
!! 1 :: Float) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ 1024)) [[[Char]]]
content
           [total :: Float
total, free :: Float
free, buffer :: Float
buffer, cache :: Float
cache] = ([Char] -> Float) -> [[Char]] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Map [Char] Float
info Map [Char] Float -> [Char] -> Float
forall k a. Ord k => Map k a -> k -> a
M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"]
           available :: Float
available = Float -> [Char] -> Map [Char] Float -> Float
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault (Float
free Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
buffer Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
cache) "MemAvailable:" Map [Char] Float
info
           used :: Float
used = Float
total Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
available
           usedratio :: Float
usedratio = Float
used Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
total
           freeratio :: Float
freeratio = Float
free Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
total
           availableratio :: Float
availableratio = Float
available Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
total
       [Float] -> IO [Float]
forall (m :: * -> *) a. Monad m => a -> m a
return [Float
usedratio, Float
freeratio, Float
availableratio, Float
total, Float
free, Float
buffer, Float
cache, Float
available, Float
used]

totalMem :: IO Float
totalMem :: IO Float
totalMem = ([Float] -> Float) -> IO [Float] -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Float -> Float -> Float
forall a. Num a => a -> a -> a
*1024) (Float -> Float) -> ([Float] -> Float) -> [Float] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Float] -> Int -> Float
forall a. [a] -> Int -> a
!!1)) IO [Float]
parseMEM

usedMem :: IO Float
usedMem :: IO Float
usedMem = ([Float] -> Float) -> IO [Float] -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Float -> Float -> Float
forall a. Num a => a -> a -> a
*1024) (Float -> Float) -> ([Float] -> Float) -> [Float] -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Float] -> Int -> Float
forall a. [a] -> Int -> a
!!6)) IO [Float]
parseMEM

formatMem :: MemOpts -> [Float] -> Monitor [String]
formatMem :: MemOpts -> [Float] -> Monitor [[Char]]
formatMem opts :: MemOpts
opts (r :: Float
r:fr :: Float
fr:ar :: Float
ar:xs :: [Float]
xs) =
    do let f :: Float -> [Char]
f = Int -> Float -> [Char]
forall a. RealFloat a => Int -> a -> [Char]
showDigits 0
           mon :: Maybe IconPattern -> Float -> [Monitor [Char]]
mon i :: Maybe IconPattern
i x :: Float
x = [Float -> Float -> Monitor [Char]
showPercentBar (100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x) Float
x, Float -> Float -> Monitor [Char]
showVerticalBar (100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
x) Float
x, Maybe IconPattern -> Float -> Monitor [Char]
showIconPattern Maybe IconPattern
i Float
x]
       [Monitor [Char]] -> Monitor [[Char]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Monitor [Char]] -> Monitor [[Char]])
-> [Monitor [Char]] -> Monitor [[Char]]
forall a b. (a -> b) -> a -> b
$ Maybe IconPattern -> Float -> [Monitor [Char]]
mon (MemOpts -> Maybe IconPattern
usedIconPattern MemOpts
opts) Float
r
           [Monitor [Char]] -> [Monitor [Char]] -> [Monitor [Char]]
forall a. [a] -> [a] -> [a]
++ Maybe IconPattern -> Float -> [Monitor [Char]]
mon (MemOpts -> Maybe IconPattern
freeIconPattern MemOpts
opts) Float
fr
           [Monitor [Char]] -> [Monitor [Char]] -> [Monitor [Char]]
forall a. [a] -> [a] -> [a]
++ Maybe IconPattern -> Float -> [Monitor [Char]]
mon (MemOpts -> Maybe IconPattern
availableIconPattern MemOpts
opts) Float
ar
           [Monitor [Char]] -> [Monitor [Char]] -> [Monitor [Char]]
forall a. [a] -> [a] -> [a]
++ (Float -> Monitor [Char]) -> [Float] -> [Monitor [Char]]
forall a b. (a -> b) -> [a] -> [b]
map Float -> Monitor [Char]
showPercentWithColors [Float
r, Float
fr, Float
ar]
           [Monitor [Char]] -> [Monitor [Char]] -> [Monitor [Char]]
forall a. [a] -> [a] -> [a]
++ (Float -> Monitor [Char]) -> [Float] -> [Monitor [Char]]
forall a b. (a -> b) -> [a] -> [b]
map ((Float -> [Char]) -> Float -> Monitor [Char]
forall a. (Num a, Ord a) => (a -> [Char]) -> a -> Monitor [Char]
showWithColors Float -> [Char]
f) [Float]
xs
formatMem _ _ = Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate 10 ([Char] -> [[Char]]) -> Monitor [Char] -> Monitor [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Selector [Char] -> Monitor [Char]
forall a. Selector a -> Monitor a
getConfigValue Selector [Char]
naString

runMem :: [String] -> Monitor String
runMem :: [[Char]] -> Monitor [Char]
runMem argv :: [[Char]]
argv =
    do [Float]
m <- IO [Float] -> Monitor [Float]
forall a. IO a -> Monitor a
io IO [Float]
parseMEM
       MemOpts
opts <- IO MemOpts -> Monitor MemOpts
forall a. IO a -> Monitor a
io (IO MemOpts -> Monitor MemOpts) -> IO MemOpts -> Monitor MemOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (MemOpts -> MemOpts)]
-> MemOpts -> [[Char]] -> IO MemOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (MemOpts -> MemOpts)]
options MemOpts
defaultOpts [[Char]]
argv
       [[Char]]
l <- MemOpts -> [Float] -> Monitor [[Char]]
formatMem MemOpts
opts [Float]
m
       [[Char]] -> Monitor [Char]
parseTemplate [[Char]]
l