summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Plugins/Accordion.hs97
1 files changed, 97 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs
new file mode 100644
index 0000000..6377928
--- /dev/null
+++ b/src/Xmobar/Plugins/Accordion.hs
@@ -0,0 +1,97 @@
+{-# LANGUAGE TupleSections, FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.Accordion
+-- Copyright : (c) 2024 Enrico Maria De Angelis
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A plugin to group adjacent plugins and make them, as a whole, shrinkable to
+-- an alternate text upon clicking.
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, Tuning(..)) where
+
+import Control.Concurrent.Async (withAsync)
+import Control.Exception (finally)
+import Control.Monad (forever, join, when)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Reader (runReaderT, ask)
+import Control.Monad.State.Strict (evalStateT, get, modify')
+import Data.IORef (atomicModifyIORef', newIORef, readIORef)
+import Data.Maybe (isJust)
+import System.Directory (removeFile)
+import System.Exit (ExitCode(..))
+import System.Process (readProcessWithExitCode)
+import Xmobar.Run.Exec (Exec(..), tenthSeconds)
+
+-- TODO: Ideally, I'd have just `Accordion`, and not `Tuning`, but since
+-- `Accordion` is polymorphic, I can't have a `defaultAccordion` constructor
+-- with `plugins = []`, because that leaves `a` undetermined.
+-- So I have move all non-polymorphic typed members in `Tuning`, allowing for
+-- default values at least for those members.
+data Accordion a = Accordion {
+ tuning :: Tuning
+ , plugins :: [a]
+} deriving (Show, Read)
+
+makeAccordion :: Exec a => Tuning -> [a] -> Accordion a
+makeAccordion t rs = Accordion { tuning = t, plugins = rs }
+
+data Tuning = Tuning {
+ alias' :: String
+ , initial :: Bool
+ , expand :: String
+ , shrink :: String
+} deriving (Read, Show)
+
+defaultTuning :: Tuning
+defaultTuning = Tuning {
+ alias' = "accordion"
+ , initial = True
+ , expand = "<>"
+ , shrink = "><"
+}
+
+instance (Exec a, Read a, Show a) => Exec (Accordion a) where
+ alias (Accordion Tuning { alias' = name } _) = name
+ start (Accordion Tuning { initial = initial'
+ , expand = expand'
+ , shrink = shrink' }
+ runnables)
+ cb = do
+ clicked <- newIORef Nothing
+ (_, n, _) <- readProcessWithExitCode "uuidgen" [] ""
+ let pipe = "/tmp/accordion-" ++ removeLinebreak n
+ (_, _, _) <- readProcessWithExitCode "mkfifo" [pipe] ""
+ withAsync (forever $ do (ret, _, _) <- readProcessWithExitCode "cat" [pipe] ""
+ case ret of
+ ExitSuccess -> atomicModifyIORef' clicked (const (Just (), ()))
+ ExitFailure _ -> error "how is this possible?")
+ (const $ do
+ srefs <- mapM (newIORef . const "") runnables
+ foldr (\(runnable, sref) acc -> withAsync (start runnable (writeToRef sref)) (const acc))
+ (forever (do liftIO (tenthSeconds 1)
+ clicked' <- liftIO $ readIORef clicked
+ when (isJust clicked')
+ (do liftIO $ clear clicked
+ modify' not)
+ b <- get
+ if b then loop pipe else liftIO $ cb (click pipe expand'))
+ `runReaderT` srefs `evalStateT` initial')
+ (zip runnables srefs))
+ `finally` removeFile pipe
+ where
+ click file icon = "<action=`echo 1 > " ++ file ++ "`>" ++ icon ++ "</action>"
+ clear = (`atomicModifyIORef'` const (Nothing, ()))
+ removeLinebreak = init
+ writeToRef strRef = atomicModifyIORef' strRef . const . (,())
+ loop p = do
+ srefs <- ask
+ text <- join <$> mapM (liftIO . readIORef) srefs
+ liftIO $ cb $ text ++ click p shrink'