taffybar: robust Wayland/Hyprland environment discovery

Instead of relying solely on environment variables (which can be stale
from systemd --user), actively discover wayland sockets and Hyprland
instance signatures from XDG_RUNTIME_DIR.  Fix up the process
environment so taffybar's internal backend detection agrees, and also
correct XDG_SESSION_TYPE in both directions.  Add INFO-level logging
for backend selection.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

dotfiles/config/taffybar/taffybar.hs

@@ -7,7 +7,7 @@ module Main (main) where
 import           Control.Monad (guard, when)
 import           Control.Monad.IO.Class (MonadIO, liftIO)
 import           Data.Int (Int32)
-import           Data.List (nub)
+import           Data.List (isPrefixOf, isSuffixOf, nub)
 import qualified Data.Map as M
 import           Data.Maybe (catMaybes, fromMaybe, isJust, mapMaybe)
 import           Data.Text (Text)
@@ -15,11 +15,11 @@ import qualified Data.Text as T
 import qualified GI.GdkPixbuf.Objects.Pixbuf as Gdk
 import qualified GI.Gtk as Gtk
 import           Network.HostName (getHostName)
-import           System.Directory (doesPathExist)
+import           System.Directory (doesPathExist, listDirectory)
 import           System.Environment (lookupEnv, setEnv, unsetEnv)
 import           System.Environment.XDG.BaseDir (getUserConfigFile)
 import           System.FilePath.Posix ((</>))
-import           System.Log.Logger (Priority (..), getLogger, logM, saveGlobalLogger, setLevel)
+import           System.Log.Logger (Priority (..), getLogger, logM, rootLoggerName, saveGlobalLogger, setLevel, updateGlobalLogger)
 import           System.Taffybar (startTaffybar)
 import           System.Taffybar.Context (Backend (BackendWayland, BackendX11), TaffyIO, detectBackend)
 import           System.Taffybar.DBus
@@ -73,19 +73,78 @@ enableLogger loggerName level = do
   logger <- getLogger loggerName
   saveGlobalLogger $ setLevel level logger
 
--- Systemd --user's manager environment can be stale across logins (e.g. still
--- containing WAYLAND_DISPLAY from an older session). `detectBackend` will pick
--- Wayland if WAYLAND_DISPLAY is set, even when no compositor is running.
+-- | Try to find a @wayland-*@ socket in the given runtime directory.
+discoverWaylandSocket :: FilePath -> IO (Maybe String)
+discoverWaylandSocket runtime = do
+  entries <- listDirectory runtime
+  let candidates =
+        [ e | e <- entries
+        , "wayland-" `isPrefixOf` e
+        , not (".lock" `isSuffixOf` e)
+        ]
+  go candidates
+  where
+    go [] = pure Nothing
+    go (c:cs) = do
+      ok <- doesPathExist (runtime </> c)
+      if ok then pure (Just c) else go cs
+
+-- | Try to find a Hyprland instance signature in @XDG_RUNTIME_DIR/hypr/@.
+discoverHyprlandSignature :: FilePath -> IO (Maybe String)
+discoverHyprlandSignature runtime = do
+  let hyprDir = runtime </> "hypr"
+  exists <- doesPathExist hyprDir
+  if not exists
+    then pure Nothing
+    else do
+      entries <- listDirectory hyprDir
+      go hyprDir entries
+  where
+    go _ [] = pure Nothing
+    go hyprDir (e:es) = do
+      isSig <- doesPathExist (hyprDir </> e </> "hyprland.lock")
+      if isSig then pure (Just e) else go hyprDir es
+
+-- Systemd --user's manager environment can be stale across logins.  It may
+-- carry a leftover WAYLAND_DISPLAY pointing at a dead socket, or conversely
+-- have WAYLAND_DISPLAY/HYPRLAND_INSTANCE_SIGNATURE completely absent while a
+-- compositor is actually running.
 --
--- Prefer a backend that's actually usable, and sanitize the process environment
--- so taffybar's internal context backend detection makes the same decision.
+-- This function discovers the real state, fixes up the process environment so
+-- taffybar's internal backend detection makes the same decision, and returns
+-- the appropriate backend.
 detectBackendRobust :: IO Backend
 detectBackendRobust = do
   mRuntime <- lookupEnv "XDG_RUNTIME_DIR"
-  mWaylandDisplay <- lookupEnv "WAYLAND_DISPLAY"
   mDisplay <- lookupEnv "DISPLAY"
   mSessionType <- lookupEnv "XDG_SESSION_TYPE"
-  mHyprSig <- lookupEnv "HYPRLAND_INSTANCE_SIGNATURE"
+
+  -- Discover and fix up WAYLAND_DISPLAY if it is missing or empty.
+  mWaylandDisplay <- do
+    raw <- lookupEnv "WAYLAND_DISPLAY"
+    case (mRuntime, raw) of
+      (Just runtime, val) | maybe True null val -> do
+        mSock <- discoverWaylandSocket runtime
+        case mSock of
+          Just sock -> do
+            logM "Main" INFO $ "Discovered wayland socket: " ++ sock
+            setEnv "WAYLAND_DISPLAY" sock
+            pure (Just sock)
+          Nothing -> pure raw
+      _ -> pure raw
+
+  -- Discover and fix up HYPRLAND_INSTANCE_SIGNATURE if it is missing or empty.
+  do
+    raw <- lookupEnv "HYPRLAND_INSTANCE_SIGNATURE"
+    case (mRuntime, raw) of
+      (Just runtime, val) | maybe True null val -> do
+        mSig <- discoverHyprlandSignature runtime
+        case mSig of
+          Just sig -> do
+            logM "Main" INFO $ "Discovered Hyprland signature: " ++ sig
+            setEnv "HYPRLAND_INSTANCE_SIGNATURE" sig
+          Nothing -> pure ()
+      _ -> pure ()
 
   let mWaylandPath = do
         runtime <- mRuntime
@@ -102,11 +161,16 @@ detectBackendRobust = do
           "WAYLAND_DISPLAY is set but no socket at " ++ wlPath ++ "; preferring X11 when available"
       pure ok
 
+  -- Clean up the environment when falling back to X11.
   when (not waylandOk && maybe False (not . null) mDisplay) $ do
-    when (isJust mWaylandDisplay) $ unsetEnv "WAYLAND_DISPLAY"
-    when (isJust mHyprSig) $ unsetEnv "HYPRLAND_INSTANCE_SIGNATURE"
+    unsetEnv "WAYLAND_DISPLAY"
+    unsetEnv "HYPRLAND_INSTANCE_SIGNATURE"
     when (mSessionType == Just "wayland") $ setEnv "XDG_SESSION_TYPE" "x11"
 
+  -- Fix XDG_SESSION_TYPE when selecting Wayland.
+  when (waylandOk && mSessionType /= Just "wayland") $
+    setEnv "XDG_SESSION_TYPE" "wayland"
+
   let x11Ok = maybe False (not . null) mDisplay
   if waylandOk
     then pure BackendWayland
@@ -416,10 +480,12 @@ mkSimpleTaffyConfig hostName backend cssFiles =
 
 main :: IO ()
 main = do
+  updateGlobalLogger rootLoggerName (setLevel INFO)
   enableLogger "Graphics.UI.GIGtkStrut" DEBUG
 
   hostName <- getHostName
   backend <- detectBackendRobust
+  logM "Main" INFO $ "Selected backend: " ++ show backend
   cssFiles <- mapM (getUserConfigFile "taffybar") (cssFilesForHost hostName)
 
   let simpleTaffyConfig = mkSimpleTaffyConfig hostName backend cssFiles