diff options
| -rw-r--r-- | src/Xmobar/Plugins/Monitors.hs | 6 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/UVMeter.hs | 87 |
2 files changed, 72 insertions, 21 deletions
diff --git a/src/Xmobar/Plugins/Monitors.hs b/src/Xmobar/Plugins/Monitors.hs index 6674fb4..d6fc0a0 100644 --- a/src/Xmobar/Plugins/Monitors.hs +++ b/src/Xmobar/Plugins/Monitors.hs @@ -19,7 +19,7 @@ module Xmobar.Plugins.Monitors where import Xmobar.Run.Exec -import Xmobar.Plugins.Monitors.Common (runM, runMD) +import Xmobar.Plugins.Monitors.Common (runM) #ifdef WEATHER import Xmobar.Plugins.Monitors.Weather #endif @@ -47,7 +47,7 @@ import Xmobar.Plugins.Monitors.Wireless #endif #ifdef LIBMPD import Xmobar.Plugins.Monitors.MPD -import Xmobar.Plugins.Monitors.Common (runMBD) +import Xmobar.Plugins.Monitors.Common (runMBD, runMD) #endif #ifdef ALSA import Xmobar.Plugins.Monitors.Volume @@ -184,7 +184,7 @@ instance Exec Monitors where start (Uptime a r) = runM a uptimeConfig runUptime r start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r #ifdef UVMETER - start (UVMeter s a r) = runM (a ++ [s]) uvConfig runUVMeter r + start (UVMeter s a r) = startUVMeter s a r #endif #ifdef IWLIB start (Wireless i a r) = runM a wirelessConfig (runWireless i) r diff --git a/src/Xmobar/Plugins/Monitors/UVMeter.hs b/src/Xmobar/Plugins/Monitors/UVMeter.hs index 839daed..e184cb1 100644 --- a/src/Xmobar/Plugins/Monitors/UVMeter.hs +++ b/src/Xmobar/Plugins/Monitors/UVMeter.hs @@ -19,16 +19,40 @@ import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE import Network.HTTP.Conduit - (parseRequest, newManager, tlsManagerSettings, httpLbs, - responseBody) + ( Manager + , httpLbs + , managerConnCount + , newManager + , parseRequest + , responseBody + , tlsManagerSettings + ) import Data.ByteString.Lazy.Char8 as B -import Data.IORef (newIORef, readIORef) +import Data.Maybe (fromMaybe) +import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) import Text.Read (readMaybe) import Text.Parsec import Text.Parsec.String import Control.Monad (void) +-- | Options the user may specify. +newtype UVMeterOpts = UVMeterOpts + { useManager :: Bool + } + +-- | Default values for options. +defaultOpts :: UVMeterOpts +defaultOpts = UVMeterOpts + { useManager = True + } + +-- | Apply options. +options :: [OptDescr (UVMeterOpts -> UVMeterOpts)] +options = + [ Option "m" ["useManager"] (ReqArg (\m o -> o { useManager = read m }) "") "" + ] + uvConfig :: IO MConfig uvConfig = mkMConfig "<station>" -- template @@ -41,16 +65,19 @@ newtype UvInfo = UV { index :: String } uvURL :: String uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml" -getData :: IO String -getData = - CE.catch (do request <- parseRequest uvURL - manager <- newManager tlsManagerSettings - res <- httpLbs request manager - return $ B.unpack $ responseBody res) - errHandler - where errHandler - :: CE.SomeException -> IO String - errHandler _ = return "<Could not retrieve data>" +-- | Get the UV data from the given url. +getData :: Maybe Manager -> IO String +getData uvMan = CE.catch + (do man <- flip fromMaybe uvMan <$> mkManager + -- Create a new manager if none was present or the user does not want to + -- use one, otherwise use the provided manager. + request <- parseRequest uvURL + res <- httpLbs request man + return $ B.unpack $ responseBody res) + errHandler + where + errHandler :: CE.SomeException -> IO String + errHandler _ = return "<Could not retrieve data>" textToXMLDocument :: String -> Either ParseError [XML] textToXMLDocument = parse document "" @@ -70,11 +97,23 @@ getUVRating _ (Element "index" [] [Body rate]:_) = readMaybe rate getUVRating locID (_:xs) = getUVRating locID xs getUVRating _ [] = Nothing - -runUVMeter :: [String] -> Monitor String -runUVMeter [] = return "N.A." -runUVMeter (s:_) = do - resp <- io getData +-- | Start the uvmeter monitor, create a new 'Maybe Manager', should the user have +-- chosen to use one. +startUVMeter + :: String -- ^ Station + -> [String] -- ^ User supplied arguments + -> Int -- ^ Update rate + -> (String -> IO ()) + -> IO () +startUVMeter station args rate cb = do + opts <- parseOptsWith options defaultOpts (getArgvs args) + uvMan <- tryMakeManager opts + runM (station : args) uvConfig (runUVMeter uvMan) rate cb + +runUVMeter :: Maybe Manager -> [String] -> Monitor String +runUVMeter _ [] = return "N.A." +runUVMeter uvMan (s:_) = do + resp <- io $ getData uvMan case textToXMLDocument resp of Right doc -> formatUVRating (getUVRating s doc) Left _ -> getConfigValue naString @@ -156,3 +195,15 @@ attribute = do char '"' spaces return (Attribute (name, value)) + +-- | Possibly create a new 'Manager', based upon the users preference. If one +-- is created, this 'Manager' will be used throughout the monitor. +tryMakeManager :: UVMeterOpts -> IO (Maybe Manager) +tryMakeManager opts = + if useManager opts + then Just <$> mkManager + else pure Nothing + +-- | Create a new 'Manager' for managing network connections. +mkManager :: IO Manager +mkManager = newManager $ tlsManagerSettings {managerConnCount = 1} |