From e4d9cc1c22ba36516d24902c7f0de52b1009570b Mon Sep 17 00:00:00 2001
From: Josh Rahm <rahm@google.com>
Date: Wed, 3 Nov 2021 13:17:54 -0600
Subject: Finally, after much wailing and gnashing of teeth, fixed the Xmobar
 layout icon issue!

---
 src/Internal/LayoutDraw.hs | 106 +++++++++++++++++++++++----------------------
 1 file changed, 54 insertions(+), 52 deletions(-)

(limited to 'src/Internal/LayoutDraw.hs')

diff --git a/src/Internal/LayoutDraw.hs b/src/Internal/LayoutDraw.hs
index 7c69a08..dedac0f 100644
--- a/src/Internal/LayoutDraw.hs
+++ b/src/Internal/LayoutDraw.hs
@@ -2,6 +2,8 @@
 ScopedTypeVariables, BangPatterns #-}
 module Internal.LayoutDraw where
 
+import System.IO
+
 import System.Process
 import Text.Printf
 import Control.Arrow
@@ -21,17 +23,17 @@ import System.Directory
 import Internal.Layout
 import Internal.Hash
 
-showLayout :: X (Maybe String)
+showLayout :: X (Bool, String, Maybe String)
 showLayout = do
     winset <- gets windowset
     let layout = S.layout . S.workspace . S.current $ winset
-    xpm <- drawPng layout
-    return $ Just $ printf "<icon=%s/>" xpm
+    (cached, xpm) <- drawPng layout
+    return $ (cached, description layout, Just $ printf "<icon=%s/>" xpm)
 
 iconSize :: (Num a) => (a, a)
 iconSize = (64, 32)
 
-drawPng :: (LayoutClass layout Window) => layout Window -> X String
+drawPng :: (LayoutClass layout Window) => layout Window -> X (Bool, String)
 drawPng l = do
     dir <- getXMonadDir
     let sixWindows = [1..(4 :: Window)]
@@ -45,54 +47,54 @@ drawPng l = do
     let descr = description l
     let pngCacheDir = dir </> "icons" </> "cache"
 
-    liftIO $ createDirectoryIfMissing True pngCacheDir
-    let testf = dir </> "text.txt"
-    let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
-    let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
-
-    let colors = [
-           -- (1.0, 1.0, 1.0),
-           -- (0.9, 0.9, 1.0),
-           -- (0.8, 0.8, 1.0),
-           -- (0.7, 0.7, 1.0),
-           (0.8, 0.6, 0.6),
-           (0.8, 0.5, 0.5),
-           (0.8, 0.4, 0.4),
-           (0.8, 0.3, 0.3),
-           (0.8, 0.2, 0.2),
-           (0.8, 0.1, 0.1),
-           (0.8, 0.0, 0.0)
-          ]
-
-    exists <- liftIO $ doesFileExist filepathXpm
-    when (not exists) $
-      liftIO $ do
-        withImageSurface FormatARGB32 64 32 $ \surface -> do
-            renderWith surface $ do
-              setLineCap LineCapButt
-              setLineJoin LineJoinMiter
-
-              forM_ (reverse $ zip (map (second extraPad) rects) colors) $
-                \((wind, Rectangle x y w h), (r, g, b)) -> do
-                  setSourceRGBA r g b 1
-
-                  rectangle
-                    (fromIntegral $ floor (fromIntegral x / 30.0))
-                    (fromIntegral $ floor (fromIntegral y / 30.0))
-                    (fromIntegral $ floor (fromIntegral w / 30.0))
-                    (fromIntegral $ floor (fromIntegral h / 30.0))
-
-                  fill
-
-            surfaceWriteToPNG surface filepathPng
-
-            out <- readProcessWithExitCode
-              "/usr/bin/convert"
-              [filepathPng, filepathXpm]
-              ""
-            return ()
-
-    return filepathXpm
+    liftIO $ do
+      createDirectoryIfMissing True pngCacheDir
+      let testf = dir </> "text.txt"
+      let filepathPng = pngCacheDir </> (quickHash descr ++ ".png")
+      let filepathXpm = pngCacheDir </> (quickHash descr ++ ".xpm")
+
+      let colors = [
+             -- (1.0, 1.0, 1.0),
+             -- (0.9, 0.9, 1.0),
+             -- (0.8, 0.8, 1.0),
+             -- (0.7, 0.7, 1.0),
+             (0.8, 0.6, 0.6),
+             (0.8, 0.5, 0.5),
+             (0.8, 0.4, 0.4),
+             (0.8, 0.3, 0.3),
+             (0.8, 0.2, 0.2),
+             (0.8, 0.1, 0.1),
+             (0.8, 0.0, 0.0)
+            ]
+
+      exists <- doesFileExist filepathXpm
+      when (not exists) $ do
+          withImageSurface FormatARGB32 64 32 $ \surface -> do
+              renderWith surface $ do
+                setLineCap LineCapButt
+                setLineJoin LineJoinMiter
+
+                forM_ (reverse $ zip (map (second extraPad) rects) colors) $
+                  \((wind, Rectangle x y w h), (r, g, b)) -> do
+                    setSourceRGBA r g b 1
+
+                    rectangle
+                      (fromIntegral $ floor (fromIntegral x / 30.0))
+                      (fromIntegral $ floor (fromIntegral y / 30.0))
+                      (fromIntegral $ floor (fromIntegral w / 30.0))
+                      (fromIntegral $ floor (fromIntegral h / 30.0))
+
+                    fill
+
+              surfaceWriteToPNG surface filepathPng
+
+              _ <- handle (\(e :: SomeException) -> return ()) $ void $ readProcessWithExitCode
+                     "/usr/bin/convert"
+                     [filepathPng, filepathXpm]
+                     ""
+              return ()
+
+      return (exists, filepathXpm)
     where
       extraPad (Rectangle x y w h) =
         Rectangle (x + 100) (y + 100) (w - 100) (h - 100)
-- 
cgit