-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Cpu.Linux
-- Copyright   :  (c) 2011, 2017 Jose Antonio Ortega Ruiz
--                (c) 2007-2010 Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A cpu monitor for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Cpu.Linux (parseCpu
                                         , CpuDataRef
                                         , cpuData) where

import Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..))
import qualified Data.ByteString.Lazy.Char8 as B
import Data.IORef (IORef, readIORef, writeIORef)

type CpuDataRef = IORef [Int]

-- Details about the fields here: https://www.kernel.org/doc/Documentation/filesystems/proc.txt
cpuData :: IO [Int]
cpuData :: IO [Int]
cpuData = ByteString -> [Int]
cpuParser (ByteString -> [Int]) -> IO ByteString -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
"/proc/stat"

readInt :: B.ByteString -> Int
readInt :: ByteString -> Int
readInt ByteString
bs = case ByteString -> Maybe (Int, ByteString)
B.readInt ByteString
bs of
               Maybe (Int, ByteString)
Nothing -> Int
0
               Just (Int
i, ByteString
_) -> Int
i

cpuParser :: B.ByteString -> [Int]
cpuParser :: ByteString -> [Int]
cpuParser = (ByteString -> Int) -> [ByteString] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
readInt ([ByteString] -> [Int])
-> (ByteString -> [ByteString]) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
forall a. [a] -> [a]
tail ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.words (ByteString -> [ByteString])
-> (ByteString -> ByteString) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines

convertToCpuData :: [Float] -> CpuData
convertToCpuData :: [Float] -> CpuData
convertToCpuData (Float
u:Float
n:Float
s:Float
ie:Float
iw:[Float]
_) =
  CpuData :: Float -> Float -> Float -> Float -> Float -> Float -> CpuData
CpuData
    { cpuUser :: Float
cpuUser = Float
u
    , cpuNice :: Float
cpuNice = Float
n
    , cpuSystem :: Float
cpuSystem = Float
s
    , cpuIdle :: Float
cpuIdle = Float
ie
    , cpuIowait :: Float
cpuIowait = Float
iw
    , cpuTotal :: Float
cpuTotal = [Float] -> Float
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Float
u, Float
n, Float
s]
    }
convertToCpuData [Float]
args = FilePath -> CpuData
forall a. HasCallStack => FilePath -> a
error (FilePath -> CpuData) -> FilePath -> CpuData
forall a b. (a -> b) -> a -> b
$ FilePath
"convertToCpuData: Unexpected list" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> [Float] -> FilePath
forall a. Show a => a -> FilePath
show [Float]
args

parseCpu :: CpuDataRef -> IO CpuData
parseCpu :: CpuDataRef -> IO CpuData
parseCpu CpuDataRef
cref =
    do [Int]
a <- CpuDataRef -> IO [Int]
forall a. IORef a -> IO a
readIORef CpuDataRef
cref
       [Int]
b <- IO [Int]
cpuData
       CpuDataRef -> [Int] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef CpuDataRef
cref [Int]
b
       let dif :: [Int]
dif = (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Int]
b [Int]
a
           tot :: Float
tot = 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
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
dif
           safeDiv :: a -> Float
safeDiv a
n = case Float
tot of
                         Float
0 -> Float
0
                         Float
v -> a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
v
           percent :: [Float]
percent = (Int -> Float) -> [Int] -> [Float]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Float
forall a. Integral a => a -> Float
safeDiv [Int]
dif
       CpuData -> IO CpuData
forall (m :: * -> *) a. Monad m => a -> m a
return (CpuData -> IO CpuData) -> CpuData -> IO CpuData
forall a b. (a -> b) -> a -> b
$ [Float] -> CpuData
convertToCpuData [Float]
percent