From 1b0f62cc6799876b251501c3e96d6e296359ac96 Mon Sep 17 00:00:00 2001
From: Ivan Malison <IvanMalison@gmail.com>
Date: Tue, 12 Sep 2017 01:58:47 -0700
Subject: [PATCH] [taffybar] Set icons for workspaces

---
 .../config/taffybar/imalison-taffybar.cabal   |  1 +
 dotfiles/config/taffybar/taffybar             |  2 +-
 dotfiles/config/taffybar/taffybar.hs          | 39 ++++++++++++++++---
 3 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/dotfiles/config/taffybar/imalison-taffybar.cabal b/dotfiles/config/taffybar/imalison-taffybar.cabal
index dcb63a9e..f9016ab7 100644
--- a/dotfiles/config/taffybar/imalison-taffybar.cabal
+++ b/dotfiles/config/taffybar/imalison-taffybar.cabal
@@ -20,6 +20,7 @@ executable imalison-taffybar
                      , filepath
                      , gtk
                      , gtk-traymanager>=0.1.6
+                     , mtl
                      , process
                      , split
                      , taffybar
diff --git a/dotfiles/config/taffybar/taffybar b/dotfiles/config/taffybar/taffybar
index e7a5d009..3f64d6da 160000
--- a/dotfiles/config/taffybar/taffybar
+++ b/dotfiles/config/taffybar/taffybar
@@ -1 +1 @@
-Subproject commit e7a5d0092d823003880dc8337a931eeeb93555a9
+Subproject commit 3f64d6da4d2e01ce659540a1a3ef291e5a89848d
diff --git a/dotfiles/config/taffybar/taffybar.hs b/dotfiles/config/taffybar/taffybar.hs
index 231a7ec7..45c5c29c 100644
--- a/dotfiles/config/taffybar/taffybar.hs
+++ b/dotfiles/config/taffybar/taffybar.hs
@@ -3,6 +3,7 @@ module Main where
 import qualified Control.Concurrent.MVar as MV
 import           Control.Exception.Base
 import           Control.Monad
+import           Control.Monad.Reader
 import           Data.List
 import           Data.List.Split
 import qualified Data.Map as M
@@ -19,6 +20,7 @@ import           System.Information.Memory
 import           System.Information.X11DesktopInfo
 import           System.Process
 import           System.Taffybar
+import           System.Taffybar.IconImages
 import           System.Taffybar.LayoutSwitcher
 import           System.Taffybar.MPRIS2
 import           System.Taffybar.NetMonitor
@@ -30,8 +32,13 @@ import           System.Taffybar.Widgets.PollingGraph
 import           System.Taffybar.WindowSwitcher
 import           System.Taffybar.WorkspaceHUD
 import           Text.Printf
-import           Text.Read hiding (get)
+import           Text.Read hiding (get, lift)
 
+data ConstantIconController = ConstantIconController { cicImage :: Gtk.Image }
+
+instance WorkspaceWidgetController ConstantIconController where
+  updateWidget cic _ = return cic
+  getWidget = Gtk.toWidget . cicImage
 
 memCfg =
   defaultGraphConfig
@@ -114,11 +121,12 @@ myFormatEntry wsNames ((ws, wtitle, wclass), _) =
     wsName = M.findWithDefault ("WS#" ++ show wsN) ws wsNames
     WSIdx wsN = ws
 
-
 getInterfaces = do
   (_, output, _) <- readCreateProcessWithExitCode (shell "list_interfaces.sh") ""
   return $ splitOn "\n" output
 
+swapMaybeIO = maybe (return Nothing) (Just <$>)
+
 main = do
   monEither <-
     (try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String)
@@ -126,6 +134,22 @@ main = do
   homeDirectory <- getHomeDirectory
   let resourcesDirectory = homeDirectory </> ".lib" </> "resources"
       inResourcesDirectory file = resourcesDirectory </> file
+      getWorkspacePixBuf size Workspace { workspaceIdx = WSIdx wsId } =
+        pixBufFromFile size . inResourcesDirectory <$>
+                       case wsId + 1 of
+                         1 -> Just "urxvt.png"
+                         2 -> Just "stack-overflow.png"
+                         3 -> Just "bookmark.png"
+                         4 -> Just "tv.png"
+                         _ -> Nothing
+      buildConstantIconController :: ControllerConstructor
+      buildConstantIconController ws = do
+         cfg <- asks hudConfig
+         lift $ do
+           img <- Gtk.imageNew
+           pb <- swapMaybeIO $ getWorkspacePixBuf (windowIconSize cfg) ws
+           setImage (windowIconSize cfg) img pb
+           return $ WWC ConstantIconController { cicImage = img }
       makeIcon = return . IIFilePath . inResourcesDirectory
       myGetIconInfo w@WindowData {windowTitle = title, windowClass = klass}
         | "URxvt" `isInfixOf` klass = makeIcon "urxvt.png"
@@ -163,7 +187,7 @@ main = do
         Gtk.widgetSetName theTray "Taffytray"
         Gtk.widgetShowAll cont
         return $ Gtk.toWidget cont
-      hudConfig =
+      myHUDConfig =
         defaultWorkspaceHUDConfig
         { underlineHeight = 3
         , underlinePadding = 2
@@ -172,7 +196,10 @@ main = do
         , getIconInfo = myGetIconInfo
         , windowIconSize = 25
         , widgetGap = 0
-        -- , widgetBuilder = buildBorderButtonController
+        , widgetBuilder = buildButtonController $
+                          buildUnderlineController $
+                          buildContentsController
+                          [buildConstantIconController, buildLabelController, buildIconController]
         , showWorkspaceFn = hideEmpty
         , updateRateLimitMicroseconds = 100000
         , updateIconsOnTitleChange = True
@@ -188,10 +215,10 @@ main = do
         defaultPagerConfig
         {useImages = True, windowSwitcherFormatter = myFormatEntry}
       -- pager = taffyPagerNew pagerConfig
-      makeUnderline = underlineWidget hudConfig
+      makeUnderline = underlineWidget myHUDConfig
   pgr <- pagerNew pagerConfig
   tray2 <- movableWidget tray
-  let hud = buildWorkspaceHUD hudConfig pgr
+  let hud = buildWorkspaceHUD myHUDConfig pgr
       los = makeUnderline (layoutSwitcherNew pgr) "red"
       wnd = makeUnderline (windowSwitcherNew pgr) "teal"
       taffyConfig =