summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Common/Run.hs
blob: 188b02acb67186ce99d2973a1df582553c95f0eb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
------------------------------------------------------------------------------
-- |
-- 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 =
    [
      Option ['H'] ["High"] (ReqArg High "number") "The high threshold"
    , Option ['L'] ["Low"] (ReqArg Low "number") "The low threshold"
    , Option "h" ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\""
    , Option "n" ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\""
    , Option "l" ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\""
    , Option "t" ["template"] (ReqArg Template "output template") "Output template."
    , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes."
    , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display."
    , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width."
    , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width"
    , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width"
    , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width"
    , Option "e" ["maxwidthellipsis"] (ReqArg WidthEllipsis "Maximum width ellipsis") "Ellipsis to be added to the field when it has reached its max width."
    , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding"
    , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right"
    , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds"
    , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds"
    , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width"
    , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available"
    , Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width"
    , Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "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 args =
    case getOpt Permute pluginOptions args of
        (_, n, []  ) -> n
        (_, _, errs) -> errs



doArgs :: [String]
       -> ([String] -> Monitor String)
       -> ([String] -> Monitor Bool)
       -> Monitor String
doArgs args action detect =
    case getOpt Permute pluginOptions args of
      (o, n, [])   -> do doConfigOptions o
                         ready <- detect n
                         if ready
                            then action n
                            else return "<Waiting...>"
      (_, _, errs) -> return (concat errs)

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

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

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

runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
        -> (String -> IO ()) -> IO ()
runMB args conf action wait = runMBD args conf action wait (\_ -> return True)

runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
        -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
runMBD args conf action wait detect cb = handle (cb . showException) loop
  where ac = doArgs args action detect
        loop = conf >>= runReaderT ac >>= cb >> wait >> loop

runML :: [String] -> IO MConfig -> ([String] -> Monitor String)
      -> (IO () -> IO ()) -> (String -> IO ()) -> IO ()
runML args conf action looper = runMLD args conf action looper (\_ -> return True)

runMLD :: [String] -> IO MConfig -> ([String] -> Monitor String)
       -> (IO () -> IO ()) -> ([String] -> Monitor Bool) -> (String -> IO ())
       -> IO ()
runMLD args conf action looper detect cb = handle (cb . showException) loop
  where ac = doArgs args action detect
        loop = looper $ conf >>= runReaderT ac >>= cb

showException :: SomeException -> String
showException = ("error: "++) . show . flip asTypeOf undefined

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

getMConfig :: [String] -> IO MConfig -> IO MConfig
getMConfig args mconfig = do
  config <- mconfig
  runReaderT (updateOptions args >> ask) config

updateOptions :: [String] -> Monitor ()
updateOptions args= case getOpt Permute pluginOptions args of
                      (o, _, []) -> doConfigOptions o
                      _ -> return ()