diff --git a/dotfiles/config/taffybar/TaffybarConfig/ChromeFavicons.hs b/dotfiles/config/taffybar/TaffybarConfig/ChromeFavicons.hs new file mode 100644 index 00000000..c10be6b8 --- /dev/null +++ b/dotfiles/config/taffybar/TaffybarConfig/ChromeFavicons.hs @@ -0,0 +1,320 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} + +module TaffybarConfig.ChromeFavicons + ( ChromeFaviconOverlayMode (..), + ChromeFaviconConfig (..), + defaultChromeFaviconConfig, + chromeFaviconIconGetter, + ) +where + +import Control.Exception (IOException, try) +import Control.Monad (unless, when) +import Control.Monad.IO.Class (liftIO) +import Data.Char (isAlphaNum) +import Data.Int (Int32) +import Data.Maybe (fromMaybe, listToMaybe) +import Data.Text (Text) +import qualified Data.Text as T +import qualified GI.GdkPixbuf.Enums as GdkPixbuf +import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk +import System.Directory + ( createDirectoryIfMissing, + doesFileExist, + getFileSize, + renameFile, + ) +import System.Environment.XDG.BaseDir (getUserCacheDir) +import System.Exit (ExitCode (ExitSuccess)) +import System.FilePath (()) +import System.Process (readProcessWithExitCode) +import qualified System.Taffybar.Information.Workspaces.Model as WorkspaceModel +import qualified System.Taffybar.Widget.Workspaces as Workspaces +import System.Taffybar.Widget.Util (loadPixbufByName) + +data ChromeFaviconOverlayMode + = FaviconWithChromeOverlay + | ChromeWithFaviconOverlay + deriving (Eq, Show) + +data ChromeFaviconConfig = ChromeFaviconConfig + { chromeFaviconOverlayMode :: ChromeFaviconOverlayMode, + chromeFaviconOverlayRatio :: Double, + chromeFaviconEnabled :: Bool + } + deriving (Eq, Show) + +defaultChromeFaviconConfig :: ChromeFaviconConfig +defaultChromeFaviconConfig = + ChromeFaviconConfig + { chromeFaviconOverlayMode = FaviconWithChromeOverlay, + chromeFaviconOverlayRatio = 0.45, + chromeFaviconEnabled = True + } + +data BridgePayload = BridgePayload + { payloadMappedWindowId :: Text, + payloadFaviconURL :: Text + } + deriving (Eq, Show) + +chromeFaviconIconGetter :: ChromeFaviconConfig -> Workspaces.WindowIconPixbufGetter +chromeFaviconIconGetter cfg = + Workspaces.handleIconGetterException $ \size windowInfo -> + if chromeFaviconEnabled cfg && isChromeWindow windowInfo + then liftIO $ chromeFaviconPixbuf cfg size windowInfo + else pure Nothing + +chromeFaviconPixbuf :: + ChromeFaviconConfig -> + Int32 -> + WorkspaceModel.WindowInfo -> + IO (Maybe Gdk.Pixbuf) +chromeFaviconPixbuf cfg size windowInfo = do + payload <- getChromeWindowInfoPayload windowInfo + case payload of + Just p + | payloadMatchesWindow windowInfo p, + validFaviconURL (payloadFaviconURL p) -> do + mFavicon <- loadCachedFavicon size (payloadFaviconURL p) + mChrome <- runChromeIconGetter size windowInfo + case (mFavicon, mChrome) of + (Just favicon, Just chromeIcon) -> + Just <$> composeChromeFavicon cfg size favicon chromeIcon + (Just favicon, Nothing) -> Just <$> scalePixbuf size favicon + _ -> pure Nothing + _ -> pure Nothing + +runChromeIconGetter :: Int32 -> WorkspaceModel.WindowInfo -> IO (Maybe Gdk.Pixbuf) +runChromeIconGetter size _ = + loadPixbufByName size "google-chrome" + +payloadMatchesWindow :: WorkspaceModel.WindowInfo -> BridgePayload -> Bool +payloadMatchesWindow windowInfo payload = + normalizedHyprlandWindowId windowInfo == Just (normalizeAddress (payloadMappedWindowId payload)) + +normalizedHyprlandWindowId :: WorkspaceModel.WindowInfo -> Maybe Text +normalizedHyprlandWindowId windowInfo = + case WorkspaceModel.windowIdentity windowInfo of + WorkspaceModel.HyprlandWindowIdentity address -> Just (normalizeAddress address) + WorkspaceModel.X11WindowIdentity _ -> Nothing + +isChromeWindow :: WorkspaceModel.WindowInfo -> Bool +isChromeWindow windowInfo = + any looksLikeChrome (WorkspaceModel.windowClassHints windowInfo) + +looksLikeChrome :: Text -> Bool +looksLikeChrome raw = + let lowered = T.toLower raw + in any (`T.isInfixOf` lowered) ["chrome", "chromium", "brave", "edge", "vivaldi"] + +normalizeAddress :: Text -> Text +normalizeAddress address = + let trimmed = T.strip address + in if "0x" `T.isPrefixOf` trimmed || T.null trimmed + then trimmed + else "0x" <> trimmed + +validFaviconURL :: Text -> Bool +validFaviconURL url = + any (`T.isPrefixOf` url) ["https://", "http://"] + +getChromeWindowInfoPayload :: WorkspaceModel.WindowInfo -> IO (Maybe BridgePayload) +getChromeWindowInfoPayload windowInfo = + case normalizedHyprlandWindowId windowInfo of + Just windowId -> do + payloads <- getBridgeString "GetWindowPayloads" + payload <- case payloads of + Just payloadText -> extractBridgePayloadForWindow windowId payloadText + Nothing -> pure Nothing + case payload of + Just value -> pure (Just value) + Nothing -> getLastChromeWindowInfoPayload + Nothing -> getLastChromeWindowInfoPayload + +getLastChromeWindowInfoPayload :: IO (Maybe BridgePayload) +getLastChromeWindowInfoPayload = do + payload <- getBridgeString "GetLastPayload" + case payload of + Just payloadText -> extractBridgePayload payloadText + Nothing -> pure Nothing + +getBridgeString :: String -> IO (Maybe String) +getBridgeString method = do + result <- + try @IOException $ + readProcessWithExitCode + "busctl" + [ "--user", + "call", + "org.imalison.ChromeWindowInfo", + "/org/imalison/ChromeWindowInfo", + "org.imalison.ChromeWindowInfo", + method + ] + "" + case result of + Right (ExitSuccess, stdoutText, _) -> + pure (parseBusctlString stdoutText) + _ -> pure Nothing + +parseBusctlString :: String -> Maybe String +parseBusctlString output = do + rest <- T.stripPrefix "s " (T.strip (T.pack output)) + decodeQuotedString (T.unpack rest) + +decodeQuotedString :: String -> Maybe String +decodeQuotedString raw = + case reads raw of + [(decoded, trailing)] | all (`elem` (" \n\t\r" :: String)) trailing -> Just decoded + _ -> Nothing + +extractBridgePayload :: String -> IO (Maybe BridgePayload) +extractBridgePayload payload = do + let jqFilter = "[.bridge.mapped_window.window_id // \"\", .tab.favicon_url // \"\"] | @tsv" + (code, stdoutText, _) <- readProcessWithExitCode "jq" ["-r", jqFilter] payload + pure $ + case (code, T.splitOn "\t" (T.strip (T.pack stdoutText))) of + (ExitSuccess, [mappedWindowId, faviconURL]) + | not (T.null mappedWindowId), + not (T.null faviconURL) -> + Just (BridgePayload mappedWindowId faviconURL) + _ -> Nothing + +extractBridgePayloadForWindow :: Text -> String -> IO (Maybe BridgePayload) +extractBridgePayloadForWindow windowId payloads = do + let jqFilter = ".[$window_id] // empty | [.bridge.mapped_window.window_id // \"\", .tab.favicon_url // \"\"] | @tsv" + (code, stdoutText, _) <- + readProcessWithExitCode + "jq" + ["-r", "--arg", "window_id", T.unpack windowId, jqFilter] + payloads + pure $ + case (code, T.splitOn "\t" (T.strip (T.pack stdoutText))) of + (ExitSuccess, [mappedWindowId, faviconURL]) + | not (T.null mappedWindowId), + not (T.null faviconURL) -> + Just (BridgePayload mappedWindowId faviconURL) + _ -> Nothing + +loadCachedFavicon :: Int32 -> Text -> IO (Maybe Gdk.Pixbuf) +loadCachedFavicon size url = do + path <- ensureCachedFavicon url + case path of + Just faviconPath -> + try @IOException (Gdk.pixbufNewFromFileAtScale faviconPath size size True) >>= \case + Right (Just pixbuf) -> pure (Just pixbuf) + Right Nothing -> pure Nothing + Left _ -> pure Nothing + Nothing -> pure Nothing + +ensureCachedFavicon :: Text -> IO (Maybe FilePath) +ensureCachedFavicon url = do + cacheRoot <- getUserCacheDir "taffybar/chrome-favicons" + let rawDir = cacheRoot "raw" + createDirectoryIfMissing True rawDir + hash <- hashText url + let path = rawDir (hash <> faviconExtension url) + cached <- nonEmptyFileExists path + unless cached $ + downloadFavicon url path + exists <- nonEmptyFileExists path + pure $ if exists then Just path else Nothing + +hashText :: Text -> IO String +hashText value = do + (code, stdoutText, _) <- + readProcessWithExitCode "sha256sum" [] (T.unpack value) + pure $ + if code == ExitSuccess + then takeWhile (/= ' ') stdoutText + else safeFileComponent value + +safeFileComponent :: Text -> String +safeFileComponent = + take 96 . map normalizeChar . T.unpack + where + normalizeChar c + | isAlphaNum c = c + | otherwise = '-' + +faviconExtension :: Text -> String +faviconExtension url = + fromMaybe ".img" $ + listToMaybe + [ T.unpack ext + | ext <- [".svg", ".png", ".ico", ".jpg", ".jpeg", ".webp", ".gif"] :: [Text], + ext `T.isSuffixOf` T.toLower pathOnly + ] + where + pathOnly = T.takeWhile (/= '?') url + +downloadFavicon :: Text -> FilePath -> IO () +downloadFavicon url path = do + let tmp = path <> ".tmp" + (code, _, _) <- + readProcessWithExitCode + "curl" + [ "-fsSL", + "--max-time", + "10", + "--retry", + "1", + "-o", + tmp, + T.unpack url + ] + "" + when (code == ExitSuccess) $ + renameFile tmp path + +nonEmptyFileExists :: FilePath -> IO Bool +nonEmptyFileExists path = do + exists <- doesFileExist path + if exists + then (> 0) <$> getFileSize path + else pure False + +composeChromeFavicon :: + ChromeFaviconConfig -> + Int32 -> + Gdk.Pixbuf -> + Gdk.Pixbuf -> + IO Gdk.Pixbuf +composeChromeFavicon cfg size favicon chromeIcon = do + let (baseSource, overlaySource) = + case chromeFaviconOverlayMode cfg of + FaviconWithChromeOverlay -> (favicon, chromeIcon) + ChromeWithFaviconOverlay -> (chromeIcon, favicon) + base <- scalePixbuf size baseSource + result <- fromMaybe base <$> Gdk.pixbufCopy base + baseWidth <- Gdk.pixbufGetWidth result + baseHeight <- Gdk.pixbufGetHeight result + let baseSize = max 1 (min baseWidth baseHeight) + overlaySize = + max 1 $ + min baseSize $ + round (fromIntegral baseSize * chromeFaviconOverlayRatio cfg) + overlayX = baseWidth - overlaySize + overlayY = baseHeight - overlaySize + overlay <- scalePixbuf overlaySize overlaySource + Gdk.pixbufComposite + overlay + result + overlayX + overlayY + overlaySize + overlaySize + (fromIntegral overlayX) + (fromIntegral overlayY) + 1 + 1 + GdkPixbuf.InterpTypeBilinear + 255 + pure result + +scalePixbuf :: Int32 -> Gdk.Pixbuf -> IO Gdk.Pixbuf +scalePixbuf size pixbuf = + fromMaybe pixbuf <$> Gdk.pixbufScaleSimple pixbuf size size GdkPixbuf.InterpTypeBilinear diff --git a/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs b/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs index f30e4397..14c2aa24 100644 --- a/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs +++ b/dotfiles/config/taffybar/TaffybarConfig/Widgets.hs @@ -26,6 +26,7 @@ import System.Taffybar.Context ) import System.Taffybar.Information.Memory (MemoryInfo (..), parseMeminfo) import qualified System.Taffybar.Information.Workspaces.Hyprland as HyprlandWorkspaces +import System.Taffybar.Information.ChromeWindowInfo (getChromeWindowInfoRefreshChan) import System.Taffybar.Util (postGUIASync) import System.Taffybar.Widget import qualified System.Taffybar.Widget.ASUS as ASUS @@ -110,6 +111,7 @@ workspacesWidget = { Workspaces.widgetGap = 0, Workspaces.minIcons = 1, Workspaces.getWindowIconPixbuf = workspaceWindowIconGetter, + Workspaces.externalIconRefreshSources = [getChromeWindowInfoRefreshChan], Workspaces.hyprlandWorkspaceProviderConfig = HyprlandWorkspaces.defaultHyprlandWorkspaceProviderConfig { HyprlandWorkspaces.specialWorkspaceWindowTarget = diff --git a/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs b/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs index 059d6689..1e441210 100644 --- a/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs +++ b/dotfiles/config/taffybar/TaffybarConfig/Workspaces.hs @@ -29,6 +29,20 @@ import System.Taffybar.Util (getPixbufFromFilePath, maybeTCombine, (<|||>)) import System.Taffybar.Widget.Util (loadPixbufByName) import qualified System.Taffybar.Widget.Workspaces as Workspaces import System.Taffybar.WindowIcon (pixBufFromColor) +import TaffybarConfig.ChromeFavicons + ( ChromeFaviconConfig (..), + ChromeFaviconOverlayMode (..), + chromeFaviconIconGetter, + defaultChromeFaviconConfig, + ) + +chromeFaviconConfig :: ChromeFaviconConfig +chromeFaviconConfig = + defaultChromeFaviconConfig + { chromeFaviconOverlayMode = FaviconWithChromeOverlay, + chromeFaviconOverlayRatio = 0.45, + chromeFaviconEnabled = True + } x11FullWorkspaceNames :: X11Property [(WorkspaceId, String)] x11FullWorkspaceNames = @@ -174,7 +188,8 @@ workspaceFallbackIcon size _ = workspaceWindowIconGetter :: Workspaces.WindowIconPixbufGetter workspaceWindowIconGetter = - workspaceManualIconGetter + chromeFaviconIconGetter chromeFaviconConfig + <|||> workspaceManualIconGetter <|||> Workspaces.getWindowIconPixbufFromChrome <|||> Workspaces.defaultGetWindowIconPixbuf <|||> workspaceFallbackIcon diff --git a/dotfiles/config/taffybar/imalison-taffybar.cabal b/dotfiles/config/taffybar/imalison-taffybar.cabal index cf530592..cedc2ed9 100644 --- a/dotfiles/config/taffybar/imalison-taffybar.cabal +++ b/dotfiles/config/taffybar/imalison-taffybar.cabal @@ -14,6 +14,7 @@ executable taffybar hs-source-dirs: . main-is: taffybar.hs other-modules: TaffybarConfig.Config + , TaffybarConfig.ChromeFavicons , TaffybarConfig.Host , TaffybarConfig.Widgets , TaffybarConfig.WidgetUtil diff --git a/dotfiles/config/taffybar/taffybar b/dotfiles/config/taffybar/taffybar index 2c95fd5a..5af1f40e 160000 --- a/dotfiles/config/taffybar/taffybar +++ b/dotfiles/config/taffybar/taffybar @@ -1 +1 @@ -Subproject commit 2c95fd5a8aa125d0ba89873a7d4dfd49bb57b00c +Subproject commit 5af1f40e567a8a672394cb08678db1e56e83952d