From eb878f652ac52348dffdc13d36c1ca44775a7109 Mon Sep 17 00:00:00 2001 From: jao Date: Mon, 27 Jan 2020 00:56:51 +0000 Subject: Revert "Use a single Manager across the whole application" This reverts commit 1f1f0bd8b811740c84215f9ed4fa5ebd8309a990. --- src/Xmobar/Plugins/Monitors/Common/Types.hs | 9 ++--- src/Xmobar/Plugins/Monitors/UVMeter.hs | 30 +++++++------- src/Xmobar/Plugins/Monitors/Weather.hs | 62 +++++++++++------------------ xmobar.cabal | 8 ++-- 4 files changed, 43 insertions(+), 66 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 "" +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 "" 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 "" +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 "" 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 diff --git a/xmobar.cabal b/xmobar.cabal index 176a18d..1eff7ba 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -176,8 +176,7 @@ library parsec-numbers >= 0.1.0, stm >= 2.3 && < 2.6, extensible-exceptions == 0.1.*, - async, - http-conduit + async if impl(ghc < 8.0.2) -- Disable building with GHC before 8.0.2. @@ -251,11 +250,11 @@ library if flag(with_weather) || flag(all_extensions) exposed-modules: Xmobar.Plugins.Monitors.Weather cpp-options: -DWEATHER - build-depends: http-types + build-depends: http-conduit, http-types if flag(with_uvmeter) exposed-modules: Xmobar.Plugins.Monitors.UVMeter - build-depends: http-types + build-depends: http-conduit, http-types cpp-options: -DUVMETER if os(freebsd) @@ -311,7 +310,6 @@ test-suite XmobarTest async, temporary, hspec == 2.*, - http-conduit, xmobar other-modules: Xmobar.Plugins.Monitors.CommonSpec -- cgit v1.2.3