dotfiles/dotfiles/config/taffybar/taffybar.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE DataKinds #-}
module Main where

import           Control.Exception.Base
import           Control.Monad
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import qualified Data.ByteString.Char8 as BS
import           Data.List
import           Data.List.Split
import qualified Data.Map as M
import           Data.Maybe
import qualified Data.Text
import           Data.Time
import qualified GI.Gtk as Gtk
import qualified GI.Gtk.Objects.Overlay as Gtk
import           Network.HostName
import           StatusNotifier.Tray
import           System.Directory
import           System.Environment
import           System.Environment.XDG.BaseDir
import           System.FilePath.Posix
import           System.IO
import           System.Log.Handler.Simple
import           System.Log.Logger
import           System.Process
import           System.Taffybar
import           System.Taffybar.Auth
import           System.Taffybar.Context (appendHook)
import           System.Taffybar.DBus
import           System.Taffybar.DBus.Toggle
import           System.Taffybar.Hooks
import           System.Taffybar.Information.CPU
import           System.Taffybar.Information.EWMHDesktopInfo
import           System.Taffybar.Information.Memory
import           System.Taffybar.Information.X11DesktopInfo
import           System.Taffybar.SimpleConfig
import           System.Taffybar.Util
import           System.Taffybar.Widget
import           System.Taffybar.Widget.Crypto
import           System.Taffybar.Widget.Generic.Icon
import           System.Taffybar.Widget.Generic.PollingGraph
import           System.Taffybar.Widget.Generic.PollingLabel
import           System.Taffybar.Widget.Util
import           System.Taffybar.Widget.Workspaces
import           Text.Printf
import           Text.Read hiding (lift)

setClassAndBoundingBoxes :: MonadIO m => Data.Text.Text -> Gtk.Widget -> m Gtk.Widget
setClassAndBoundingBoxes klass = buildContentsBox >=> flip widgetSetClassGI klass

deocrateWithSetClassAndBoxes :: MonadIO m => Data.Text.Text -> m Gtk.Widget -> m Gtk.Widget
deocrateWithSetClassAndBoxes klass builder = builder >>= setClassAndBoundingBoxes klass

mkRGBA (r, g, b, a) = (r/256, g/256, b/256, a/256)
blue = mkRGBA (42, 99, 140, 256)
yellow1 = mkRGBA (242, 163, 54, 256)
yellow2 = mkRGBA (254, 204, 83, 256)
yellow3 = mkRGBA (227, 134, 18, 256)
red = mkRGBA (210, 77, 37, 256)

myGraphConfig =
  defaultGraphConfig
  { graphPadding = 0
  , graphBorderWidth = 0
  , graphWidth = 75
  , graphBackgroundColor = (0.0, 0.0, 0.0, 0.0)
  }

netCfg = myGraphConfig
  { graphDataColors = [yellow1, yellow2]
  , graphLabel = Just "net"
  }

memCfg = myGraphConfig
  { graphDataColors = [(0.129, 0.588, 0.953, 1)]
  , graphLabel = Just "mem"
  }

cpuCfg = myGraphConfig
  { graphDataColors = [red, (1, 0, 1, 0.5)]
  , graphLabel = Just "cpu"
  }

memCallback :: IO [Double]
memCallback = do
  mi <- parseMeminfo
  return [memoryUsedRatio mi]

cpuCallback = do
  (_, systemLoad, totalLoad) <- cpuLoad
  return [totalLoad, systemLoad]

getFullWorkspaceNames :: X11Property [(WorkspaceId, String)]
getFullWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_FULL_NAMES"
  where go = zip [WorkspaceId i | i <- [0..]]

workspaceNamesLabelSetter workspace =
  remapNSP . fromMaybe "" . lookup (workspaceIdx workspace) <$>
            liftX11Def [] getFullWorkspaceNames
  where remapNSP "NSP" = "S"
        remapNSP n = n

enableLogger logger level = do
  logger <- getLogger logger
  saveGlobalLogger $ setLevel level logger

logDebug = do
  global <- getLogger ""
  saveGlobalLogger $ setLevel DEBUG global
  logger3 <- getLogger "System.Taffybar"
  saveGlobalLogger $ setLevel DEBUG logger3
  logger <- getLogger "System.Taffybar.Widget.Generic.AutoSizeImage"
  saveGlobalLogger $ setLevel DEBUG logger
  logger2 <- getLogger "StatusNotifier.Tray"
  saveGlobalLogger $ setLevel DEBUG logger2
  -- workspacesLogger <- getLogger "System.Taffybar.Widget.Workspaces"
  -- saveGlobalLogger $ setLevel WARNING workspacesLogger
  -- logDebug
  -- logM "What" WARNING "Why"
  -- enableLogger "System.Taffybar.Widget.Util" DEBUG
  -- enableLogger "System.Taffybar.Information.XDG.DesktopEntry" DEBUG
  -- enableLogger "System.Taffybar.WindowIcon" DEBUG
  -- enableLogger "System.Taffybar.Widget.Generic.PollingLabel" DEBUG

cssFilesByHostname =
  [ ("uber-loaner", ["uber-loaner.css"])
  , ("imalison-home", ["taffybar.css"])
  , ("ivanm-dfinity-razer", ["taffybar.css"])
  , ("ryzen-shine", ["taffybar.css"])
  , ("stevie-nixos", ["taffybar.css"])
  ]

main = do
  enableLogger "Graphics.UI.GIGtkStrut" DEBUG

  hostName <- getHostName
  homeDirectory <- getHomeDirectory
  let relativeFiles = fromMaybe ["taffybar.css"] $ lookup hostName cssFilesByHostname
  cssFiles <- mapM (getUserConfigFile "taffybar") relativeFiles

  let myCPU = deocrateWithSetClassAndBoxes "cpu" $
              pollingGraphNew cpuCfg 5 cpuCallback
      myMem = deocrateWithSetClassAndBoxes "mem" $
              pollingGraphNew memCfg 5 memCallback
      myNet = deocrateWithSetClassAndBoxes "net" $
              networkGraphNew netCfg Nothing
      myLayout = deocrateWithSetClassAndBoxes "layout" $
                 layoutNew defaultLayoutConfig
      myWindows = deocrateWithSetClassAndBoxes "windows" $
                  windowsNew defaultWindowsConfig
      myWorkspaces =
        flip widgetSetClassGI "workspaces" =<<
        workspacesNew defaultWorkspacesConfig
                        { minIcons = 1
                        , getWindowIconPixbuf =
                          scaledWindowIconPixbufGetter $
                          getWindowIconPixbufFromChrome <|||>
                          unscaledDefaultGetWindowIconPixbuf <|||>
                          (\size _ -> lift $ loadPixbufByName size "application-default-icon")
                        , widgetGap = 0
                        , showWorkspaceFn = hideEmpty
                        , updateRateLimitMicroseconds = 100000
                        , labelSetter = workspaceNamesLabelSetter
                        , widgetBuilder = buildLabelOverlayController
                        }
      myClock = deocrateWithSetClassAndBoxes "clock" $
                textClockNewWith
                defaultClockConfig
                { clockUpdateStrategy = RoundedTargetInterval 60 0.0
                , clockFormatString = "%a %b %_d, 🕑%I:%M %p"
                }
      myICP = deocrateWithSetClassAndBoxes "icp" $ cryptoPriceLabelWithIcon @"ICP-USD"
      myBTC = deocrateWithSetClassAndBoxes "btc" $ cryptoPriceLabelWithIcon @"BTC-USD"
      myETH = deocrateWithSetClassAndBoxes "eth" $ cryptoPriceLabelWithIcon @"ETH-USD"
      myTray = deocrateWithSetClassAndBoxes "tray" $
               sniTrayNewFromParams defaultTrayParams { trayLeftClickAction = PopupMenu
                                                      , trayRightClickAction = Activate
                                                      }
      myMpris = mpris2NewWithConfig
                MPRIS2Config { mprisWidgetWrapper = deocrateWithSetClassAndBoxes "mpris" . return
                             , updatePlayerWidget =
                               simplePlayerWidget
                               defaultPlayerConfig
                               { setNowPlayingLabel = playingText 20 20 }
                             }
      myBatteryIcon = deocrateWithSetClassAndBoxes "battery-icon" batteryIconNew
      myBatteryText =
        deocrateWithSetClassAndBoxes "battery-text" $ textBatteryNew "$percentage$%"
      batteryWidgets = [myBatteryIcon, myBatteryText]
      baseEndWidgets =
        [ myTray
        , myICP
        , myBTC
        , myETH
        , myMpris
        ]
      fullEndWidgets = baseEndWidgets ++ [ myCPU, myMem, myNet, myMpris ]
      laptopEndWidgets = batteryWidgets ++ baseEndWidgets
      baseConfig =
        defaultSimpleTaffyConfig
        { startWidgets = [ myWorkspaces, myLayout, myWindows ]
        , endWidgets = baseEndWidgets
        , barPosition = Top
        , widgetSpacing = 0
        , barPadding = 0
        , barHeight = ScreenRatio $ 1/27
        , cssPaths = cssFiles
        , startupHook = void $ setCMCAPIKey "f9e66366-9d42-4c6e-8d40-4194a0aaa329"
        , centerWidgets = [ myClock ]
        }
      selectedConfig =
        fromMaybe baseConfig $ lookup hostName
          [ ( "uber-loaner"
            , baseConfig { endWidgets = laptopEndWidgets }
            )
          , ( "adele"
            , baseConfig { endWidgets = laptopEndWidgets }
            )
          , ( "stevie-nixos"
            , baseConfig { endWidgets = laptopEndWidgets
                         , startWidgets = [myWorkspaces, myLayout]
                         }
            )
          , ( "jay-lenovo"
            , baseConfig { endWidgets = laptopEndWidgets }
            )
          ]
      simpleTaffyConfig = selectedConfig
        { centerWidgets = [ myClock ]
        -- , endWidgets = []
        -- , startWidgets = []
        }
  startTaffybar $
    appendHook (void $ getTrayHost False) $
    withLogServer $
    withToggleServer $
    toTaffyConfig simpleTaffyConfig