summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r--src/Xmobar/Plugins/Accordion.hs99
-rw-r--r--src/Xmobar/Plugins/ArchUpdates.hs41
-rw-r--r--src/Xmobar/Plugins/EWMH.hs2
-rw-r--r--src/Xmobar/Plugins/MarqueePipeReader.hs2
-rw-r--r--src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc2
-rw-r--r--src/Xmobar/Plugins/Monitors/MPD.hs5
-rw-r--r--src/Xmobar/Plugins/Monitors/Mpris.hs10
-rw-r--r--src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc5
-rw-r--r--src/Xmobar/Plugins/Monitors/Top.hs6
-rw-r--r--src/Xmobar/Plugins/PacmanUpdates.hs149
10 files changed, 222 insertions, 99 deletions
diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs
index 6377928..ce15cee 100644
--- a/src/Xmobar/Plugins/Accordion.hs
+++ b/src/Xmobar/Plugins/Accordion.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE TupleSections, FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
@@ -15,18 +16,19 @@
--
-----------------------------------------------------------------------------
-module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, Tuning(..)) where
+module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where
-import Control.Concurrent.Async (withAsync)
+import Control.Concurrent.Async (concurrently_, mapConcurrently_)
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 Control.Monad.Extra (whenM)
+import Control.Monad (forever, join)
+import Control.Monad.IO.Class (liftIO, MonadIO)
+import Control.Monad.Reader (MonadReader, runReaderT, ask)
+import Control.Monad.State.Strict (MonadState, evalStateT, get, modify')
+import Data.IORef (atomicModifyIORef', newIORef, readIORef, IORef)
+import GHC.IO.Handle.FD (withFileBlocking)
import System.Directory (removeFile)
-import System.Exit (ExitCode(..))
+import System.IO (IOMode(ReadMode), hGetContents')
import System.Process (readProcessWithExitCode)
import Xmobar.Run.Exec (Exec(..), tenthSeconds)
@@ -38,10 +40,14 @@ import Xmobar.Run.Exec (Exec(..), tenthSeconds)
data Accordion a = Accordion {
tuning :: Tuning
, plugins :: [a]
+ , shortPlugins :: [a]
} deriving (Show, Read)
makeAccordion :: Exec a => Tuning -> [a] -> Accordion a
-makeAccordion t rs = Accordion { tuning = t, plugins = rs }
+makeAccordion t rs = Accordion { tuning = t, plugins = rs, shortPlugins = [] }
+
+makeAccordion' :: Exec a => Tuning -> [a] -> [a] -> Accordion a
+makeAccordion' t rs rs' = Accordion { tuning = t, plugins = rs, shortPlugins = rs' }
data Tuning = Tuning {
alias' :: String
@@ -58,40 +64,49 @@ defaultTuning = Tuning {
, 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
+instance Exec a => Exec (Accordion a) where
+ alias (Accordion Tuning{..} _ _) = alias'
+ start (Accordion Tuning{..} runnables shortRunnables) cb = do
+ clicked <- newIORef False
(_, 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))
+ concurrently_ (forever $ do "" <- withFileBlocking pipe ReadMode hGetContents'
+ atomicModifyIORef' clicked (const (True, ())))
+ (do
+ strRefs <- mapM (newIORef . const "") runnables
+ strRefs' <- mapM (newIORef . const "") shortRunnables
+ let processClick = forever (do liftIO (tenthSeconds 1)
+ whenM (liftIO $ readIORef clicked)
+ (do liftIO $ clear clicked
+ modify' not)
+ get >>= loop pipe)
+ `runReaderT` (strRefs, strRefs')
+ `evalStateT` initial
+ let startRunnables = zipWith start
+ (runnables ++ shortRunnables)
+ (map writeToRef $ strRefs ++ strRefs')
+ parallel_ $ processClick:startRunnables)
`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'
+ loop :: (MonadIO m,
+ MonadState Bool m,
+ MonadReader ([IORef String], [IORef String]) m)
+ => String -> Bool -> m ()
+ loop pipe bool = do
+ (strRefs, strRefs') <- ask
+ text <- join <$> mapM (liftIO . readIORef) (if bool then strRefs else strRefs')
+ liftIO $ cb $ text ++ attachClick pipe (if bool then shrink else expand)
+ parallel_ = mapConcurrently_ id
+
+writeToRef :: IORef a -> a -> IO ()
+writeToRef strRef = atomicModifyIORef' strRef . const . (,())
+
+clear :: IORef Bool -> IO ()
+clear = (`atomicModifyIORef'` const (False, ()))
+
+removeLinebreak :: [a] -> [a]
+removeLinebreak = init
+
+attachClick :: String -> String -> String
+attachClick file icon = "<action=`echo -n > " ++ file ++ "`>" ++ icon ++ "</action>"
diff --git a/src/Xmobar/Plugins/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs
deleted file mode 100644
index f803d0f..0000000
--- a/src/Xmobar/Plugins/ArchUpdates.hs
+++ /dev/null
@@ -1,41 +0,0 @@
-{-# 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/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs
index 78f1cc0..9b583ea 100644
--- a/src/Xmobar/Plugins/EWMH.hs
+++ b/src/Xmobar/Plugins/EWMH.hs
@@ -232,7 +232,7 @@ updateClientList _ = do
where
unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0
listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask
- update w = mapM_ (($ w) . snd) clientHandlers
+ update w = mapM_ (`snd` w) clientHandlers
modifyClient :: Window -> (Client -> Client) -> M ()
modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s })
diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs
index 075503c..a6d590e 100644
--- a/src/Xmobar/Plugins/MarqueePipeReader.hs
+++ b/src/Xmobar/Plugins/MarqueePipeReader.hs
@@ -60,7 +60,7 @@ writer txt sep len rate chan cb = do
Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb
toInfTxt :: String -> String -> String
-toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ")
+toInfTxt line sep = cycle (line ++ " " ++ sep ++ " ")
checkPipe :: FilePath -> IO ()
checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do
diff --git a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc
index 296ba6c..b5530f1 100644
--- a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc
+++ b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc
@@ -39,7 +39,7 @@ import Xmobar.Plugins.Monitors.Disk.Common (
, Path
)
-import qualified Control.Exception.Extensible as E
+import qualified Control.Exception as E
import qualified Data.List as DL
import qualified Data.Map as DM
import qualified Data.Set as DS
diff --git a/src/Xmobar/Plugins/Monitors/MPD.hs b/src/Xmobar/Plugins/Monitors/MPD.hs
index 7ecbc0c..b091147 100644
--- a/src/Xmobar/Plugins/Monitors/MPD.hs
+++ b/src/Xmobar/Plugins/Monitors/MPD.hs
@@ -109,8 +109,9 @@ parseMPD (Right st) song opts = do
si = stateGlyph s opts
vol = int2str $ fromMaybe 0 (M.stVolume st)
(p, t) = fromMaybe (0, 0) (M.stTime st)
- [lap, len, remain] = map showTime
- [floor p, floor t, max 0 (floor t - floor p)]
+ lap = showTime $ floor p
+ len = showTime $ floor t
+ remain = showTime $ max 0 (floor t - floor p)
b = if t > 0 then realToFrac $ p / t else 0
plen = int2str $ M.stPlaylistLength st
ppos = maybe "" (int2str . (+1)) $ M.stSongPos st
diff --git a/src/Xmobar/Plugins/Monitors/Mpris.hs b/src/Xmobar/Plugins/Monitors/Mpris.hs
index ee30ad3..eb9595b 100644
--- a/src/Xmobar/Plugins/Monitors/Mpris.hs
+++ b/src/Xmobar/Plugins/Monitors/Mpris.hs
@@ -28,7 +28,7 @@ import qualified DBus.Client as DC
import Control.Arrow ((***))
import Data.Maybe ( fromJust )
import Data.Int ( Int32, Int64 )
-import Data.Word ( Word32 )
+import Data.Word ( Word32, Word64 )
import System.IO.Unsafe ( unsafePerformIO )
import Control.Exception (try)
@@ -136,17 +136,17 @@ makeList version md = map getStr (fieldsList version) where
"xesam:trackNumber" -> printf "%02d" num
_ -> (show::Int32 -> String) num
pw32 v = printf "%02d" (fromVar v::Word32)
- plen str v = let num = fromVar v in
- case str of
+ plen str num = case str of
"mpris:length" -> formatTime (num `div` 1000000)
- _ -> (show::Int64 -> String) num
+ _ -> show num
getStr str = case lookup str md of
Nothing -> ""
Just v -> case variantType v of
TypeString -> fromVar v
TypeInt32 -> pInt str v
TypeWord32 -> pw32 v
- TypeInt64 -> plen str v
+ TypeWord64 -> plen str (fromVar v :: Word64)
+ TypeInt64 -> plen str (fromVar v :: Int64)
TypeArray TypeString ->
let x = arrayItems (fromVar v) in
if null x then "" else fromVar (head x)
diff --git a/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc
index 9c74e36..90c58c1 100644
--- a/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc
+++ b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc
@@ -71,11 +71,10 @@ instance Storable SwapData where
poke _ _ = pure ()
-
isEnabled :: IO Bool
isEnabled = do
- enabled <- sysctlReadUInt "vm.swap_enabled"
- return $ enabled == 1
+ nswapdev <- sysctlReadUInt "vm.nswapdev"
+ return $ nswapdev > 0
parseMEM' :: Bool -> IO [Float]
parseMEM' False = return []
diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs
index 3bfe6fd..b2e573b 100644
--- a/src/Xmobar/Plugins/Monitors/Top.hs
+++ b/src/Xmobar/Plugins/Monitors/Top.hs
@@ -3,7 +3,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Top
--- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022 Jose A Ortega Ruiz
+-- Copyright : (c) 2010-2014, 2018, 2022, 2025 Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
@@ -20,7 +20,7 @@ import Xmobar.Plugins.Monitors.Common
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (sortBy)
-import Data.Ord (comparing)
+import Data.Ord (comparing, Down (..))
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import Xmobar.Plugins.Monitors.Top.Common (
@@ -66,7 +66,7 @@ showInfo nm sms mms = do
sortTop :: [(String, Float)] -> [(String, Float)]
-sortTop = sortBy (flip (comparing snd))
+sortTop = sortBy (comparing (Down . snd))
showMemInfo :: Float -> MemInfo -> Monitor [String]
showMemInfo scale (nm, rss) =
diff --git a/src/Xmobar/Plugins/PacmanUpdates.hs b/src/Xmobar/Plugins/PacmanUpdates.hs
new file mode 100644
index 0000000..03b556f
--- /dev/null
+++ b/src/Xmobar/Plugins/PacmanUpdates.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeFamilyDependencies #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE ViewPatterns #-}
+
+-----------------------------------------------------------------------------
+
+-----------------------------------------------------------------------------
+
+{- |
+Module : Plugins.Monitors.PacmanUpdates
+Copyright : (c) 2024, 2026 Enrico Maria De Angelis
+ , (c) 2025 Alexander Pankoff
+ , (c) 2026 Enrico Maria De Angelis
+License : BSD-style (see LICENSE)
+
+Maintainer : Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com>
+Stability : unstable
+Portability : unportable
+
+A Pacman updates availablility plugin for Xmobar. It also informs whether a kernel update is
+available (provided the name of the kernel package), and whether the running kernel is older
+than the installed one.
+-}
+module Xmobar.Plugins.PacmanUpdates (
+ {-# DEPRECATED "This ctor is DEPRECATED; please use `PacmanUpdates` type and `PacmanUpdatesK` and `PacmanUpdatesNoK` constructors instead." #-}
+ pattern PacmanUpdates
+ , PacmanUpdates ()
+ , pattern PacmanUpdatesK
+ , pattern PacmanUpdatesNoK) where
+
+import System.Exit (ExitCode (..))
+import System.Process (readProcessWithExitCode)
+import Xmobar.Plugins.Command (Rate)
+import Xmobar.Run.Exec
+import Data.Tuple.Extra (fst3)
+import Data.Kind (Type)
+import Data.Functor ((<&>))
+import Data.Void (Void)
+import Control.Arrow ((&&&))
+import qualified Data.Vector as V
+
+-- | Deprecated plugin ctor (will be deleted in 2027).
+-- Use `PacmanUpdatesK` or `PacmanUpdatesNoK` instead.
+pattern PacmanUpdates :: (String, String, String, String) -- ^ `String`s to be shown for 0, 1, ≥ 2 updates,
+ -- and for error respectively (in the 3rd string, for
+ -- ≥ 2 updates, any occurrence of the '?' character
+ -- is a placeholder for the number of available updates).
+ -> Rate -- ^ `Rate` of update (see [Xmobar doc](https://codeberg.org/xmobar/xmobar/src/commit/39fd70308c3aef5402abe7152ade76ff7bb331bb/src/Xmobar/Plugins/Command.hs#L34)).
+ -> PacmanUpdates False
+pattern PacmanUpdates irrelevant <- (error "PacmanUpdates: PacmanUpdates is a build-only pattern synonym (a ctor synonym)." -> irrelevant)
+ where PacmanUpdates zome r
+ = let (z, o, m, e) = zome
+ printer = const
+ $ (++ deprecationNote)
+ . \case Left _ -> e
+ Right 0 -> z
+ Right 1 -> o
+ Right n -> m >>= \c -> if c == '?'
+ then show n
+ else pure c
+ deprecationNote = " <fc=#ff0000>(<action=`xdg-open https://codeberg.org/xmobar/xmobar/pulls/765`>"
+ ++ "deprecated plugin, click here</action>)</fc>"
+ in PacmanUpdatesNoK r printer
+
+-- | PacmanUpdates plugin parametrized over `Bool` kind: if `True` the plugin
+-- will detect if there's pending update(s) for the kernel package; if `False`
+-- it wont.
+data PacmanUpdates (b :: Bool)
+ = Make -- ^ Constructor.
+ Rate -- ^ `Rate` of update (see [Xmobar doc](https://codeberg.org/xmobar/xmobar/src/commit/39fd70308c3aef5402abe7152ade76ff7bb331bb/src/Xmobar/Plugins/Command.hs#L34)).
+ (Arg b) -- ^ Optional further argument. See instances of `Updates`.
+ (Printer b) -- ^ Printer. See instances of `Updates` for its signature.
+
+instance Show (PacmanUpdates b) where
+ show = error "PacmanUpdates: Show instance is stub"
+
+instance Read (PacmanUpdates b) where
+ readsPrec = error "PacmanUpdates: Read instance is stub"
+
+instance Updates b => Exec (PacmanUpdates (b :: Bool)) where
+ alias = const "pacman"
+ rate (Make r _ _) = r
+ run = Xmobar.Plugins.PacmanUpdates.run'
+
+class Updates (b :: Bool) where
+ -- | See `Updates`'s instances.
+ type Arg b = (a :: Type) | a -> b
+ -- | See `Updates`'s instances.
+ type Printer b = (p :: Type) | p -> b
+ -- | This is the implementation of `Xmobar.Run.Exec.run`.
+ run' :: PacmanUpdates b -> IO String
+
+-- | No additional argument required for constructing the plugin;
+-- the user-provided printer is fed with a `Bool` telling whether
+-- the system is running an outdated kernel, and an `Int` telling
+-- the number of available updates (or `Left` if an error occurred
+-- when calling `checkupdates`).
+instance Updates False where
+ type Arg False = Void
+ type Printer False = Bool -> Either String Int -> String
+ run' (Make _ _ printer)
+ = printer
+ <$> kernIsOld
+ <*> (fmap V.length <$> checkUpdates)
+
+-- | Constructing the plugin requires an additional `String` telling the name
+-- name of the kernel package; the user-provided printer is fed with a `Bool`
+-- telling whether the system is running an outdated kernel, and an `(Int,
+-- Bool)` pair telling the number of available updates and whether one of these
+-- is a kernel update (or `Left` if an error occurred when calling
+-- `checkupdates`).
+instance Updates True where
+ type Arg True = String
+ type Printer True = Bool -> Either String (Int, Bool) -> String
+ run' (Make _ kernName printer)
+ = printer
+ <$> kernIsOld
+ <*> (fmap (V.length &&& elem kernName) <$> checkUpdates)
+
+-- | Pattern synonym used to construct a `PacmanUpdates True`.
+pattern PacmanUpdatesK :: Rate -> Arg True -> Printer True -> PacmanUpdates True
+pattern PacmanUpdatesK r a p = Make r a p
+
+-- | Pattern synonym used to construct a `PacmanUpdates False`.
+pattern PacmanUpdatesNoK :: Rate -> Printer False -> PacmanUpdates False
+pattern PacmanUpdatesNoK r p <- Make r _ p
+ where PacmanUpdatesNoK r p = Make r undefined p
+
+checkUpdates :: IO (Either String (V.Vector String))
+checkUpdates = readProcessWithExitCode "checkupdates" [] ""
+ <&> \case (ExitFailure 2, "", "") -> Right V.empty
+ (ExitSuccess, stdout, "")
+ -> let pkgName = takeWhile (/= ' ')
+ pkgs = V.fromList $ fmap pkgName $ lines stdout
+ in case V.length pkgs of
+ 0 -> impossible
+ _ -> Right pkgs
+ (ExitFailure 1, _, _) -> Left "checkupdates: unknown cause of failure."
+ _ -> impossible
+
+kernIsOld :: IO Bool
+kernIsOld = (/= ExitSuccess) . exitCode <$> readProcessWithExitCode "modinfo" ["-n", "i915"] ""
+ where exitCode = fst3
+
+impossible :: a
+impossible = error "This is impossible, according to my knowledge."
generated by cgit v1.2.3 (git 2.46.0) at 2026-05-23 18:15:44 +0000