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

module Xmobar.Plugins.Monitors.MultiCpu (startMultiCpu) where

import Xmobar.Plugins.Monitors.Common
import qualified Data.ByteString.Lazy.Char8 as B
import Data.List (isPrefixOf, transpose, unfoldr)
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import System.Console.GetOpt

data MultiCpuOpts = MultiCpuOpts
  { MultiCpuOpts -> [IconPattern]
loadIconPatterns :: [IconPattern]
  , MultiCpuOpts -> Maybe IconPattern
loadIconPattern :: Maybe IconPattern
  , MultiCpuOpts -> Maybe IconPattern
fallbackIconPattern :: Maybe IconPattern
  , MultiCpuOpts -> Bool
contiguous :: Bool
  }

defaultOpts :: MultiCpuOpts
defaultOpts :: MultiCpuOpts
defaultOpts = MultiCpuOpts :: [IconPattern]
-> Maybe IconPattern -> Maybe IconPattern -> Bool -> MultiCpuOpts
MultiCpuOpts
  { loadIconPatterns :: [IconPattern]
loadIconPatterns = []
  , loadIconPattern :: Maybe IconPattern
loadIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  , fallbackIconPattern :: Maybe IconPattern
fallbackIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
  , contiguous :: Bool
contiguous = Bool
False
  }

options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
options =
  [ [Char]
-> [[Char]]
-> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
-> [Char]
-> OptDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"load-icon-pattern"] (([Char] -> MultiCpuOpts -> MultiCpuOpts)
-> [Char] -> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x MultiCpuOpts
o ->
     MultiCpuOpts
o { loadIconPattern :: Maybe IconPattern
loadIconPattern = 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 (MultiCpuOpts -> MultiCpuOpts)
-> [Char]
-> OptDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"load-icon-patterns"] (([Char] -> MultiCpuOpts -> MultiCpuOpts)
-> [Char] -> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x MultiCpuOpts
o ->
     MultiCpuOpts
o { loadIconPatterns :: [IconPattern]
loadIconPatterns = [Char] -> IconPattern
parseIconPattern [Char]
x IconPattern -> [IconPattern] -> [IconPattern]
forall a. a -> [a] -> [a]
: MultiCpuOpts -> [IconPattern]
loadIconPatterns MultiCpuOpts
o }) [Char]
"") [Char]
""
  , [Char]
-> [[Char]]
-> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
-> [Char]
-> OptDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"fallback-icon-pattern"] (([Char] -> MultiCpuOpts -> MultiCpuOpts)
-> [Char] -> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg (\[Char]
x MultiCpuOpts
o ->
     MultiCpuOpts
o { fallbackIconPattern :: Maybe IconPattern
fallbackIconPattern = 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 (MultiCpuOpts -> MultiCpuOpts)
-> [Char]
-> OptDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"" [[Char]
"contiguous-icons"] ((MultiCpuOpts -> MultiCpuOpts)
-> ArgDescr (MultiCpuOpts -> MultiCpuOpts)
forall a. a -> ArgDescr a
NoArg (\MultiCpuOpts
o -> MultiCpuOpts
o {contiguous :: Bool
contiguous = Bool
True})) [Char]
""
  ]

variables :: [String]
variables :: [[Char]]
variables = [[Char]
"bar", [Char]
"vbar",[Char]
"ipat",[Char]
"total",[Char]
"user",[Char]
"nice",[Char]
"system",[Char]
"idle"]
vNum :: Int
vNum :: Int
vNum = [[Char]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
variables

multiCpuConfig :: IO MConfig
multiCpuConfig :: IO MConfig
multiCpuConfig =
  [Char] -> [[Char]] -> IO MConfig
mkMConfig [Char]
"Cpu: <total>%" ([[Char]] -> IO MConfig) -> [[Char]] -> IO MConfig
forall a b. (a -> b) -> a -> b
$
            [[Char]
"auto" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
k | [Char]
k <- [[Char]]
variables] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++
            [ [Char]
k [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
n     | [Char]
n <- [Char]
"" [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: IconPattern -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map IconPattern
forall a. Show a => a -> [Char]
show [Int
0 :: Int ..]
                         , [Char]
k <- [[Char]]
variables]

type CpuDataRef = IORef [[Int]]

cpuData :: IO [[Int]]
cpuData :: IO [[Int]]
cpuData = ByteString -> [[Int]]
parse (ByteString -> [[Int]]) -> IO ByteString -> IO [[Int]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO ByteString
B.readFile [Char]
"/proc/stat"
  where parse :: ByteString -> [[Int]]
parse = ([ByteString] -> [Int]) -> [[ByteString]] -> [[Int]]
forall a b. (a -> b) -> [a] -> [b]
map [ByteString] -> [Int]
parseList ([[ByteString]] -> [[Int]])
-> (ByteString -> [[ByteString]]) -> ByteString -> [[Int]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [[ByteString]]
cpuLists
        cpuLists :: ByteString -> [[ByteString]]
cpuLists = ([ByteString] -> Bool) -> [[ByteString]] -> [[ByteString]]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile [ByteString] -> Bool
isCpu ([[ByteString]] -> [[ByteString]])
-> (ByteString -> [[ByteString]]) -> ByteString -> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
        isCpu :: [ByteString] -> Bool
isCpu (ByteString
w:[ByteString]
_) = [Char]
"cpu" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ByteString -> [Char]
B.unpack ByteString
w
        isCpu [ByteString]
_ = Bool
False
        parseList :: [ByteString] -> [Int]
parseList = (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Int
parseInt ([Char] -> Int) -> (ByteString -> [Char]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
B.unpack) ([ByteString] -> [Int])
-> ([ByteString] -> [ByteString]) -> [ByteString] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail

parseCpuData :: CpuDataRef -> IO [[Float]]
parseCpuData :: CpuDataRef -> IO [[Float]]
parseCpuData CpuDataRef
cref =
  do [[Int]]
as <- CpuDataRef -> IO [[Int]]
forall a. IORef a -> IO a
readIORef CpuDataRef
cref
     [[Int]]
bs <- IO [[Int]]
cpuData
     CpuDataRef -> [[Int]] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef CpuDataRef
cref [[Int]]
bs
     let p0 :: [[Float]]
p0 = ([Int] -> [Int] -> [Float]) -> [[Int]] -> [[Int]] -> [[Float]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Int] -> [Int] -> [Float]
percent [[Int]]
bs [[Int]]
as
     [[Float]] -> IO [[Float]]
forall (m :: * -> *) a. Monad m => a -> m a
return [[Float]]
p0

percent :: [Int] -> [Int] -> [Float]
percent :: [Int] -> [Int] -> [Float]
percent [Int]
b [Int]
a = if Float
tot Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then (Float -> Float) -> [Float] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map (Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
tot) ([Float] -> [Float]) -> [Float] -> [Float]
forall a b. (a -> b) -> a -> b
$ Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
4 [Float]
dif else [Float
0, Float
0, Float
0, Float
0]
  where dif :: [Float]
dif = (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Float]) -> [Int] -> [Float]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
b [Int]
a
        tot :: Float
tot = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float]
dif

formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String]
formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [[Char]]
formatMultiCpus MultiCpuOpts
_ [] = [[Char]] -> Monitor [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
formatMultiCpus MultiCpuOpts
opts [[Float]]
xs =
  [[[Char]]] -> [[Char]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[[Char]]] -> [[Char]])
-> ReaderT MConfig IO [[[Char]]] -> Monitor [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Int, [Float]) -> Monitor [[Char]])
-> [(Int, [Float])] -> ReaderT MConfig IO [[[Char]]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Int
i, [Float]
x) -> MultiCpuOpts -> Int -> [Float] -> Monitor [[Char]]
formatCpu MultiCpuOpts
opts Int
i [Float]
x) ([Int] -> [[Float]] -> [(Int, [Float])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [[Float]]
xs)

formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String]
formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [[Char]]
formatCpu MultiCpuOpts
opts Int
i [Float]
xs
  | [Float] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Float]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 = [Float] -> Monitor [[Char]]
showPercentsWithColors ([Float] -> Monitor [[Char]]) -> [Float] -> Monitor [[Char]]
forall a b. (a -> b) -> a -> b
$ Int -> Float -> [Float]
forall a. Int -> a -> [a]
replicate Int
vNum Float
0.0
  | Bool
otherwise = let t :: Float
t = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Float] -> Float) -> [Float] -> Float
forall a b. (a -> b) -> a -> b
$ Int -> [Float] -> [Float]
forall a. Int -> [a] -> [a]
take Int
3 [Float]
xs
                in do [Char]
b <- Float -> Float -> Monitor [Char]
showPercentBar (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t) Float
t
                      [Char]
h <- Float -> Float -> Monitor [Char]
showVerticalBar (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t) Float
t
                      [Char]
d <- Maybe IconPattern -> Float -> Monitor [Char]
showIconPattern Maybe IconPattern
tryString Float
t
                      [[Char]]
ps <- [Float] -> Monitor [[Char]]
showPercentsWithColors (Float
tFloat -> [Float] -> [Float]
forall a. a -> [a] -> [a]
:[Float]
xs)
                      [[Char]] -> Monitor [[Char]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
b[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
h[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[Char]
d[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:[[Char]]
ps)
  where tryString :: Maybe IconPattern
tryString
          | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = MultiCpuOpts -> Maybe IconPattern
loadIconPattern MultiCpuOpts
opts
          | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [IconPattern] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (MultiCpuOpts -> [IconPattern]
loadIconPatterns MultiCpuOpts
opts) =
              IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ MultiCpuOpts -> [IconPattern]
loadIconPatterns MultiCpuOpts
opts [IconPattern] -> Int -> IconPattern
forall a. [a] -> Int -> a
!! (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
          | Bool
otherwise = MultiCpuOpts -> Maybe IconPattern
fallbackIconPattern MultiCpuOpts
opts

splitEvery :: Int -> [a] -> [[a]]
splitEvery :: Int -> [a] -> [[a]]
splitEvery Int
n = ([a] -> Maybe ([a], [a])) -> [a] -> [[a]]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (\[a]
x -> if [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
x then Maybe ([a], [a])
forall a. Maybe a
Nothing else ([a], [a]) -> Maybe ([a], [a])
forall a. a -> Maybe a
Just (([a], [a]) -> Maybe ([a], [a])) -> ([a], [a]) -> Maybe ([a], [a])
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [a]
x)

groupData :: [String] -> [[String]]
groupData :: [[Char]] -> [[[Char]]]
groupData = [[[Char]]] -> [[[Char]]]
forall a. [[a]] -> [[a]]
transpose ([[[Char]]] -> [[[Char]]])
-> ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[[Char]]] -> [[[Char]]]
forall a. [a] -> [a]
tail ([[[Char]]] -> [[[Char]]])
-> ([[Char]] -> [[[Char]]]) -> [[Char]] -> [[[Char]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[Char]] -> [[[Char]]]
forall a. Int -> [a] -> [[a]]
splitEvery Int
vNum

formatAutoCpus :: MultiCpuOpts -> [String] -> Monitor [String]
formatAutoCpus :: MultiCpuOpts -> [[Char]] -> Monitor [[Char]]
formatAutoCpus MultiCpuOpts
_ [] = [[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
$ Int -> [Char] -> [[Char]]
forall a. Int -> a -> [a]
replicate Int
vNum [Char]
""
formatAutoCpus MultiCpuOpts
opts [[Char]]
xs =
  [[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
$ ([[Char]] -> [Char]) -> [[[Char]]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (if MultiCpuOpts -> Bool
contiguous MultiCpuOpts
opts then [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat else [[Char]] -> [Char]
unwords) ([[Char]] -> [[[Char]]]
groupData [[Char]]
xs)

runMultiCpu :: CpuDataRef -> [String] -> Monitor String
runMultiCpu :: CpuDataRef -> [[Char]] -> Monitor [Char]
runMultiCpu CpuDataRef
cref [[Char]]
argv =
  do [[Float]]
c <- IO [[Float]] -> Monitor [[Float]]
forall a. IO a -> Monitor a
io (IO [[Float]] -> Monitor [[Float]])
-> IO [[Float]] -> Monitor [[Float]]
forall a b. (a -> b) -> a -> b
$ CpuDataRef -> IO [[Float]]
parseCpuData CpuDataRef
cref
     MultiCpuOpts
opts <- IO MultiCpuOpts -> Monitor MultiCpuOpts
forall a. IO a -> Monitor a
io (IO MultiCpuOpts -> Monitor MultiCpuOpts)
-> IO MultiCpuOpts -> Monitor MultiCpuOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
-> MultiCpuOpts -> [[Char]] -> IO MultiCpuOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [[Char]] -> IO opts
parseOptsWith [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
options MultiCpuOpts
defaultOpts [[Char]]
argv
     [[Char]]
l <- MultiCpuOpts -> [[Float]] -> Monitor [[Char]]
formatMultiCpus MultiCpuOpts
opts [[Float]]
c
     [[Char]]
a <- MultiCpuOpts -> [[Char]] -> Monitor [[Char]]
formatAutoCpus MultiCpuOpts
opts [[Char]]
l
     [[Char]] -> Monitor [Char]
parseTemplate ([[Char]] -> Monitor [Char]) -> [[Char]] -> Monitor [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]]
a [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
l

startMultiCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
startMultiCpu :: [[Char]] -> Int -> ([Char] -> IO ()) -> IO ()
startMultiCpu [[Char]]
a Int
r [Char] -> IO ()
cb = do
  CpuDataRef
cref <- [[Int]] -> IO CpuDataRef
forall a. a -> IO (IORef a)
newIORef [[]]
  [[Float]]
_ <- CpuDataRef -> IO [[Float]]
parseCpuData CpuDataRef
cref
  [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> Int
-> ([Char] -> IO ())
-> IO ()
runM [[Char]]
a IO MConfig
multiCpuConfig (CpuDataRef -> [[Char]] -> Monitor [Char]
runMultiCpu CpuDataRef
cref) Int
r [Char] -> IO ()
cb