{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE PatternSynonyms #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

{- |
Module      :  Plugins.Monitors.PacmanUpdates
Copyright   :  (c) 2024 Enrico Maria De Angelis
            ,  (c) 2025 Alexander Pankoff
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.
-}
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

-- | 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 PacmanUpdatesDeprecated where
  alias = const "pacman"
  rate (PacmanUpdates _ r) = r
  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."