{-# 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 (
#if __GLASGOW_HASKELL__ >= 908
    {-# DEPRECATED "This ctor is DEPRECATED; please use `PacmanUpdates` type and `PacmanUpdatesK`, `PacmanUpdatesPredicateK` and `PacmanUpdatesNoK` constructors instead." #-}
#endif
    pattern PacmanUpdates
  , PacmanUpdates ()
  , PacmanUpdatesKernelCheck (..)
  , pattern PacmanUpdatesK
  , pattern PacmanUpdatesPredicateK
  , 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`, `PacmanUpdatesPredicateK`, 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 NoKernelCheck
pattern $bPacmanUpdates :: (String, String, String, String)
-> Int -> PacmanUpdates 'NoKernelCheck
$mPacmanUpdates :: forall {r}.
(Int -> PacmanUpdates 'NoKernelCheck)
-> ((String, String, String, String) -> r) -> ((# #) -> r) -> r
PacmanUpdates irrelevant <- (error "PacmanUpdates: PacmanUpdates is a build-only pattern synonym (a ctor synonym)." -> irrelevant)
  where PacmanUpdates (String, String, String, String)
zome Int
r
          = let (String
z, String
o, String
m, String
e) = (String, String, String, String)
zome
                printer :: Bool -> Either String Int -> String
printer = (Either String Int -> String)
-> Bool -> Either String Int -> String
forall a b. a -> b -> a
const
                        ((Either String Int -> String)
 -> Bool -> Either String Int -> String)
-> (Either String Int -> String)
-> Bool
-> Either String Int
-> String
forall a b. (a -> b) -> a -> b
$ (String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
deprecationNote)
                        (String -> String)
-> (Either String Int -> String) -> Either String Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case Left String
_ -> String
e
                                Right Int
0 -> String
z
                                Right Int
1 -> String
o
                                Right Int
n -> String
m String -> (Char -> String) -> String
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'?'
                                                            then Int -> String
forall a. Show a => a -> String
show Int
n
                                                            else Char -> String
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
                deprecationNote :: String
deprecationNote = String
" <fc=#ff0000>(<action=`xdg-open https://codeberg.org/xmobar/xmobar/pulls/765`>"
                                 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"deprecated plugin, click here</action>)</fc>"
            in Int -> Printer 'NoKernelCheck -> PacmanUpdates 'NoKernelCheck
PacmanUpdatesNoK Int
r Printer 'NoKernelCheck
Bool -> Either String Int -> String
printer


-- | Different types of kernel checks.
data PacmanUpdatesKernelCheck = NoKernelCheck | PredicateKernelCheck

-- | PacmanUpdates plugin parametrized over the `PacmanUpdatesKernelCheck` kind.
data PacmanUpdates (b :: PacmanUpdatesKernelCheck)
  = 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 :: PacmanUpdates b -> String
show = String -> PacmanUpdates b -> String
forall a. HasCallStack => String -> a
error String
"PacmanUpdates: Show instance is stub"

instance Read (PacmanUpdates b) where
  readsPrec :: Int -> ReadS (PacmanUpdates b)
readsPrec = String -> Int -> ReadS (PacmanUpdates b)
forall a. HasCallStack => String -> a
error String
"PacmanUpdates: Read instance is stub"

instance Updates b => Exec (PacmanUpdates (b :: PacmanUpdatesKernelCheck)) where
  alias :: PacmanUpdates b -> String
alias = String -> PacmanUpdates b -> String
forall a b. a -> b -> a
const String
"pacman"
  rate :: PacmanUpdates b -> Int
rate (Make Int
r Arg b
_ Printer b
_) = Int
r
  run :: PacmanUpdates b -> IO String
run = PacmanUpdates b -> IO String
forall (b :: PacmanUpdatesKernelCheck).
Updates b =>
PacmanUpdates b -> IO String
Xmobar.Plugins.PacmanUpdates.run'

class Updates (b :: PacmanUpdatesKernelCheck) 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 NoKernelCheck where
  type Arg NoKernelCheck = Void
  type Printer NoKernelCheck = Bool -> Either String Int -> String
  run' :: PacmanUpdates 'NoKernelCheck -> IO String
run' (Make Int
_ Arg 'NoKernelCheck
_ Printer 'NoKernelCheck
printer)
      = Printer 'NoKernelCheck
Bool -> Either String Int -> String
printer
          (Bool -> Either String Int -> String)
-> IO Bool -> IO (Either String Int -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
kernIsOld
          IO (Either String Int -> String)
-> IO (Either String Int) -> IO String
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Vector String -> Int)
-> Either String (Vector String) -> Either String Int
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector String -> Int
forall a. Vector a -> Int
V.length (Either String (Vector String) -> Either String Int)
-> IO (Either String (Vector String)) -> IO (Either String Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either String (Vector String))
checkUpdates)

-- | Constructing the plugin requires an additional `String -> Bool` predicate
-- that receives each available package name and returns `True` for kernel
-- packages; 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 PredicateKernelCheck where
  type Arg PredicateKernelCheck = String -> Bool
  type Printer PredicateKernelCheck = Bool -> Either String (Int, Bool) -> String
  run' :: PacmanUpdates 'PredicateKernelCheck -> IO String
run' (Make Int
_ Arg 'PredicateKernelCheck
checkKern Printer 'PredicateKernelCheck
printer)
      = Printer 'PredicateKernelCheck
Bool -> Either String (Int, Bool) -> String
printer
          (Bool -> Either String (Int, Bool) -> String)
-> IO Bool -> IO (Either String (Int, Bool) -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
kernIsOld
          IO (Either String (Int, Bool) -> String)
-> IO (Either String (Int, Bool)) -> IO String
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Vector String -> (Int, Bool))
-> Either String (Vector String) -> Either String (Int, Bool)
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector String -> Int
forall a. Vector a -> Int
V.length (Vector String -> Int)
-> (Vector String -> Bool) -> Vector String -> (Int, Bool)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (String -> Bool) -> Vector String -> Bool
forall a. (a -> Bool) -> Vector a -> Bool
V.any Arg 'PredicateKernelCheck
String -> Bool
checkKern) (Either String (Vector String) -> Either String (Int, Bool))
-> IO (Either String (Vector String))
-> IO (Either String (Int, Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either String (Vector String))
checkUpdates)

-- | Pattern synonym to construct a `PacmanUpdates PredicateKernelCheck` that
-- detects updates for packages matched by the given @(String -> Bool)@
-- predicate. This can be used to detect kernel updates for distributions
-- with versioned kernel package names (e.g. Manjaro's @linux618@)
pattern PacmanUpdatesPredicateK :: Rate -> Arg PredicateKernelCheck -> Printer PredicateKernelCheck -> PacmanUpdates PredicateKernelCheck
pattern $bPacmanUpdatesPredicateK :: Int
-> Arg 'PredicateKernelCheck
-> Printer 'PredicateKernelCheck
-> PacmanUpdates 'PredicateKernelCheck
$mPacmanUpdatesPredicateK :: forall {r}.
PacmanUpdates 'PredicateKernelCheck
-> (Int
    -> Arg 'PredicateKernelCheck -> Printer 'PredicateKernelCheck -> r)
-> ((# #) -> r)
-> r
PacmanUpdatesPredicateK r a p = Make r a p

-- | A convenience wrapper around PacmanUpdatesPredicateK with the predicate @(== kernName)@
-- Construction only: the kernel name cannot be recovered when matching.
pattern PacmanUpdatesK :: Rate -> String -> Printer PredicateKernelCheck -> PacmanUpdates PredicateKernelCheck
pattern $bPacmanUpdatesK :: Int
-> String
-> Printer 'PredicateKernelCheck
-> PacmanUpdates 'PredicateKernelCheck
$mPacmanUpdatesK :: forall {r}.
PacmanUpdates 'PredicateKernelCheck
-> (Int -> String -> Printer 'PredicateKernelCheck -> r)
-> ((# #) -> r)
-> r
PacmanUpdatesK r kernName p <-
    (error "PacmanUpdatesK: build-only pattern synonym (a ctor synonym)." -> (r, kernName, p))
  where PacmanUpdatesK Int
r String
kernName Printer 'PredicateKernelCheck
p = Int
-> Arg 'PredicateKernelCheck
-> Printer 'PredicateKernelCheck
-> PacmanUpdates 'PredicateKernelCheck
PacmanUpdatesPredicateK Int
r (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kernName) Printer 'PredicateKernelCheck
p

-- | Pattern synonym used to construct a `PacmanUpdates NoKernelCheck`.
pattern PacmanUpdatesNoK :: Rate -> Printer NoKernelCheck -> PacmanUpdates NoKernelCheck
pattern $bPacmanUpdatesNoK :: Int -> Printer 'NoKernelCheck -> PacmanUpdates 'NoKernelCheck
$mPacmanUpdatesNoK :: forall {r}.
PacmanUpdates 'NoKernelCheck
-> (Int -> Printer 'NoKernelCheck -> r) -> ((# #) -> r) -> r
PacmanUpdatesNoK r p <- Make r _ p
  where PacmanUpdatesNoK Int
r Printer 'NoKernelCheck
p = Int
-> Arg 'NoKernelCheck
-> Printer 'NoKernelCheck
-> PacmanUpdates 'NoKernelCheck
forall (b :: PacmanUpdatesKernelCheck).
Int -> Arg b -> Printer b -> PacmanUpdates b
Make Int
r Void
Arg 'NoKernelCheck
forall a. HasCallStack => a
undefined Printer 'NoKernelCheck
p

checkUpdates :: IO (Either String (V.Vector String))
checkUpdates :: IO (Either String (Vector String))
checkUpdates = String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"checkupdates" [] String
""
    IO (ExitCode, String, String)
-> ((ExitCode, String, String) -> Either String (Vector String))
-> IO (Either String (Vector String))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case (ExitFailure Int
2, String
"", String
"") -> Vector String -> Either String (Vector String)
forall a b. b -> Either a b
Right Vector String
forall a. Vector a
V.empty
              (ExitCode
ExitSuccess, String
stdout, String
"")
                  -> let pkgName :: String -> String
pkgName = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ')
                         pkgs :: Vector String
pkgs = [String] -> Vector String
forall a. [a] -> Vector a
V.fromList ([String] -> Vector String) -> [String] -> Vector String
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
pkgName ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
stdout
                     in case Vector String -> Int
forall a. Vector a -> Int
V.length Vector String
pkgs of
                      Int
0 -> Either String (Vector String)
forall a. a
impossible
                      Int
_ -> Vector String -> Either String (Vector String)
forall a b. b -> Either a b
Right Vector String
pkgs
              (ExitFailure Int
1, String
_, String
_) -> String -> Either String (Vector String)
forall a b. a -> Either a b
Left String
"checkupdates: unknown cause of failure."
              (ExitCode, String, String)
_ -> Either String (Vector String)
forall a. a
impossible

kernIsOld :: IO Bool
kernIsOld :: IO Bool
kernIsOld = (ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (ExitCode -> Bool)
-> ((ExitCode, String, String) -> ExitCode)
-> (ExitCode, String, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExitCode, String, String) -> ExitCode
forall {a} {b} {c}. (a, b, c) -> a
exitCode ((ExitCode, String, String) -> Bool)
-> IO (ExitCode, String, String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"modinfo" [String
"-n", String
"i915"] String
""
  where exitCode :: (a, b, c) -> a
exitCode = (a, b, c) -> a
forall {a} {b} {c}. (a, b, c) -> a
fst3

impossible :: a
impossible :: forall a. a
impossible = String -> a
forall a. HasCallStack => String -> a
error String
"This is impossible, according to my knowledge."