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."
]
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 ()