{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Xmobar.Plugins.Monitors
-- Copyright   :  (c) 2010, 2011, 2012, 2013, 2017, 2018, 2019, 2020 Jose Antonio Ortega Ruiz
--                (c) 2007-10 Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- The system monitor plugin for Xmobar.
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors where

import Xmobar.Run.Exec

import Xmobar.Plugins.Monitors.Common (runM)
#ifdef WEATHER
import Xmobar.Plugins.Monitors.Weather
#endif
import Xmobar.Plugins.Monitors.Net
import Xmobar.Plugins.Monitors.Mem
import Xmobar.Plugins.Monitors.Swap
import Xmobar.Plugins.Monitors.Cpu
import Xmobar.Plugins.Monitors.MultiCpu
import Xmobar.Plugins.Monitors.Batt
import Xmobar.Plugins.Monitors.Bright
import Xmobar.Plugins.Monitors.Thermal
import Xmobar.Plugins.Monitors.ThermalZone
import Xmobar.Plugins.Monitors.CpuFreq
import Xmobar.Plugins.Monitors.CoreTemp
import Xmobar.Plugins.Monitors.MultiCoreTemp
import Xmobar.Plugins.Monitors.K10Temp
import Xmobar.Plugins.Monitors.Disk
import Xmobar.Plugins.Monitors.Top
import Xmobar.Plugins.Monitors.Uptime
import Xmobar.Plugins.Monitors.CatInt
#ifdef UVMETER
import Xmobar.Plugins.Monitors.UVMeter
#endif
#if defined IWLIB || defined USE_NL80211
import Xmobar.Plugins.Monitors.Wireless
#endif
#ifdef LIBMPD
import Xmobar.Plugins.Monitors.MPD
import Xmobar.Plugins.Monitors.Common (runMBD, runMD)
#endif
#ifdef ALSA
import Xmobar.Plugins.Monitors.Volume
import Xmobar.Plugins.Monitors.Alsa
#endif
#ifdef MPRIS
import Xmobar.Plugins.Monitors.Mpris
#endif

data Monitors = Network      Interface   Args Rate
              | DynNetwork               Args Rate
              | BatteryP     Args        Args Rate
              | BatteryN     Args        Args Rate Alias
              | Battery      Args        Rate
              | DiskU        DiskSpec    Args Rate
              | DiskIO       DiskSpec    Args Rate
              | Thermal      Zone        Args Rate
              | ThermalZone  ZoneNo      Args Rate
              | Memory       Args        Rate
              | Swap         Args        Rate
              | Cpu          Args        Rate
              | MultiCpu     Args        Rate
              | Brightness   Args        Rate
              | CpuFreq      Args        Rate
              | CoreTemp     Args        Rate
              | MultiCoreTemp Args       Rate
              | K10Temp      Slot        Args Rate
              | TopProc      Args        Rate
              | TopMem       Args        Rate
              | Uptime       Args        Rate
              | CatInt       Int FilePath Args Rate
#ifdef WEATHER
              | Weather      Station     Args Rate
              | WeatherX     Station SkyConditions Args Rate
#endif
#ifdef UVMETER
              | UVMeter      Station     Args Rate
#endif
#if defined IWLIB || defined USE_NL80211
              | Wireless Interface  Args Rate
#endif
#ifdef LIBMPD
              | MPD Args Rate
              | MPDX Args Rate Alias
              | AutoMPD  Args
#endif
#ifdef ALSA
              | Volume   String     String Args Rate
              | Alsa     String     String Args
#endif
#ifdef MPRIS
              | Mpris1   String     Args Rate
              | Mpris2   String     Args Rate
#endif
                deriving (Int -> Monitors -> ShowS
[Monitors] -> ShowS
Monitors -> String
(Int -> Monitors -> ShowS)
-> (Monitors -> String) -> ([Monitors] -> ShowS) -> Show Monitors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Monitors] -> ShowS
$cshowList :: [Monitors] -> ShowS
show :: Monitors -> String
$cshow :: Monitors -> String
showsPrec :: Int -> Monitors -> ShowS
$cshowsPrec :: Int -> Monitors -> ShowS
Show,ReadPrec [Monitors]
ReadPrec Monitors
Int -> ReadS Monitors
ReadS [Monitors]
(Int -> ReadS Monitors)
-> ReadS [Monitors]
-> ReadPrec Monitors
-> ReadPrec [Monitors]
-> Read Monitors
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Monitors]
$creadListPrec :: ReadPrec [Monitors]
readPrec :: ReadPrec Monitors
$creadPrec :: ReadPrec Monitors
readList :: ReadS [Monitors]
$creadList :: ReadS [Monitors]
readsPrec :: Int -> ReadS Monitors
$creadsPrec :: Int -> ReadS Monitors
Read,Monitors -> Monitors -> Bool
(Monitors -> Monitors -> Bool)
-> (Monitors -> Monitors -> Bool) -> Eq Monitors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Monitors -> Monitors -> Bool
$c/= :: Monitors -> Monitors -> Bool
== :: Monitors -> Monitors -> Bool
$c== :: Monitors -> Monitors -> Bool
Eq)

type Args      = [String]
type Program   = String
type Alias     = String
type Station   = String
type SkyConditions = [(String, String)]
type Zone      = String
type ZoneNo    = Int
type Interface = String
type Rate      = Int
type DiskSpec  = [(String, String)]
type Slot      = String

instance Exec Monitors where
#ifdef WEATHER
    alias :: Monitors -> String
alias (Weather String
s Args
_ Int
_) = String
s
    alias (WeatherX String
s SkyConditions
_ Args
_ Int
_) = String
s
#endif
    alias (Network String
i Args
_ Int
_) = String
i
    alias (DynNetwork Args
_ Int
_) = String
"dynnetwork"
    alias (Thermal String
z Args
_ Int
_) = String
z
    alias (ThermalZone Int
z Args
_ Int
_) = String
"thermal" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
z
    alias (Memory Args
_ Int
_) = String
"memory"
    alias (Swap Args
_ Int
_) = String
"swap"
    alias (Cpu Args
_ Int
_) = String
"cpu"
    alias (MultiCpu Args
_ Int
_) = String
"multicpu"
    alias (Battery Args
_ Int
_) = String
"battery"
    alias BatteryP {} = String
"battery"
    alias (BatteryN Args
_ Args
_ Int
_ String
a)= String
a
    alias (Brightness Args
_ Int
_) = String
"bright"
    alias (CpuFreq Args
_ Int
_) = String
"cpufreq"
    alias (TopProc Args
_ Int
_) = String
"top"
    alias (TopMem Args
_ Int
_) = String
"topmem"
    alias (CoreTemp Args
_ Int
_) = String
"coretemp"
    alias (MultiCoreTemp Args
_ Int
_) = String
"multicoretemp"
    alias K10Temp {} = String
"k10temp"
    alias DiskU {} = String
"disku"
    alias DiskIO {} = String
"diskio"
    alias (Uptime Args
_ Int
_) = String
"uptime"
    alias (CatInt Int
n String
_ Args
_ Int
_) = String
"cat" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
#ifdef UVMETER
    alias (UVMeter s _ _) = "uv " ++ s
#endif
#if defined IWLIB || defined USE_NL80211
    alias (Wireless i _ _) = i ++ "wi"
#endif
#ifdef LIBMPD
    alias (MPD _ _) = "mpd"
    alias (AutoMPD _) = "autompd"
    alias (MPDX _ _ a) = a
#endif
#ifdef ALSA
    alias (Volume m c _ _) = m ++ ":" ++ c
    alias (Alsa m c _) = "alsa:" ++ m ++ ":" ++ c
#endif
#ifdef MPRIS
    alias (Mpris1 _ _ _) = "mpris1"
    alias (Mpris2 _ _ _) = "mpris2"
#endif
    start :: Monitors -> (String -> IO ()) -> IO ()
start (Network  String
i Args
a Int
r) = String -> Args -> Int -> (String -> IO ()) -> IO ()
startNet String
i Args
a Int
r
    start (DynNetwork Args
a Int
r) = Args -> Int -> (String -> IO ()) -> IO ()
startDynNet Args
a Int
r
    start (Cpu Args
a Int
r) = Args -> Int -> (String -> IO ()) -> IO ()
startCpu Args
a Int
r
    start (MultiCpu Args
a Int
r) = Args -> Int -> (String -> IO ()) -> IO ()
startMultiCpu Args
a Int
r
    start (TopProc Args
a Int
r) = Args -> Int -> (String -> IO ()) -> IO ()
startTop Args
a Int
r
    start (TopMem Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
topMemConfig Args -> Monitor String
runTopMem Int
r
#ifdef WEATHER
    start (Weather  String
s   Args
a Int
r) = String -> Args -> Int -> (String -> IO ()) -> IO ()
startWeather    String
s Args
a Int
r
    start (WeatherX String
s SkyConditions
c Args
a Int
r) = SkyConditions
-> String -> Args -> Int -> (String -> IO ()) -> IO ()
startWeather' SkyConditions
c String
s Args
a Int
r
#endif
    start (Thermal String
z Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM (Args
a Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ [String
z]) IO MConfig
thermalConfig Args -> Monitor String
runThermal Int
r
    start (ThermalZone Int
z Args
a Int
r) =
      Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM (Args
a Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ [Int -> String
forall a. Show a => a -> String
show Int
z]) IO MConfig
thermalZoneConfig Args -> Monitor String
runThermalZone Int
r
    start (Memory Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
memConfig Args -> Monitor String
runMem Int
r
    start (Swap Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
swapConfig Args -> Monitor String
runSwap Int
r
    start (Battery Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
battConfig Args -> Monitor String
runBatt Int
r
    start (BatteryP Args
s Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
battConfig (Args -> Args -> Monitor String
runBatt' Args
s) Int
r
    start (BatteryN Args
s Args
a Int
r String
_) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
battConfig (Args -> Args -> Monitor String
runBatt' Args
s) Int
r
    start (Brightness Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
brightConfig Args -> Monitor String
runBright Int
r
    start (CpuFreq Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
cpuFreqConfig Args -> Monitor String
runCpuFreq Int
r
    start (CoreTemp Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
coreTempConfig Args -> Monitor String
runCoreTemp Int
r
    start (MultiCoreTemp Args
a Int
r) = Args -> Int -> (String -> IO ()) -> IO ()
startMultiCoreTemp Args
a Int
r
    start (K10Temp String
s Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM (Args
a Args -> Args -> Args
forall a. [a] -> [a] -> [a]
++ [String
s]) IO MConfig
k10TempConfig Args -> Monitor String
runK10Temp Int
r
    start (DiskU SkyConditions
s Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
diskUConfig (SkyConditions -> Args -> Monitor String
runDiskU SkyConditions
s) Int
r
    start (DiskIO SkyConditions
s Args
a Int
r) = SkyConditions -> Args -> Int -> (String -> IO ()) -> IO ()
startDiskIO SkyConditions
s Args
a Int
r
    start (Uptime Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
uptimeConfig Args -> Monitor String
runUptime Int
r
    start (CatInt Int
_ String
s Args
a Int
r) = Args
-> IO MConfig
-> (Args -> Monitor String)
-> Int
-> (String -> IO ())
-> IO ()
runM Args
a IO MConfig
catIntConfig (String -> Args -> Monitor String
runCatInt String
s) Int
r
#ifdef UVMETER
    start (UVMeter s a r) = startUVMeter s a r
#endif
#if defined IWLIB || defined USE_NL80211
    start (Wireless i a r) = runM a wirelessConfig (runWireless i) r
#endif
#ifdef LIBMPD
    start (MPD a r) = runMD a mpdConfig runMPD r mpdReady
    start (MPDX a r _) = start (MPD a r)
    start (AutoMPD a) = runMBD a mpdConfig runMPD mpdWait mpdReady
#endif
#ifdef ALSA
    start (Volume m c a r) = runM a volumeConfig (runVolume m c) r
    start (Alsa m c a) = startAlsaPlugin m c a
#endif
#ifdef MPRIS
    start (Mpris1 s a r) = runM a mprisConfig (runMPRIS1 s) r
    start (Mpris2 s a r) = runM a mprisConfig (runMPRIS2 s) r
#endif