diff options
| -rw-r--r-- | src/Xmobar/Plugins/PacmanUpdates.hs | 139 | ||||
| -rw-r--r-- | src/Xmobar/Run/Types.hs | 5 | ||||
| -rw-r--r-- | xmobar.cabal | 1 |
3 files changed, 128 insertions, 17 deletions
diff --git a/src/Xmobar/Plugins/PacmanUpdates.hs b/src/Xmobar/Plugins/PacmanUpdates.hs index 1e8a8fc..ad6d2c9 100644 --- a/src/Xmobar/Plugins/PacmanUpdates.hs +++ b/src/Xmobar/Plugins/PacmanUpdates.hs @@ -1,4 +1,9 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- @@ -14,30 +19,132 @@ Maintainer : Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com> Stability : unstable Portability : unportable -A Pacman updates availablility plugin for Xmobar +A Pacman updates availablility plugin for Xmobar. -} -module Xmobar.Plugins.PacmanUpdates (PacmanUpdates (..)) where +module Xmobar.Plugins.PacmanUpdates ( + {-# DEPRECATED "These type and constructor are DEPRECATED;\ + please use `PacmanUpdates` type and `PacmanUpdatesK`\ + and `PacmanUpdatesNoK` constructors" #-} + PacmanUpdatesDeprecated(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 -data PacmanUpdates = PacmanUpdates (String, String, String, String) Rate +-- | Deprecated plugin type. +data PacmanUpdatesDeprecated + = PacmanUpdates (String, String, String, String) -- ^ strings 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 deriving (Read, Show) -instance Exec PacmanUpdates where +instance Exec PacmanUpdatesDeprecated where alias = const "pacman" rate (PacmanUpdates _ r) = r - run (PacmanUpdates (z, o, m, e) _) = do - (exit, stdout, _) <- readProcessWithExitCode "checkupdates" [] "" - return $ case exit of - ExitFailure 2 -> z -- ero updates - ExitFailure 1 -> e - 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" + run (PacmanUpdates (z, o, m, e) r) + = Xmobar.Run.Exec.run (Make @False r undefined printer) + where 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/723`>" + ++ "deprecated plugin, click here</action>)</fc>" + +-- | 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." diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs index 6b51b2d..e5c2e76 100644 --- a/src/Xmobar/Run/Types.hs +++ b/src/Xmobar/Run/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators, CPP #-} +{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Types @@ -60,7 +61,9 @@ infixr :*: runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: - PacmanUpdates :*: + PacmanUpdatesDeprecated :*: + PacmanUpdates False :*: + PacmanUpdates True :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/xmobar.cabal b/xmobar.cabal index 4d4cb8d..ff8bc59 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -220,6 +220,7 @@ library transformers, unix, utf8-string >= 0.3 && < 1.1, + vector, X11 >= 1.6.1 if impl(ghc < 8.0.2) |