------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Run
-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Dec 02, 2018 04:17
--
--
-- Running a monitor
--
------------------------------------------------------------------------------


module Xmobar.Plugins.Monitors.Common.Run ( runM
                                          , runMD
                                          , runMB
                                          , runMBD
                                          , runML
                                          , runMLD
                                          , getArgvs
                                          , doArgs
                                          , computeMonitorConfig
                                          , pluginOptions
                                          ) where

import Control.Exception (SomeException,handle)
import Data.List
import Control.Monad.Reader
import System.Console.GetOpt

import Xmobar.Plugins.Monitors.Common.Types
import Xmobar.Run.Exec (doEveryTenthSeconds)

pluginOptions :: [OptDescr Opts]
pluginOptions :: [OptDescr Opts]
pluginOptions =
    [
      forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'H'] [[Char]
"High"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
High [Char]
"number") [Char]
"The high threshold"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char
'L'] [[Char]
"Low"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
Low [Char]
"number") [Char]
"The low threshold"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"h" [[Char]
"high"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
HighColor [Char]
"color number") [Char]
"Color for the high threshold: ex \"#FF0000\""
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"n" [[Char]
"normal"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
NormalColor [Char]
"color number") [Char]
"Color for the normal threshold: ex \"#00FF00\""
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"l" [[Char]
"low"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
LowColor [Char]
"color number") [Char]
"Color for the low threshold: ex \"#0000FF\""
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"t" [[Char]
"template"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
Template [Char]
"output template") [Char]
"Output template."
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"S" [[Char]
"suffix"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
UseSuffix [Char]
"True/False") [Char]
"Use % to display percents or other suffixes."
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"d" [[Char]
"ddigits"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
DecDigits [Char]
"decimal digits") [Char]
"Number of decimal digits to display."
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"p" [[Char]
"ppad"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
PercentPad [Char]
"percent padding") [Char]
"Minimum percentage width."
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"m" [[Char]
"minwidth"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
MinWidth [Char]
"minimum width") [Char]
"Minimum field width"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"M" [[Char]
"maxwidth"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
MaxWidth [Char]
"maximum width") [Char]
"Maximum field width"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"w" [[Char]
"width"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
Width [Char]
"fixed width") [Char]
"Fixed field width"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"e" [[Char]
"maxwidthellipsis"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
WidthEllipsis [Char]
"Maximum width ellipsis") [Char]
"Ellipsis to be added to the field when it has reached its max width."
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"c" [[Char]
"padchars"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
PadChars [Char]
"padding chars") [Char]
"Characters to use for padding"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"a" [[Char]
"align"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
PadAlign [Char]
"padding alignment") [Char]
"'l' for left padding, 'r' for right"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"b" [[Char]
"bback"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
BarBack [Char]
"bar background") [Char]
"Characters used to draw bar backgrounds"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"f" [[Char]
"bfore"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
BarFore [Char]
"bar foreground") [Char]
"Characters used to draw bar foregrounds"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"W" [[Char]
"bwidth"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
BarWidth [Char]
"bar width") [Char]
"Bar width"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"x" [[Char]
"nastring"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
NAString [Char]
"N/A string") [Char]
"String used when the monitor is not available"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"T" [[Char]
"maxtwidth"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
MaxTotalWidth [Char]
"Maximum total width") [Char]
"Maximum total width"
    , forall a. [Char] -> [[Char]] -> ArgDescr a -> [Char] -> OptDescr a
Option [Char]
"E" [[Char]
"maxtwidthellipsis"] (forall a. ([Char] -> a) -> [Char] -> ArgDescr a
ReqArg [Char] -> Opts
MaxTotalWidthEllipsis [Char]
"Maximum total width ellipsis") [Char]
"Ellipsis to be added to the total text when it has reached its max width."
    ]

-- | Get all argument values out of a list of arguments.
getArgvs :: [String] -> [String]
getArgvs :: [[Char]] -> [[Char]]
getArgvs [[Char]]
args =
    case forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt forall a. ArgOrder a
Permute [OptDescr Opts]
pluginOptions [[Char]]
args of
        ([Opts]
_, [[Char]]
n, []  ) -> [[Char]]
n
        ([Opts]
_, [[Char]]
_, [[Char]]
errs) -> [[Char]]
errs



doArgs :: [String]
       -> ([String] -> Monitor String)
       -> ([String] -> Monitor Bool)
       -> Monitor String
doArgs :: [[Char]]
-> ([[Char]] -> Monitor [Char])
-> ([[Char]] -> Monitor Bool)
-> Monitor [Char]
doArgs [[Char]]
args [[Char]] -> Monitor [Char]
action [[Char]] -> Monitor Bool
detect =
    case forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt forall a. ArgOrder a
Permute [OptDescr Opts]
pluginOptions [[Char]]
args of
      ([Opts]
o, [[Char]]
n, [])   -> do [Opts] -> Monitor ()
doConfigOptions [Opts]
o
                         Bool
ready <- [[Char]] -> Monitor Bool
detect [[Char]]
n
                         if Bool
ready
                            then [[Char]] -> Monitor [Char]
action [[Char]]
n
                            else forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
"<Waiting...>"
      ([Opts]
_, [[Char]]
_, [[Char]]
errs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Char]]
errs)

doConfigOptions :: [Opts] -> Monitor ()
doConfigOptions :: [Opts] -> Monitor ()
doConfigOptions [] = forall a. IO a -> Monitor a
io forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()
doConfigOptions (Opts
o:[Opts]
oo) =
    do let next :: Monitor ()
next = [Opts] -> Monitor ()
doConfigOptions [Opts]
oo
           nz :: [Char] -> a
nz [Char]
s = let x :: a
x = forall a. Read a => [Char] -> a
read [Char]
s in forall a. Ord a => a -> a -> a
max a
0 a
x
           bool :: [Char] -> Bool
bool = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Char]
"True", [Char]
"true", [Char]
"Yes", [Char]
"yes", [Char]
"On", [Char]
"on"])
       (case Opts
o of
          High                  [Char]
h -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall a. Read a => [Char] -> a
read [Char]
h) MConfig -> IORef Int
high
          Low                   [Char]
l -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall a. Read a => [Char] -> a
read [Char]
l) MConfig -> IORef Int
low
          HighColor             [Char]
c -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall a. a -> Maybe a
Just [Char]
c) MConfig -> IORef (Maybe [Char])
highColor
          NormalColor           [Char]
c -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall a. a -> Maybe a
Just [Char]
c) MConfig -> IORef (Maybe [Char])
normalColor
          LowColor              [Char]
c -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall a. a -> Maybe a
Just [Char]
c) MConfig -> IORef (Maybe [Char])
lowColor
          Template              [Char]
t -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
t MConfig -> IORef [Char]
template
          PercentPad            [Char]
p -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
p) MConfig -> IORef Int
ppad
          DecDigits             [Char]
d -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
d) MConfig -> IORef Int
decDigits
          MinWidth              [Char]
w -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
minWidth
          MaxWidth              [Char]
w -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
maxWidth
          Width                 [Char]
w -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
minWidth forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                                   forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
maxWidth
          WidthEllipsis         [Char]
e -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
e MConfig -> IORef [Char]
maxWidthEllipsis
          PadChars              [Char]
s -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
s MConfig -> IORef [Char]
padChars
          PadAlign              [Char]
a -> forall a. a -> Selector a -> Monitor ()
setConfigValue ([Char]
"r" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
a) MConfig -> IORef Bool
padRight
          BarBack               [Char]
s -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
s MConfig -> IORef [Char]
barBack
          BarFore               [Char]
s -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
s MConfig -> IORef [Char]
barFore
          BarWidth              [Char]
w -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
barWidth
          UseSuffix             [Char]
u -> forall a. a -> Selector a -> Monitor ()
setConfigValue ([Char] -> Bool
bool [Char]
u) MConfig -> IORef Bool
useSuffix
          NAString              [Char]
s -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
s MConfig -> IORef [Char]
naString
          MaxTotalWidth         [Char]
w -> forall a. a -> Selector a -> Monitor ()
setConfigValue (forall {a}. (Ord a, Num a, Read a) => [Char] -> a
nz [Char]
w) MConfig -> IORef Int
maxTotalWidth
          MaxTotalWidthEllipsis [Char]
e -> forall a. a -> Selector a -> Monitor ()
setConfigValue [Char]
e MConfig -> IORef [Char]
maxTotalWidthEllipsis) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Monitor ()
next

runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
        -> (String -> IO ()) -> IO ()
runM :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> Int
-> ([Char] -> IO ())
-> IO ()
runM [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action Int
r = [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> (IO () -> IO ())
-> ([Char] -> IO ())
-> IO ()
runML [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action (Int -> IO () -> IO ()
doEveryTenthSeconds Int
r)

runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
        -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
runMD :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> Int
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action Int
r = [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> (IO () -> IO ())
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMLD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action (Int -> IO () -> IO ()
doEveryTenthSeconds Int
r)

runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
        -> (String -> IO ()) -> IO ()
runMB :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> IO ()
-> ([Char] -> IO ())
-> IO ()
runMB [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO ()
wait = [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> IO ()
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMBD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO ()
wait (\[[Char]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
        -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
runMBD :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> IO ()
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMBD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO ()
wait [[Char]] -> Monitor Bool
detect [Char] -> IO ()
cb = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ([Char] -> IO ()
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
showException) forall {b}. IO b
loop
  where ac :: Monitor [Char]
ac = [[Char]]
-> ([[Char]] -> Monitor [Char])
-> ([[Char]] -> Monitor Bool)
-> Monitor [Char]
doArgs [[Char]]
args [[Char]] -> Monitor [Char]
action [[Char]] -> Monitor Bool
detect
        loop :: IO b
loop = IO MConfig
conf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Monitor [Char]
ac forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO ()
cb forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
wait forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO b
loop

runML :: [String] -> IO MConfig -> ([String] -> Monitor String)
      -> (IO () -> IO ()) -> (String -> IO ()) -> IO ()
runML :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> (IO () -> IO ())
-> ([Char] -> IO ())
-> IO ()
runML [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO () -> IO ()
looper = [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> (IO () -> IO ())
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMLD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO () -> IO ()
looper (\[[Char]]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)

runMLD :: [String] -> IO MConfig -> ([String] -> Monitor String)
       -> (IO () -> IO ()) -> ([String] -> Monitor Bool) -> (String -> IO ())
       -> IO ()
runMLD :: [[Char]]
-> IO MConfig
-> ([[Char]] -> Monitor [Char])
-> (IO () -> IO ())
-> ([[Char]] -> Monitor Bool)
-> ([Char] -> IO ())
-> IO ()
runMLD [[Char]]
args IO MConfig
conf [[Char]] -> Monitor [Char]
action IO () -> IO ()
looper [[Char]] -> Monitor Bool
detect [Char] -> IO ()
cb = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ([Char] -> IO ()
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> [Char]
showException) IO ()
loop
  where ac :: Monitor [Char]
ac = [[Char]]
-> ([[Char]] -> Monitor [Char])
-> ([[Char]] -> Monitor Bool)
-> Monitor [Char]
doArgs [[Char]]
args [[Char]] -> Monitor [Char]
action [[Char]] -> Monitor Bool
detect
        loop :: IO ()
loop = IO () -> IO ()
looper forall a b. (a -> b) -> a -> b
$ IO MConfig
conf forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT Monitor [Char]
ac forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Char] -> IO ()
cb

showException :: SomeException -> String
showException :: SomeException -> [Char]
showException = ([Char]
"error: "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> a -> a
asTypeOf forall a. HasCallStack => a
undefined

computeMonitorConfig :: [String] -> IO MConfig -> IO MonitorConfig
computeMonitorConfig :: [[Char]] -> IO MConfig -> IO MonitorConfig
computeMonitorConfig [[Char]]
args IO MConfig
mconfig = do
  MConfig
newConfig <- [[Char]] -> IO MConfig -> IO MConfig
getMConfig [[Char]]
args IO MConfig
mconfig
  MConfig -> IO MonitorConfig
getMonitorConfig MConfig
newConfig

getMConfig :: [String] -> IO MConfig -> IO MConfig
getMConfig :: [[Char]] -> IO MConfig -> IO MConfig
getMConfig [[Char]]
args IO MConfig
mconfig = do
  MConfig
config <- IO MConfig
mconfig
  forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ([[Char]] -> Monitor ()
updateOptions [[Char]]
args forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall r (m :: * -> *). MonadReader r m => m r
ask) MConfig
config

updateOptions :: [String] -> Monitor ()
updateOptions :: [[Char]] -> Monitor ()
updateOptions [[Char]]
args= case forall a.
ArgOrder a -> [OptDescr a] -> [[Char]] -> ([a], [[Char]], [[Char]])
getOpt forall a. ArgOrder a
Permute [OptDescr Opts]
pluginOptions [[Char]]
args of
                      ([Opts]
o, [[Char]]
_, []) -> [Opts] -> Monitor ()
doConfigOptions [Opts]
o
                      ([Opts], [[Char]], [[Char]])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()