{-# 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 :: String -> WeatherOpts
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 :: String
weatherString = String
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
"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
showList :: [WindInfo] -> ShowS
$cshowList :: [WindInfo] -> ShowS
show :: WindInfo -> String
$cshow :: WindInfo -> String
showsPrec :: Int -> WindInfo -> ShowS
$cshowsPrec :: Int -> 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
showList :: [WeatherInfo] -> ShowS
$cshowList :: [WeatherInfo] -> ShowS
show :: WeatherInfo -> String
$cshow :: WeatherInfo -> String
showsPrec :: Int -> WeatherInfo -> ShowS
$cshowsPrec :: Int -> WeatherInfo -> ShowS
Show)

pTime :: Parser (String, String, String, String)
pTime :: Parser (String, String, String, String)
pTime = do String
y <- Parser String
getNumbersAsString
           Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
           String
m <- Parser String
getNumbersAsString
           Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.'
           String
d <- Parser String
getNumbersAsString
           Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
           (Char
h:Char
hh:Char
mi:String
mimi) <- Parser String
getNumbersAsString
           Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
' '
           (String, String, String, String)
-> Parser (String, String, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
y, String
m, String
d ,Char
hChar -> ShowS
forall a. a -> [a] -> [a]
:Char
hhChar -> ShowS
forall a. a -> [a] -> [a]
:String
":"String -> ShowS
forall a. [a] -> [a] -> [a]
++Char
miChar -> ShowS
forall a. a -> [a] -> [a]
:String
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 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 (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 ")
                   String
mph <- Parser String
forall u. ParsecT String u Identity String
tospace
                   String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"MPH ("
                   String
knot <- Parser String
forall u. ParsecT String u Identity String
tospace
                   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
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
                   WindInfo -> Parser WindInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (WindInfo -> Parser WindInfo) -> WindInfo -> Parser WindInfo
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> String -> String -> WindInfo
WindInfo String
"μ" String
"μ" String
mph String
knot (ShowS
toKmh String
knot) (ShowS
toMs String
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 ")
                String
cardinal <- Parser String
forall u. ParsecT String u Identity String
tospace
                Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
                String
azimuth <- Parser String
forall u. ParsecT String u Identity String
tospace
                String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"degrees) at "
                String
mph <- Parser String
forall u. ParsecT String u Identity String
tospace
                String -> Parser String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"MPH ("
                String
knot <- Parser String
forall u. ParsecT String u Identity String
tospace
                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
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
                WindInfo -> Parser WindInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (WindInfo -> Parser WindInfo) -> WindInfo -> Parser WindInfo
forall a b. (a -> b) -> a -> b
$ String
-> String -> String -> String -> String -> String -> WindInfo
WindInfo String
cardinal String
azimuth String
mph String
knot (ShowS
toKmh String
knot) (ShowS
toMs String
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 (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
'.'
           String
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
' '
           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
'('
           String
c <- 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
' '
           ParsecT String () Identity Char
skipRestOfLine
           (Int, Int) -> Parser (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (String -> Double
forall a. Read a => String -> a
read String
c :: Double), Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (String -> Double
forall a. Read a => String -> a
read String
f :: Double))

pRh :: Parser Int
pRh :: Parser Int
pRh = do String
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
'.')
         Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
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
'('
               String
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
' '
               ParsecT String () Identity Char
skipRestOfLine
               Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. Read a => String -> a
read String
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 (String
st, String
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String, String) -> GenParser Char () (String, String)
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 String
st <- String -> Parser String
getAllBut String
","
                       ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
                       String
ss <- String -> Parser String
getAllBut String
"("
                       (String, String) -> GenParser Char () (String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
st, String
ss)
                   )
       ParsecT String () Identity Char
skipRestOfLine ParsecT String () Identity Char -> Parser String -> Parser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser String
getAllBut String
"/"
       (String
y,String
m,String
d,String
h) <- Parser (String, String, String, String)
pTime
       WindInfo
w <- Parser WindInfo
pWind
       String
v <- String -> Parser String
getAfterString String
"Visibility: "
       String
sk <- String -> Parser String
getAfterString String
"Sky conditions: "
       String
we <- String -> Parser String
getAfterString String
"Weather: "
       String -> Parser String
skipTillString String
"Temperature: "
       (Int
tC,Int
tF) <- Parser (Int, Int)
pTemp
       String -> Parser String
skipTillString String
"Dew Point: "
       (Int
dC, Int
dF) <- Parser (Int, Int)
pTemp
       String -> Parser String
skipTillString String
"Relative Humidity: "
       Int
rh <- Parser Int
pRh
       String -> Parser String
skipTillString String
"Pressure (altimeter): "
       Int
p <- Parser Int
pPressure
       ParsecT String () Identity Char
-> ParsecT String () Identity () -> 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 ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
       [WeatherInfo] -> Parser [WeatherInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
-> String
-> String
-> String
-> String
-> String
-> WindInfo
-> String
-> String
-> String
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> WeatherInfo
WI String
st String
ss String
y String
m String
d String
h WindInfo
w String
v String
sk String
we Int
tC Int
tF Int
dC Int
dF Int
rh Int
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
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
        Manager
man <- IO Manager
getGlobalManager
        Response ByteString
res <- Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
request Manager
man
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ ByteString -> String
B.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res)
    SomeException -> IO String
errHandler
  where
    errHandler :: CE.SomeException -> IO String
    errHandler :: SomeException -> IO String
errHandler SomeException
_ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"<Could not retrieve data>"

formatSk :: Eq p => [(p, p)] -> p -> p
formatSk :: [(p, p)] -> p -> p
formatSk ((p
a,p
b):[(p, p)]
sks) p
sk = if p
a p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
sk then p
b else [(p, p)] -> p -> p
forall p. Eq p => [(p, p)] -> p -> p
formatSk [(p, p)]
sks p
sk
formatSk [] p
sk = p
sk

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 String
wc String
wa String
wm String
wk String
wkh String
wms) String
v String
sk String
we Int
tC Int
tF Int
dC Int
dF Int
r Int
p] =
    do String
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
       String
far <- (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
tF
       let sk' :: String
sk' = [(String, String)] -> ShowS
forall p. Eq p => [(p, p)] -> p -> p
formatSk [(String, String)]
sks ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
sk)
           we' :: String
we' = String -> ShowS
showWeather (WeatherOpts -> String
weatherString WeatherOpts
opts) String
we
       [String] -> Monitor String
parseTemplate [String
st, String
ss, String
y, String
m, String
d, String
h, String
wc, String
wa, String
wm, String
wk, String
wkh
                     , String
wms, String
v, String
sk, String
sk', String
we', String
cel, String
far
                     , Int -> String
forall a. Show a => a -> String
show Int
dC, Int -> String
forall a. Show a => a -> String
show Int
dF, Int -> String
forall a. Show a => a -> String
show Int
r , Int -> String
forall a. Show a => a -> String
show Int
p ]
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
    WeatherOpts
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)
    [String]
-> IO MConfig
-> ([String] -> Monitor String)
-> Int
-> ([String] -> Monitor Bool)
-> (String -> IO ())
-> IO ()
runMD
        (String
station String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
args)
        IO MConfig
weatherConfig
        ([(String, String)] -> WeatherOpts -> [String] -> Monitor String
runWeather [(String, String)]
sks WeatherOpts
opts)
        Int
rate
        [String] -> Monitor Bool
weatherReady
        String -> IO ()
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
    String
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. [a] -> a
head [String]
args)
    [WeatherInfo]
i <- IO [WeatherInfo] -> Monitor [WeatherInfo]
forall a. IO a -> Monitor a
io (IO [WeatherInfo] -> Monitor [WeatherInfo])
-> IO [WeatherInfo] -> Monitor [WeatherInfo]
forall a b. (a -> b) -> a -> b
$ Parser [WeatherInfo] -> String -> IO [WeatherInfo]
forall a. Parser [a] -> String -> IO [a]
runP Parser [WeatherInfo]
parseData String
d
    WeatherOpts
-> [(String, String)] -> [WeatherInfo] -> Monitor String
formatWeather WeatherOpts
opts [(String, String)]
sks [WeatherInfo]
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
    Request
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. [a] -> a
head [String]
str
    let request :: Request
request = Request
initRequest { method :: Method
method = Method
methodHead }

    IO Bool -> (SomeException -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
CE.catch
        (do Manager
man <- IO Manager
getGlobalManager
            Response ByteString
res  <- Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
request Manager
man
            Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Status -> Bool
checkResult (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
res)
        SomeException -> IO Bool
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 (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