{-# 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`, `PacmanUpdatesPredicateK` and `PacmanUpdatesNoK` constructors instead." #-}
    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 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


-- | 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 = error "PacmanUpdates: Show instance is stub"

instance Read (PacmanUpdates b) where
  readsPrec = error "PacmanUpdates: Read instance is stub"

instance Updates b => Exec (PacmanUpdates (b :: PacmanUpdatesKernelCheck)) where
  alias = const "pacman"
  rate (Make r _ _) = r
  run = 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' (Make _ _ printer)
      = printer
          <$> kernIsOld
          <*> (fmap V.length <$> 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' (Make _ checkKern printer)
      = printer
          <$> kernIsOld
          <*> (fmap (V.length &&& V.any checkKern) <$> 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 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 PacmanUpdatesK r kernName p <-
    (error "PacmanUpdatesK: build-only pattern synonym (a ctor synonym)." -> (r, kernName, p))
  where PacmanUpdatesK r kernName p = PacmanUpdatesPredicateK r (== kernName) p

-- | Pattern synonym used to construct a `PacmanUpdates NoKernelCheck`.
pattern PacmanUpdatesNoK :: Rate -> Printer NoKernelCheck -> PacmanUpdates NoKernelCheck
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."