module System.Taffybar.Information.CPU ( cpuLoad ) where

import Control.Concurrent ( threadDelay )
import System.IO ( IOMode(ReadMode), openFile, hGetLine, hClose )

procData :: IO [Double]
procData :: IO [Double]
procData = do
  Handle
h <- FilePath -> IOMode -> IO Handle
openFile FilePath
"/proc/stat" IOMode
ReadMode
  FilePath
firstLine <- Handle -> IO FilePath
hGetLine Handle
h
  FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
firstLine Int -> IO () -> IO ()
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Handle -> IO ()
hClose Handle
h
  [Double] -> IO [Double]
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> [Double]
procParser FilePath
firstLine)

procParser :: String -> [Double]
procParser :: FilePath -> [Double]
procParser = (FilePath -> Double) -> [FilePath] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Double
forall a. Read a => FilePath -> a
read ([FilePath] -> [Double])
-> (FilePath -> [FilePath]) -> FilePath -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words

truncVal :: Double -> Double
truncVal :: Double -> Double
truncVal Double
v
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isNaN Double
v Bool -> Bool -> Bool
|| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0.0 = Double
0.0
  | Bool
otherwise = Double
v

-- | Return a pair with (user time, system time, total time) (read
-- from /proc/stat).  The function waits for 50 ms between samples.
cpuLoad :: IO (Double, Double, Double)
cpuLoad :: IO (Double, Double, Double)
cpuLoad = do
  [Double]
a <- IO [Double]
procData
  Int -> IO ()
threadDelay Int
50000
  [Double]
b <- IO [Double]
procData
  let dif :: [Double]
dif = (Double -> Double -> Double) -> [Double] -> [Double] -> [Double]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Double]
b [Double]
a
      tot :: Double
tot = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Double]
dif
      pct :: [Double]
pct = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
tot) [Double]
dif
      user :: Double
user = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Double] -> Double) -> [Double] -> Double
forall a b. (a -> b) -> a -> b
$ Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
2 [Double]
pct
      system :: Double
system = [Double]
pct [Double] -> Int -> Double
forall a. [a] -> Int -> a
!! Int
2
      t :: Double
t = Double
user Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
system
  (Double, Double, Double) -> IO (Double, Double, Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Double
truncVal Double
user, Double -> Double
truncVal Double
system, Double -> Double
truncVal Double
t)