2 files changed, 127 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