dotfiles/dotfiles/config/taffybar/taffybar.hs
2024-03-20 03:43:21 -06:00

250 lines
9.3 KiB
Haskell

{-# 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]
}
)
, ( "strixi-minaj"
, baseConfig { endWidgets = laptopEndWidgets }
)
, ( "jay-lenovo"
, baseConfig { endWidgets = laptopEndWidgets }
)
, ( "nixquick"
, baseConfig { endWidgets = [ myTray , myMpris ] }
)
]
simpleTaffyConfig = selectedConfig
{ centerWidgets = [ myClock ]
-- , endWidgets = []
-- , startWidgets = []
}
startTaffybar $
appendHook (void $ getTrayHost False) $
withLogServer $
withToggleServer $
toTaffyConfig simpleTaffyConfig