summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-rw-r--r--src/Xmobar/Plugins/Accordion.hs97
-rw-r--r--src/Xmobar/Plugins/ArchUpdates.hs41
-rw-r--r--src/Xmobar/Run/Types.hs2
3 files changed, 140 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'
diff --git a/src/Xmobar/Plugins/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs
new file mode 100644
index 0000000..f803d0f
--- /dev/null
+++ b/src/Xmobar/Plugins/ArchUpdates.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE CPP #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.ArchUpdates
+-- 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
+--
+-- An ArchLinux updates availablility plugin for Xmobar
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.ArchUpdates (ArchUpdates(..)) where
+
+import System.Exit (ExitCode(..))
+import System.Process (readProcessWithExitCode)
+import Xmobar.Run.Exec
+import Xmobar.Plugins.Command (Rate)
+
+data ArchUpdates = ArchUpdates (String, String, String) Rate
+ deriving (Read, Show)
+
+instance Exec ArchUpdates where
+ alias (ArchUpdates _ _) = "arch"
+ rate (ArchUpdates _ r) = r
+ run (ArchUpdates (z, o, m) _) = do
+ (exit, stdout, _) <- readProcessWithExitCode "checkupdates" [] ""
+ return $ case exit of
+ ExitFailure 2 -> z--ero updates
+ ExitFailure 1 -> "pacman: Unknown cause of failure."
+ ExitSuccess -> case length $ lines stdout of
+ 0 -> impossible
+ 1 -> o
+ n -> m >>= \c -> if c == '?' then show n else pure c
+ _ -> impossible
+ where
+ impossible = error "This is impossible based on pacman manpage"
diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs
index 69406bb..bb573c8 100644
--- a/src/Xmobar/Run/Types.hs
+++ b/src/Xmobar/Run/Types.hs
@@ -19,6 +19,7 @@
module Xmobar.Run.Types(runnableTypes) where
import {-# SOURCE #-} Xmobar.Run.Runnable()
+import Xmobar.Plugins.ArchUpdates
import Xmobar.Plugins.Command
import Xmobar.Plugins.Monitors
import Xmobar.Plugins.Date
@@ -59,6 +60,7 @@ infixr :*:
runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*:
BufferedPipeReader :*: CommandReader :*: StdinReader :*:
XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*:
+ ArchUpdates :*:
#ifdef INOTIFY
Mail :*: MBox :*:
#endif