{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Plugins.Monitors.Weather
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see LICENSE)
--
-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A weather monitor for Xmobar
--
-----------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Weather where

import Xmobar.Plugins.Monitors.Common

import qualified Control.Exception as CE

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char (toLower)
import Network.HTTP.Conduit
import Network.HTTP.Types.Status
import Network.HTTP.Types.Method
import Network.HTTP.Client.TLS (getGlobalManager)

import Text.ParserCombinators.Parsec
import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option))


-- | Options the user may specify.
newtype WeatherOpts = WeatherOpts
  { WeatherOpts -> String
weatherString :: String
  }

-- | Default values for options.
defaultOpts :: WeatherOpts
defaultOpts :: WeatherOpts
defaultOpts = WeatherOpts
  { weatherString :: String
weatherString = String
""
  }

-- | Apply options.
options :: [OptDescr (WeatherOpts -> WeatherOpts)]
options :: [OptDescr (WeatherOpts -> WeatherOpts)]
options =
  [ String
-> [String]
-> ArgDescr (WeatherOpts -> WeatherOpts)
-> String
-> OptDescr (WeatherOpts -> WeatherOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"w" [String
"weathers"  ] ((String -> WeatherOpts -> WeatherOpts)
-> String -> ArgDescr (WeatherOpts -> WeatherOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
s WeatherOpts
o -> WeatherOpts
o { weatherString = s   }) String
"") String
""
  ]

weatherConfig :: IO MConfig
weatherConfig :: IO MConfig
weatherConfig = String -> [String] -> IO MConfig
mkMConfig
       String
"<station>: <tempC>C, rh <rh>% (<hour>)" -- template
       [String
"station"                               -- available replacements
       , String
"stationState"
       , String
"year"
       , String
"month"
       , String
"day"
       , String
"hour"
       , String
"windCardinal"
       , String
"windAzimuth"
       , String
"windMph"
       , String
"windKnots"
       , String
"windKmh"
       , String
"windMs"
       , String
"visibility"
       , String
"skyCondition"
       , String
"skyConditionS"
       , String
"weather"
       , String
"weatherS"
       , String
"tempC"
       , String
"tempF"
       , String
"dewPointC"
       , String
"dewPointF"
       , String
"rh"
       , String
"pressure"
       ]

data WindInfo =
    WindInfo {
         WindInfo -> String
windCardinal :: String -- cardinal direction
       , WindInfo -> String
windAzimuth  :: String -- azimuth direction
       , WindInfo -> String
windMph      :: String -- speed (MPH)
       , WindInfo -> String
windKnots    :: String -- speed (knot)
       , WindInfo -> String
windKmh      :: String -- speed (km/h)
       , WindInfo -> String
windMs       :: String -- speed (m/s)
    } deriving (Int -> WindInfo -> ShowS
[WindInfo] -> ShowS
WindInfo -> String
(Int -> WindInfo -> ShowS)
-> (WindInfo -> String) -> ([WindInfo] -> ShowS) -> Show WindInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WindInfo -> ShowS
showsPrec :: Int -> WindInfo -> ShowS
$cshow :: WindInfo -> String
show :: WindInfo -> String
$cshowList :: [WindInfo] -> ShowS
showList :: [WindInfo] -> ShowS
Show)

data WeatherInfo =
    WI { WeatherInfo -> String
stationPlace :: String
       , WeatherInfo -> String
stationState :: String
       , WeatherInfo -> String
year         :: String
       , WeatherInfo -> String
month        :: String
       , WeatherInfo -> String
day          :: String
       , WeatherInfo -> String
hour         :: String
       , WeatherInfo -> WindInfo
windInfo     :: WindInfo
       , WeatherInfo -> String
visibility   :: String
       , WeatherInfo -> String
skyCondition :: String
       , WeatherInfo -> String
weather      :: String
       , WeatherInfo -> Int
tempC        :: Int
       , WeatherInfo -> Int
tempF        :: Int
       , WeatherInfo -> Int
dewPointC    :: Int
       , WeatherInfo -> Int
dewPointF    :: Int
       , WeatherInfo -> Int
humidity     :: Int
       , WeatherInfo -> Int
pressure     :: Int
       } deriving (Int -> WeatherInfo -> ShowS
[WeatherInfo] -> ShowS
WeatherInfo -> String
(Int -> WeatherInfo -> ShowS)
-> (WeatherInfo -> String)
-> ([WeatherInfo] -> ShowS)
-> Show WeatherInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WeatherInfo -> ShowS
showsPrec :: Int -> WeatherInfo -> ShowS
$cshow :: WeatherInfo -> String
show :: WeatherInfo -> String
$cshowList :: [WeatherInfo] -> ShowS
showList :: [WeatherInfo] -> ShowS
Show)

pTime :: Parser (String, String, String, String)
pTime :: Parser (String, String, String, String)
pTime = do y <- Parser String
getNumbersAsString
           char '.'
           m <- getNumbersAsString
           char '.'
           d <- getNumbersAsString
           char ' '
           (h:hh:mi:mimi) <- getNumbersAsString
           char ' '
           return (y, m, d ,h:hh:":"++mi:mimi)

noWind :: WindInfo
noWind :: WindInfo
noWind = String
-> String -> String -> String -> String -> String -> WindInfo
WindInfo String
"μ" String
"μ" String
"0" String
"0" String
"0" String
"0"

pWind :: Parser WindInfo
pWind :: Parser WindInfo
pWind =
  let tospace :: ParsecT String u Identity String
tospace = ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' ')
      toKmh :: ShowS
toKmh String
knots = String
knots String -> Double -> String
$* Double
1.852
      toMs :: ShowS
toMs String
knots  = String
knots String -> Double -> String
$* Double
0.514
      ($*) :: String -> Double -> String
      String
op1 $* :: String -> Double -> String
$* Double
op2 = Integer -> String
forall a. Show a => a -> String
show (Double -> Integer
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round ((String -> Double
forall a. Read a => String -> a
read String
op1::Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
op2)::Integer)

      -- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0"
      wind0 :: Parser WindInfo
wind0 = do ParsecT String () Identity Char -> Parser String -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
skipRestOfLine (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Wind: Calm:0")
                 WindInfo -> Parser WindInfo
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return WindInfo
noWind
      windVar :: Parser WindInfo
windVar = do ParsecT String () Identity Char -> Parser String -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
skipRestOfLine (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Wind: Variable at ")
                   mph <- Parser String
forall {u}. ParsecT String u Identity String
tospace
                   string "MPH ("
                   knot <- tospace
                   manyTill anyChar newline
                   return $ WindInfo "μ" "μ" mph knot (toKmh knot) (toMs knot)
      wind :: Parser WindInfo
wind = do ParsecT String () Identity Char -> Parser String -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
skipRestOfLine (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Wind: from the ")
                cardinal <- Parser String
forall {u}. ParsecT String u Identity String
tospace
                char '('
                azimuth <- tospace
                string "degrees) at "
                mph <- tospace
                string "MPH ("
                knot <- tospace
                manyTill anyChar newline
                return $ WindInfo cardinal azimuth mph knot (toKmh knot) (toMs knot)
  in Parser WindInfo -> Parser WindInfo
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser WindInfo
wind0 Parser WindInfo -> Parser WindInfo -> Parser WindInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser WindInfo -> Parser WindInfo
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser WindInfo
windVar Parser WindInfo -> Parser WindInfo -> Parser WindInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser WindInfo -> Parser WindInfo
forall tok st a. GenParser tok st a -> GenParser tok st a
try Parser WindInfo
wind Parser WindInfo -> Parser WindInfo -> Parser WindInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> WindInfo -> Parser WindInfo
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return WindInfo
noWind

pTemp :: Parser (Int, Int)
pTemp :: Parser (Int, Int)
pTemp = do let num :: ParsecT String u Identity Char
num = ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT String u Identity Char
-> ParsecT String u Identity Char -> ParsecT String u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
           f <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall {u}. ParsecT String u Identity Char
num (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
           manyTill anyChar $ char '('
           c <- manyTill num $ char ' '
           skipRestOfLine
           return (floor (read c :: Double), floor (read f :: Double))

pRh :: Parser Int
pRh :: Parser Int
pRh = do s <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%' ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')
         return $ read s

pPressure :: Parser Int
pPressure :: Parser Int
pPressure = do ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
               s <- ParsecT String () Identity Char
-> ParsecT String () Identity Char -> Parser String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit (ParsecT String () Identity Char -> Parser String)
-> ParsecT String () Identity Char -> Parser String
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
               skipRestOfLine
               return $ read s

{-
    example of 'http://weather.noaa.gov/pub/data/observations/metar/decoded/VTUD.TXT':
        Station name not available
        Aug 11, 2013 - 10:00 AM EDT / 2013.08.11 1400 UTC
        Wind: from the N (350 degrees) at 1 MPH (1 KT):0
        Visibility: 4 mile(s):0
        Sky conditions: mostly clear
        Temperature: 77 F (25 C)
        Dew Point: 73 F (23 C)
        Relative Humidity: 88%
        Pressure (altimeter): 29.77 in. Hg (1008 hPa)
        ob: VTUD 111400Z 35001KT 8000 FEW030 25/23 Q1008 A2977 INFO R RWY30
        cycle: 14
-}
parseData :: Parser [WeatherInfo]
parseData :: Parser [WeatherInfo]
parseData =
    do (st, ss) <- GenParser Char () (String, String)
-> GenParser Char () (String, String)
forall tok st a. GenParser tok st a -> GenParser tok st a
try (String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"Station name not available" Parser String
-> GenParser Char () (String, String)
-> GenParser Char () (String, String)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> GenParser Char () (String, String)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"??", String
"??")) GenParser Char () (String, String)
-> GenParser Char () (String, String)
-> GenParser Char () (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
                   (do st <- String -> Parser String
getAllBut String
","
                       space
                       ss <- getAllBut "("
                       return (st, ss)
                   )
       skipRestOfLine >> getAllBut "/"
       (y,m,d,h) <- pTime
       w <- pWind
       v <- getAfterString "Visibility: "
       sk <- getAfterString "Sky conditions: "
       we <- getAfterString "Weather: "
       skipTillString "Temperature: "
       (tC,tF) <- pTemp
       skipTillString "Dew Point: "
       (dC, dF) <- pTemp
       skipTillString "Relative Humidity: "
       rh <- pRh
       skipTillString "Pressure (altimeter): "
       p <- pPressure
       manyTill skipRestOfLine eof
       return [WI st ss y m d h w v sk we tC tF dC dF rh p]

defUrl :: String
defUrl :: String
defUrl = String
"https://tgftp.nws.noaa.gov/data/observations/metar/decoded/"

stationUrl :: String -> String
stationUrl :: ShowS
stationUrl String
station = String
defUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
station String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".TXT"

-- | Get the decoded weather data from the given station.
getData :: String -> IO String
getData :: String -> IO String
getData String
station = IO String -> (SomeException -> IO String) -> IO String
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch
    (do request <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ ShowS
stationUrl String
station
        man <- getGlobalManager
        res <- httpLbs request man
        return $ B.unpack $ responseBody res)
    SomeException -> IO String
errHandler
  where
    errHandler :: CE.SomeException -> IO String
    errHandler :: SomeException -> IO String
errHandler SomeException
_ = String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
"<Could not retrieve data>"

formatWeather
    :: WeatherOpts        -- ^ Formatting options from the cfg file
    -> [(String,String)]  -- ^ 'SkyConditionS' for 'WeatherX'
    -> [WeatherInfo]      -- ^ The actual weather info
    -> Monitor String
formatWeather :: WeatherOpts
-> [(String, String)] -> [WeatherInfo] -> Monitor String
formatWeather WeatherOpts
opts [(String, String)]
sks [WI String
st String
ss String
y String
m String
d String
h WindInfo
wind String
v String
sk String
we Int
tC Int
tF Int
dC Int
dF Int
r Int
p] =
    do let WindInfo String
wc String
wa String
wm String
wk String
wkh String
wms = WindInfo
wind
       cel <- (Int -> String) -> Int -> Monitor String
forall a. (Num a, Ord a) => (a -> String) -> a -> Monitor String
showWithColors Int -> String
forall a. Show a => a -> String
show Int
tC
       far <- showWithColors show tF
       let we' = String -> ShowS
showWeather (WeatherOpts -> String
weatherString WeatherOpts
opts) String
we
           sk' = [(String, String)] -> String -> ShowS
forall {t} {t}. Eq t => [(t, t)] -> t -> t -> t
findSk [(String, String)]
sks ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
sk) String
we'
           we'' = [(String, String)] -> String -> ShowS
forall {t} {t}. Eq t => [(t, t)] -> t -> t -> t
findSk [(String, String)]
sks ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
we') String
sk'
       parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh
                     , wms, v, sk, sk', we', we'', cel, far
                     , show dC, show dF, show r , show p ]
       where findSk :: [(t, t)] -> t -> t -> t
findSk ((t
a,t
b):[(t, t)]
xs) t
x t
df = if t
a t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
x then t
b else [(t, t)] -> t -> t -> t
findSk [(t, t)]
xs t
x t
df
             findSk [] t
_ t
df = t
df
formatWeather WeatherOpts
_ [(String, String)]
_ [WeatherInfo]
_ = Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString

-- | Show the 'weather' field with a default string in case it was empty.
showWeather :: String -> String -> String
showWeather :: String -> ShowS
showWeather String
"" String
d = String
d
showWeather String
s  String
_ = String
s

-- | Start a weather monitor, create a new 'Maybe Manager', should the user have
-- chosen to use one.
startWeather'
    :: [(String, String)]  -- ^ 'SkyConditionS' replacement strings
    -> String              -- ^ Weather station
    -> [String]            -- ^ User supplied arguments
    -> Int                 -- ^ Update rate
    -> (String -> IO ())
    -> IO ()
startWeather' :: [(String, String)]
-> String -> [String] -> Int -> (String -> IO ()) -> IO ()
startWeather' [(String, String)]
sks String
station [String]
args Int
rate String -> IO ()
cb = do
    opts  <- [OptDescr (WeatherOpts -> WeatherOpts)]
-> WeatherOpts -> [String] -> IO WeatherOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (WeatherOpts -> WeatherOpts)]
options WeatherOpts
defaultOpts ([String] -> [String]
getArgvs [String]
args)
    runMD
        (station : args)
        weatherConfig
        (runWeather sks opts)
        rate
        weatherReady
        cb

-- | Same as 'startWeather'', only for 'Weather' instead of 'WeatherX', meaning
-- no 'SkyConditionS'.
startWeather :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
startWeather :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
startWeather = [(String, String)]
-> String -> [String] -> Int -> (String -> IO ()) -> IO ()
startWeather' []

-- | Run a weather monitor.
runWeather
    :: [(String, String)]  -- ^ 'SkyConditionS' replacement strings
    -> WeatherOpts         -- ^ Weather specific options
    -> [String]            -- ^ User supplied arguments
    -> Monitor String
runWeather :: [(String, String)] -> WeatherOpts -> [String] -> Monitor String
runWeather [(String, String)]
sks WeatherOpts
opts [String]
args = do
    d <- IO String -> Monitor String
forall a. IO a -> Monitor a
io (IO String -> Monitor String) -> IO String -> Monitor String
forall a b. (a -> b) -> a -> b
$ String -> IO String
getData ([String] -> String
forall a. HasCallStack => [a] -> a
head [String]
args)
    i <- io $ runP parseData d
    formatWeather opts sks i

weatherReady :: [String] -> Monitor Bool
weatherReady :: [String] -> Monitor Bool
weatherReady [String]
str = IO Bool -> Monitor Bool
forall a. IO a -> Monitor a
io (IO Bool -> Monitor Bool) -> IO Bool -> Monitor Bool
forall a b. (a -> b) -> a -> b
$ do
    initRequest <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow (String -> IO Request) -> String -> IO Request
forall a b. (a -> b) -> a -> b
$ ShowS
stationUrl ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
str
    let request = Request
initRequest { method = methodHead }

    CE.catch
        (do man <- getGlobalManager
            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 :: SomeException -> IO Bool
errHandler SomeException
_ = Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    -- | Check for and indicate any errors in the http response.
    checkResult :: Status -> Bool
    checkResult :: Status -> Bool
checkResult Status
status
        | Status -> Bool
statusIsServerError Status
status = Bool
False
        | Status -> Bool
statusIsClientError Status
status = Bool
False
        | Bool
otherwise = Bool
True