[taffybar] Add ability to toggle monitor on which bars appear

dotfiles/config/taffybar/lib/ToggleMonitor.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+module ToggleMonitor (
+  handleToggleRequests,
+  toggleableMonitors
+) where
+
+import           Control.Concurrent
+import qualified Control.Concurrent.MVar as MV
+import           Control.Monad
+import           Control.Monad.Trans
+import qualified Data.Map as M
+import           Data.Maybe
+import           System.Taffybar
+import           Text.Read hiding (get)
+import           Web.Scotty
+import           XMonad.Core ( whenJust )
+
+toggleableMonitors :: MV.MVar (M.Map Int Bool) -> Int -> TaffybarConfig -> IO (Maybe TaffybarConfig)
+toggleableMonitors enabledVar monNumber cfg = do
+  numToEnabled <- MV.readMVar enabledVar
+  let enabled = fromMaybe True $ M.lookup monNumber numToEnabled
+  return $ if enabled then Nothing else Just cfg
+
+handleToggleRequests :: MV.MVar (M.Map Int Bool) -> IO () -> IO ()
+handleToggleRequests enabledVar refreshTaffyWindows = do
+  let toggleTaffyOnMon fn mon = do
+        MV.modifyMVar_ enabledVar $ \numToEnabled -> do
+          let current = fromMaybe False $ M.lookup mon numToEnabled
+          return $ M.insert mon (fn current) numToEnabled
+        refreshTaffyWindows
+      runScotty =
+        scotty 3000 $ do
+          get "/toggle/:monNum" $ do
+            num <- param "monNum"
+            liftIO $
+              whenJust (readMaybe num :: Maybe Int) $ toggleTaffyOnMon not
+          get "on/:monNum" $ do
+            num <- param "monNum"
+            liftIO $
+              whenJust (readMaybe num :: Maybe Int) $
+              toggleTaffyOnMon $ const True
+          get "off/:monNum" $ do
+            num <- param "monNum"
+            liftIO $
+              whenJust (readMaybe num :: Maybe Int) $
+              toggleTaffyOnMon $ const False
+  void $ forkIO runScotty

dotfiles/config/taffybar/taffybar.hs

@@ -1,8 +1,7 @@
-module Main where
+import qualified Control.Concurrent.MVar as MV
-
 import           Control.Exception.Base
 import           Data.List
-import           Data.Maybe
+import qualified Data.Map as M
 import qualified Graphics.UI.Gtk as Gtk
 import qualified Graphics.UI.Gtk.Abstract.Widget as W
 import qualified Graphics.UI.Gtk.Layout.Table as T
@@ -22,7 +21,9 @@ import           System.Taffybar.Widgets.PollingGraph
 import           System.Taffybar.WindowSwitcher
 import           System.Taffybar.WorkspaceHUD
 import           Text.Printf
-import           Text.Read
+import           Text.Read hiding (get)
+import           ToggleMonitor
+
 
 memCallback = do
   mi <- parseMeminfo
@@ -53,7 +54,7 @@ main = do
     (try $ getEnv "TAFFYBAR_MONITOR") :: IO (Either SomeException String)
   homeDirectory <- getHomeDirectory
   let resourcesDirectory file =
-        (homeDirectory </> ".lib" </> "resources" </> file)
+        homeDirectory </> ".lib" </> "resources" </> file
       fallbackIcons _ klass
         | "URxvt" `isInfixOf` klass =
           IIFilePath $ resourcesDirectory "urxvt.png"
@@ -109,6 +110,7 @@ main = do
       pager = taffyPagerNew pagerConfig
       makeUnderline = underlineWidget hudConfig
   pgr <- pagerNew pagerConfig
+  enabledVar <- MV.newMVar M.empty
   let hud = buildWorkspaceHUD hudConfig pgr
       los = makeUnderline (layoutSwitcherNew pgr) "red"
       wnd = makeUnderline (windowSwitcherNew pgr) "teal"
@@ -124,10 +126,11 @@ main = do
             , makeUnderline mpris "red"
             ]
         , monitorNumber = monNumber
-        , getMonitorConfig = monFilter
         , barPosition = Top
         , barHeight = 50
         , widgetSpacing = 5
+        , startRefresher = Nothing -- Just $ handleToggleRequests enabledVar
+        , getMonitorConfig = Just $ toggleableMonitors enabledVar
         }
 
   defaultTaffybar taffyConfig