summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Types.hs9
-rw-r--r--src/Xmobar/Plugins/Monitors/UVMeter.hs30
-rw-r--r--src/Xmobar/Plugins/Monitors/Weather.hs62
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 03:01:25 +0000