summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
authorDragos Boca <dragos.boca@oracle.com>2015-08-18 15:10:16 +0300
committerDragos Boca <dragos.boca@oracle.com>2015-08-18 15:10:16 +0300
commit964c50754350fb68a6c2c180b9d399a4e0dc3d47 (patch)
tree92a52d615a49b0887edbbdafb8dfd31d1a323d4d /src
parentaee4dad69764015aa1578f43d44dd72382f11de6 (diff)
downloadxmobar-964c50754350fb68a6c2c180b9d399a4e0dc3d47.tar.gz
xmobar-964c50754350fb68a6c2c180b9d399a4e0dc3d47.tar.bz2
use Network::HTTP::Conduit
Diffstat (limited to 'src')
-rw-r--r--src/Plugins/Monitors/Weather.hs45
1 files changed, 25 insertions, 20 deletions
diff --git a/src/Plugins/Monitors/Weather.hs b/src/Plugins/Monitors/Weather.hs
index 92d98e7..5f5fb6f 100644
--- a/src/Plugins/Monitors/Weather.hs
+++ b/src/Plugins/Monitors/Weather.hs
@@ -18,7 +18,12 @@ import Plugins.Monitors.Common
import qualified Control.Exception as CE
-import Network.HTTP
+import Network.HTTP.Conduit
+import Network.HTTP.Types.Status
+import Network.HTTP.Types.Method
+
+--import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as B
import Text.ParserCombinators.Parsec
@@ -172,11 +177,14 @@ defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"
stationUrl :: String -> String
stationUrl station = defUrl ++ station ++ ".TXT"
-getData :: String -> IO String
-getData station = do
- let request = getRequest (stationUrl station)
- CE.catch (simpleHTTP request >>= getResponseBody) errHandler
- where errHandler :: CE.IOException -> IO String
+getData:: String -> IO String
+getData station = CE.catch (do
+ manager <- newManager tlsManagerSettings
+ request <- parseUrl $ stationUrl station
+ res <- httpLbs request manager
+ return $ B.unpack $ responseBody res
+ ) errHandler
+ where errHandler :: CE.SomeException -> IO String
errHandler _ = return "<Could not retrieve data>"
formatWeather :: [WeatherInfo] -> Monitor String
@@ -194,18 +202,15 @@ runWeather str =
weatherReady :: [String] -> Monitor Bool
weatherReady str = do
- let station = head str
- request = headRequest (stationUrl station)
- io $ CE.catch (simpleHTTP request >>= checkResult) errHandler
- where errHandler :: CE.IOException -> IO Bool
+ initRequest <- parseUrl $ stationUrl $ head str
+ let request = initRequest{method = methodHead}
+ io $ CE.catch ( do
+ manager <- newManager tlsManagerSettings
+ res <- httpLbs request manager
+ return $ checkResult $responseStatus res ) errHandler
+ where errHandler :: CE.SomeException -> IO Bool
errHandler _ = return False
- checkResult result =
- case result of
- Left _ -> return False
- Right response ->
- case rspCode response of
- -- Permission or network errors are failures; anything
- -- else is recoverable.
- (4, _, _) -> return False
- (5, _, _) -> return False
- (_, _, _) -> return True
+ checkResult status
+ | statusIsServerError status = False
+ | statusIsClientError status = False
+ | otherwise = True