module System.Taffybar.Widget.Text.CPUMonitor (textCpuMonitorNew) where

import Control.Monad.IO.Class ( MonadIO )
import Text.Printf ( printf )
import qualified Text.StringTemplate as ST
import System.Taffybar.Information.CPU
import System.Taffybar.Widget.Generic.PollingLabel ( pollingLabelNew )
import qualified GI.Gtk

-- | Creates a simple textual CPU monitor. It updates once every polling
-- period (in seconds).
textCpuMonitorNew :: MonadIO m
                  => String -- ^ Format. You can use variables: $total$, $user$, $system$
                  -> Double -- ^ Polling period (in seconds)
                  -> m GI.Gtk.Widget
textCpuMonitorNew :: forall (m :: * -> *). MonadIO m => String -> Double -> m Widget
textCpuMonitorNew String
fmt Double
period = do
  Widget
label <- Double -> IO Text -> m Widget
forall (m :: * -> *). MonadIO m => Double -> IO Text -> m Widget
pollingLabelNew Double
period IO Text
callback
  Widget -> m Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
GI.Gtk.toWidget Widget
label
  where
    callback :: IO Text
callback = do
      (Double
userLoad, Double
systemLoad, Double
totalLoad) <- IO (Double, Double, Double)
cpuLoad
      let pct :: Double -> String
pct = Double -> String
formatPercent (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)
      let template :: StringTemplate Text
template = String -> StringTemplate Text
forall a. Stringable a => String -> StringTemplate a
ST.newSTMP String
fmt
      let template' :: StringTemplate Text
template' = [(String, String)] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
[(String, a)] -> StringTemplate b -> StringTemplate b
ST.setManyAttrib [ (String
"user", Double -> String
pct Double
userLoad),
                                         (String
"system", Double -> String
pct Double
systemLoad),
                                         (String
"total", Double -> String
pct Double
totalLoad) ] StringTemplate Text
template
      Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ StringTemplate Text -> Text
forall a. Stringable a => StringTemplate a -> a
ST.render StringTemplate Text
template'

formatPercent :: Double -> String
formatPercent :: Double -> String
formatPercent = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.2f"