NetworkMonitor.hs

-- | Text network throughput widget.
module System.Taffybar.Widget.Text.NetworkMonitor where

import Control.Monad
import Control.Monad.Trans.Class
import qualified Data.Text as T
import GI.Gtk
import System.Taffybar.Context
import System.Taffybar.Hooks
import System.Taffybar.Information.Network
import System.Taffybar.Util
import System.Taffybar.Widget.Generic.ChannelWidget
import System.Taffybar.Widget.Util (widgetSetClassGI)
import Text.Printf
import Text.StringTemplate

-- | Default template for 'networkMonitorNew'.
defaultNetFormat :: String
defaultNetFormat = "▼ $inAuto$ ▲ $outAuto$"

-- | Render inbound/outbound speeds into a template.
showInfo :: String -> Int -> (Double, Double) -> T.Text
showInfo template prec (incomingb, outgoingb) =
  let attribs =
        [ ("inB", show incomingb),
          ("inKB", toKB prec incomingb),
          ("inMB", toMB prec incomingb),
          ("inAuto", toAuto prec incomingb),
          ("outB", show outgoingb),
          ("outKB", toKB prec outgoingb),
          ("outMB", toMB prec outgoingb),
          ("outAuto", toAuto prec outgoingb)
        ]
   in render . setManyAttrib attribs $ newSTMP template

-- | Convert bytes per second to KiB/s.
toKB :: Int -> Double -> String
toKB prec = setDigits prec . (/ 1024)

-- | Convert bytes per second to MiB/s.
toMB :: Int -> Double -> String
toMB prec = setDigits prec . (/ (1024 * 1024))

-- | Render a floating-point value with fixed precision.
setDigits :: Int -> Double -> String
setDigits dig = printf format
  where
    format = "%." ++ show dig ++ "f"

-- | Convert bytes per second to an automatically chosen unit.
toAuto :: Int -> Double -> String
toAuto prec value = printf "%.*f%s" p v unit
  where
    value' = max 0 value
    mag :: Int
    mag = if value' == 0 then 0 else max 0 $ min 4 $ floor $ logBase 1024 value'
    v = value' / 1024 ** fromIntegral mag
    unit = case mag of
      0 -> "B/s"
      1 -> "KiB/s"
      2 -> "MiB/s"
      3 -> "GiB/s"
      4 -> "TiB/s"
      _ -> "??B/s" -- unreachable
    p :: Int
    p = max 0 $ floor $ fromIntegral prec - logBase 10 v

-- | Create a text network monitor widget.
--
-- The optional interface list restricts aggregation to matching interface
-- names; when omitted, all interfaces are included.
networkMonitorNew :: String -> Maybe [String] -> TaffyIO GI.Gtk.Widget
networkMonitorNew template interfaces = do
  NetworkInfoChan chan <- getNetworkChan
  let filterFn = maybe (const True) (flip elem) interfaces
  label <- lift $ labelNew Nothing
  _ <- lift $ widgetSetClassGI label (T.pack "text-network-monitor")
  void $ channelWidgetNew label chan $ \speedInfo ->
    let (up, down) = sumSpeeds $ map snd $ filter (filterFn . fst) speedInfo
        labelString = showInfo template 3 (fromRational down, fromRational up)
     in postGUIASync $ labelSetMarkup label labelString
  toWidget label