diff options
author | jao <jao@gnu.org> | 2020-01-27 00:56:51 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2020-01-27 00:56:51 +0000 |
commit | eb878f652ac52348dffdc13d36c1ca44775a7109 (patch) | |
tree | 2b318a7438ce74ae5b8013ecfe94e611fc5aa070 /src/Xmobar/Plugins | |
parent | 5a7a0298a3e94f49321f7922f987a1a0396850a8 (diff) | |
download | xmobar-eb878f652ac52348dffdc13d36c1ca44775a7109.tar.gz xmobar-eb878f652ac52348dffdc13d36c1ca44775a7109.tar.bz2 |
Revert "Use a single Manager across the whole application"
This reverts commit 1f1f0bd8b811740c84215f9ed4fa5ebd8309a990.
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Types.hs | 9 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/UVMeter.hs | 30 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Weather.hs | 62 |
3 files changed, 40 insertions, 61 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Common/Types.hs b/src/Xmobar/Plugins/Monitors/Common/Types.hs index 8662ba3..c36a562 100644 --- a/src/Xmobar/Plugins/Monitors/Common/Types.hs +++ b/src/Xmobar/Plugins/Monitors/Common/Types.hs @@ -25,9 +25,8 @@ module Xmobar.Plugins.Monitors.Common.Types ( Monitor , io ) where -import Data.IORef (IORef, modifyIORef, newIORef, readIORef) -import Control.Monad.Reader (ReaderT, ask, liftIO) -import Network.HTTP.Conduit (Manager, newManager, tlsManagerSettings) +import Data.IORef +import Control.Monad.Reader type Monitor a = ReaderT MConfig IO a @@ -56,7 +55,6 @@ data MConfig = , naString :: IORef String , maxTotalWidth :: IORef Int , maxTotalWidthEllipsis :: IORef String - , manager :: IORef Manager } -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' @@ -104,8 +102,7 @@ mkMConfig tmpl exprts = na <- newIORef "N/A" mt <- newIORef 0 mtel <- newIORef "" - man <- newIORef =<< newManager tlsManagerSettings - return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel man + return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel data Opts = HighColor String | NormalColor String diff --git a/src/Xmobar/Plugins/Monitors/UVMeter.hs b/src/Xmobar/Plugins/Monitors/UVMeter.hs index 3756856..079177f 100644 --- a/src/Xmobar/Plugins/Monitors/UVMeter.hs +++ b/src/Xmobar/Plugins/Monitors/UVMeter.hs @@ -18,14 +18,14 @@ module Xmobar.Plugins.Monitors.UVMeter where import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE -import Network.HTTP.Conduit (httpLbs, parseRequest, responseBody) +import Network.HTTP.Conduit + (parseRequest, newManager, tlsManagerSettings, httpLbs, + responseBody) import Data.ByteString.Lazy.Char8 as B import Text.Read (readMaybe) import Text.Parsec import Text.Parsec.String import Control.Monad (void) -import Control.Monad.Reader (asks) -import Data.IORef (readIORef) uvConfig :: IO MConfig @@ -40,18 +40,16 @@ newtype UvInfo = UV { index :: String } uvURL :: String uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml" --- | Get the UV data from the given url. -getData :: Monitor String -getData = do - man <- io =<< readIORef <$> asks manager - io $ CE.catch - (do 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>" +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>" textToXMLDocument :: String -> Either ParseError [XML] textToXMLDocument = parse document "" @@ -75,7 +73,7 @@ getUVRating _ [] = Nothing runUVMeter :: [String] -> Monitor String runUVMeter [] = return "N.A." runUVMeter (s:_) = do - resp <- getData + resp <- io getData case textToXMLDocument resp of Right doc -> formatUVRating (getUVRating s doc) Left _ -> getConfigValue naString diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs index 250c258..07d8cc4 100644 --- a/src/Xmobar/Plugins/Monitors/Weather.hs +++ b/src/Xmobar/Plugins/Monitors/Weather.hs @@ -19,13 +19,11 @@ import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE -import Control.Monad.Reader (asks) -import qualified Data.ByteString.Lazy.Char8 as B -import Data.Char (toLower) -import Data.IORef (readIORef) import Network.HTTP.Conduit -import Network.HTTP.Types.Method (methodHead) import Network.HTTP.Types.Status +import Network.HTTP.Types.Method +import qualified Data.ByteString.Lazy.Char8 as B +import Data.Char (toLower) import Text.ParserCombinators.Parsec import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) @@ -210,18 +208,15 @@ defUrl = "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/" stationUrl :: String -> String stationUrl station = defUrl ++ station ++ ".TXT" --- | Get the decoded weather data from the given station. -getData :: String -> Monitor String -getData station = do - man <- io =<< readIORef <$> asks manager - io $ CE.catch ( do - request <- parseUrlThrow $ stationUrl station - res <- httpLbs request man - return $ B.unpack $ responseBody res - ) errHandler - where - errHandler :: CE.SomeException -> IO String - errHandler _ = return "<Could not retrieve data>" +getData :: String -> IO String +getData station = CE.catch (do + manager <- newManager tlsManagerSettings + request <- parseUrlThrow $ stationUrl station + res <- httpLbs request manager + return $ B.unpack $ responseBody res + ) errHandler + where errHandler :: CE.SomeException -> IO String + errHandler _ = return "<Could not retrieve data>" formatSk :: Eq p => [(p, p)] -> p -> p formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk @@ -247,38 +242,27 @@ showWeather :: String -> String -> String showWeather "" d = d showWeather s _ = s --- | Run the 'Weather' monitor. runWeather :: [String] -> Monitor String runWeather = runWeather' [] --- | Run the 'WeatherX' monitor. -runWeather' - :: [(String, String)] -- ^ 'SkyConditionS' replacement strings - -> [String] -- ^ User supplied arguments - -> Monitor String +runWeather' :: [(String, String)] -> [String] -> Monitor String runWeather' sks args = - do d <- getData $ head args + do d <- io $ getData $ head args o <- io $ parseOptsWith options defaultOpts args i <- io $ runP parseData d formatWeather o sks i --- | Test internet connectivity before executing the monitor. weatherReady :: [String] -> Monitor Bool weatherReady str = do initRequest <- parseUrlThrow $ stationUrl $ head str let request = initRequest{method = methodHead} - man <- io =<< readIORef <$> asks manager io $ CE.catch ( do - res <- httpLbs request man - return $ checkResult $ responseStatus res ) errHandler - where - -- | If any exception occurs, indicate that the monitor is not ready. - errHandler :: CE.SomeException -> IO Bool - errHandler _ = return False - - -- | Check for and indicate any errors in the http response. - checkResult :: Status -> Bool - checkResult status - | statusIsServerError status = False - | statusIsClientError status = False - | otherwise = True + manager <- newManager tlsManagerSettings + res <- httpLbs request manager + return $ checkResult $responseStatus res ) errHandler + where errHandler :: CE.SomeException -> IO Bool + errHandler _ = return False + checkResult status + | statusIsServerError status = False + | statusIsClientError status = False + | otherwise = True |