diff --git a/dotfiles/config/taffybar/lib/ToggleMonitor.hs b/dotfiles/config/taffybar/lib/ToggleMonitor.hs new file mode 100644 index 00000000..14d8cf96 --- /dev/null +++ b/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 diff --git a/dotfiles/config/taffybar/taffybar.hs b/dotfiles/config/taffybar/taffybar.hs index 14c4118a..67081f61 100644 --- a/dotfiles/config/taffybar/taffybar.hs +++ b/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