    {-# LANGUAGE OverloadedStrings #-}
    -- | This module defines a simple textual weather widget that polls
    -- NOAA for weather data.  To find your weather station, you can use
    -- either of the following:
    --
    -- <https://www.weather.gov/tg/siteloc>
    -- <https://cnrfc.noaa.gov/metar.php>
    --
    -- For example, Madison, WI is KMSN.
    --
    -- NOAA provides several pieces of information in each request; you can control
    -- which pieces end up in your weather widget by providing a _template_ that is
    -- filled in with the current information. The template is just a 'String' with
    -- variables between dollar signs. The variables will be substituted with real
    -- data by the widget. Example:
    --
    -- > let wcfg = (defaultWeatherConfig "KMSN") { weatherTemplate = "$tempC$ C @ $humidity$" }
    -- >     weatherWidget = weatherNew wcfg 10
    --
    -- This example makes a new weather widget that checks the weather at KMSN
    -- (Madison, WI) every 10 minutes, and displays the results in Celcius.
    --
    -- Available variables:
    --
    -- [@stationPlace@] The name of the weather station
    --
    -- [@stationState@] The state that the weather station is in
    --
    -- [@year@] The year the report was generated
    --
    -- [@month@] The month the report was generated
    --
    -- [@day@] The day the report was generated
    --
    -- [@hour@] The hour the report was generated
    --
    -- [@wind@] The direction and strength of the wind
    --
    -- [@visibility@] Description of current visibility conditions
    --
    -- [@skyCondition@] ?
    --
    -- [@tempC@] The temperature in Celsius
    --
    -- [@tempF@] The temperature in Farenheit
    --
    -- [@dewPoint@] The current dew point
    --
    -- [@humidity@] The current relative humidity
    --
    -- [@pressure@] The current pressure
    --
    --
    -- As an example, a template like
    --
    -- > "$tempF$ °F"
    --
    -- would yield a widget displaying the temperature in Farenheit with a small
    -- label after it.
    --
    -- Implementation Note: the weather data parsing code is taken from xmobar. This
    -- version of the code makes direct HTTP requests instead of invoking a separate
    -- cURL process.

    module System.Taffybar.Widget.Weather
      ( WeatherConfig(..)
      , WeatherInfo(..)
      , WeatherFormatter(WeatherFormatter)
      , weatherNew
      , weatherCustomNew
      , defaultWeatherConfig
      ) where

    import Control.Monad.IO.Class
    import qualified Data.ByteString.Lazy as LB
    import Data.List (stripPrefix)
    import Data.Maybe (fromMaybe)
    import qualified Data.Text as T
    import qualified Data.Text.Encoding as T
    import GI.GLib(markupEscapeText)
    import GI.Gtk
    import Network.HTTP.Client
    import Network.HTTP.Client.TLS (tlsManagerSettings)
    import Network.HTTP.Types.Status
    import System.Log.Logger
    import Text.Parsec
    import Text.Printf
    import Text.StringTemplate

    import System.Taffybar.Widget.Generic.PollingLabel

    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 -> String
    wind :: String
      , WeatherInfo -> String
    visibility :: String
      , WeatherInfo -> String
    skyCondition :: String
      , WeatherInfo -> Int
    tempC :: Int
      , WeatherInfo -> Int
    tempF :: Int
      , WeatherInfo -> String
    dewPoint :: String
      , 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)

    -- Parsers stolen from xmobar

    type Parser = Parsec String ()

    pTime :: Parser (String, String, String, String)
    pTime :: Parser (String, String, String, String)
    pTime = do
      String
    y <- Parser String
    getNumbersAsString
      Char
    _ <- 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
    _ <- 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
    _ <- 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
    _ <- 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 a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    y, String
    m, String
    d , [Char
    h]String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char
    hh]String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ":"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[Char
    mi]String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    mimi)

    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
    ' '
      String
    _ <- 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
    ' '
      Char
    _ <- ParsecT String () Identity Char
    skipRestOfLine
      (Int, Int) -> Parser (Int, Int)
    forall a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Double -> Int
    forall b. Integral b => Double -> b
    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 b. Integral b => Double -> b
    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 (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
    -> 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 a. a -> ParsecT String () Identity a
    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
      String
    _ <- 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
    ' '
      Char
    _ <- ParsecT String () Identity Char
    skipRestOfLine
      Int -> Parser Int
    forall a. a -> ParsecT String () Identity a
    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

    parseData :: Parser WeatherInfo
    parseData :: Parser WeatherInfo
    parseData = do
      String
    st <- String -> Parser String
    getAllBut String
    ","
      Char
    _ <- 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
    _ <- ParsecT String () Identity Char
    skipRestOfLine ParsecT String () Identity Char -> Parser String -> Parser 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 -> Parser String
    getAllBut String
    "/"
      (String
    y,String
    m,String
    d,String
    h) <- Parser (String, String, String, String)
    pTime
      String
    w <- String -> Parser String
    getAfterString String
    "Wind: "
      String
    v <- String -> Parser String
    getAfterString String
    "Visibility: "
      String
    sk <- String -> Parser String
    getAfterString String
    "Sky conditions: "
      String
    _ <- String -> Parser String
    skipTillString String
    "Temperature: "
      (Int
    tC,Int
    tF) <- Parser (Int, Int)
    pTemp
      String
    dp <- String -> Parser String
    getAfterString String
    "Dew Point: "
      String
    _ <- String -> Parser String
    skipTillString String
    "Relative Humidity: "
      Int
    rh <- Parser Int
    pRh
      String
    _ <- String -> Parser String
    skipTillString String
    "Pressure (altimeter): "
      Int
    p <- Parser Int
    pPressure
      String
    _ <- 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 a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WeatherInfo -> Parser WeatherInfo)
    -> WeatherInfo -> Parser WeatherInfo
    forall a b. (a -> b) -> a -> b
    $ String
    -> String
    -> String
    -> String
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Int
    -> Int
    -> String
    -> Int
    -> Int
    -> WeatherInfo
    WI String
    st String
    ss String
    y String
    m String
    d String
    h String
    w String
    v String
    sk Int
    tC Int
    tF String
    dp Int
    rh Int
    p

    getAllBut :: String -> Parser String
    getAllBut :: String -> Parser String
    getAllBut 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 (String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    s) (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)
    -> Char -> ParsecT String () Identity Char
    forall a b. (a -> b) -> a -> b
    $ String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    s)

    getAfterString :: String -> Parser String
    getAfterString :: String -> Parser String
    getAfterString String
    s = Parser String
    pAfter Parser String -> Parser String -> Parser String
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> String -> Parser String
    forall a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    "<" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " not found!>")
      where
        pAfter :: Parser String
    pAfter = do
          String
    _ <- Parser String -> Parser String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
    try (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ 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 (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ String -> Parser String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    string 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
    anyChar ParsecT String () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline

    skipTillString :: String -> Parser String
    skipTillString :: String -> Parser String
    skipTillString String
    s =
        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 (Parser String -> Parser String) -> Parser String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ String -> Parser String
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m String
    string String
    s

    getNumbersAsString :: Parser String
    getNumbersAsString :: Parser String
    getNumbersAsString = ParsecT String () Identity Char -> ParsecT String () Identity ()
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
    skipMany ParsecT String () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    space ParsecT String () Identity () -> Parser String -> Parser 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
    >> ParsecT String () Identity Char -> Parser String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 ParsecT String () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    digit Parser String -> (String -> Parser String) -> Parser String
    forall a b.
    ParsecT String () Identity a
    -> (a -> ParsecT String () Identity b)
    -> ParsecT String () Identity b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \String
    n -> String -> Parser String
    forall a. a -> ParsecT String () Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    n

    skipRestOfLine :: Parser Char
    skipRestOfLine :: ParsecT String () Identity Char
    skipRestOfLine = do
      String
    _ <- ParsecT String () Identity Char -> Parser String
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many (ParsecT String () Identity Char -> Parser String)
    -> ParsecT String () Identity Char -> Parser String
    forall a b. (a -> b) -> a -> b
    $ String -> ParsecT String () Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf String
    "\n\r"
      ParsecT String () Identity Char
    forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
    newline

    -- | Simple: download the document at a URL.
    downloadURL :: Manager -> Request -> IO (Either String String)
    downloadURL :: Manager -> Request -> IO (Either String String)
    downloadURL Manager
    mgr Request
    request = do
      Response ByteString
    response <- Request -> Manager -> IO (Response ByteString)
    httpLbs Request
    request Manager
    mgr
      case Response ByteString -> Status
    forall body. Response body -> Status
    responseStatus Response ByteString
    response of
        Status
    s | Status
    s Status -> Status -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Status
    status200 Bool -> Bool -> Bool
    && Status
    s Status -> Status -> Bool
    forall a. Ord a => a -> a -> Bool
    < Status
    status300 ->
          Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> Either String String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String -> Either String String
    forall a b. b -> Either a b
    Right (Text -> String
    T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Text
    T.decodeUtf8 (ByteString -> Text)
    -> (ByteString -> ByteString) -> ByteString -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    LB.toStrict (ByteString -> String) -> ByteString -> String
    forall a b. (a -> b) -> a -> b
    $ Response ByteString -> ByteString
    forall body. Response body -> body
    responseBody Response ByteString
    response)
        Status
    otherStatus ->
          Either String String -> IO (Either String String)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String String -> IO (Either String String))
    -> (String -> Either String String)
    -> String
    -> IO (Either String String)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Either String String
    forall a b. a -> Either a b
    Left (String -> IO (Either String String))
    -> String -> IO (Either String String)
    forall a b. (a -> b) -> a -> b
    $ String
    "HTTP 2XX status was expected but received " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Status -> String
    forall a. Show a => a -> String
    show Status
    otherStatus

    getWeather :: Manager -> String -> IO (Either String WeatherInfo)
    getWeather :: Manager -> String -> IO (Either String WeatherInfo)
    getWeather Manager
    mgr String
    url = do
      Request
    request <- String -> IO Request
    forall (m :: * -> *). MonadThrow m => String -> m Request
    parseRequest String
    url
      Either String String
    dat <- Manager -> Request -> IO (Either String String)
    downloadURL Manager
    mgr Request
    request
      case Either String String
    dat of
        Right String
    dat' -> case Parser WeatherInfo
    -> String -> String -> Either ParseError WeatherInfo
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse Parser WeatherInfo
    parseData String
    url String
    dat' of
          Right WeatherInfo
    d -> Either String WeatherInfo -> IO (Either String WeatherInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WeatherInfo -> Either String WeatherInfo
    forall a b. b -> Either a b
    Right WeatherInfo
    d)
          Left ParseError
    err -> Either String WeatherInfo -> IO (Either String WeatherInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String WeatherInfo
    forall a b. a -> Either a b
    Left (ParseError -> String
    forall a. Show a => a -> String
    show ParseError
    err))
        Left String
    err -> Either String WeatherInfo -> IO (Either String WeatherInfo)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String -> Either String WeatherInfo
    forall a b. a -> Either a b
    Left (ShowS
    forall a. Show a => a -> String
    show String
    err))

    defaultFormatter :: StringTemplate String -> WeatherInfo -> String
    defaultFormatter :: StringTemplate String -> WeatherInfo -> String
    defaultFormatter StringTemplate String
    tpl WeatherInfo
    wi = StringTemplate String -> String
    forall a. Stringable a => StringTemplate a -> a
    render StringTemplate String
    tpl'
      where
        tpl' :: StringTemplate String
    tpl' = [(String, String)]
    -> StringTemplate String -> StringTemplate String
    forall a b.
    (ToSElem a, Stringable b) =>
    [(String, a)] -> StringTemplate b -> StringTemplate b
    setManyAttrib [ (String
    "stationPlace", WeatherInfo -> String
    stationPlace WeatherInfo
    wi)
                             , (String
    "stationState", WeatherInfo -> String
    stationState WeatherInfo
    wi)
                             , (String
    "year", WeatherInfo -> String
    year WeatherInfo
    wi)
                             , (String
    "month", WeatherInfo -> String
    month WeatherInfo
    wi)
                             , (String
    "day", WeatherInfo -> String
    day WeatherInfo
    wi)
                             , (String
    "hour", WeatherInfo -> String
    hour WeatherInfo
    wi)
                             , (String
    "wind", WeatherInfo -> String
    wind WeatherInfo
    wi)
                             , (String
    "visibility", WeatherInfo -> String
    visibility WeatherInfo
    wi)
                             , (String
    "skyCondition", WeatherInfo -> String
    skyCondition WeatherInfo
    wi)
                             , (String
    "tempC", Int -> String
    forall a. Show a => a -> String
    show (WeatherInfo -> Int
    tempC WeatherInfo
    wi))
                             , (String
    "tempF", Int -> String
    forall a. Show a => a -> String
    show (WeatherInfo -> Int
    tempF WeatherInfo
    wi))
                             , (String
    "dewPoint", WeatherInfo -> String
    dewPoint WeatherInfo
    wi)
                             , (String
    "humidity", Int -> String
    forall a. Show a => a -> String
    show (WeatherInfo -> Int
    humidity WeatherInfo
    wi))
                             , (String
    "pressure", Int -> String
    forall a. Show a => a -> String
    show (WeatherInfo -> Int
    pressure WeatherInfo
    wi))
                             ] StringTemplate String
    tpl

    getCurrentWeather :: IO (Either String WeatherInfo)
        -> StringTemplate String
        -> StringTemplate String
        -> WeatherFormatter
        -> IO (T.Text, Maybe T.Text)
    getCurrentWeather :: IO (Either String WeatherInfo)
    -> StringTemplate String
    -> StringTemplate String
    -> WeatherFormatter
    -> IO (Text, Maybe Text)
    getCurrentWeather IO (Either String WeatherInfo)
    getter StringTemplate String
    labelTpl StringTemplate String
    tooltipTpl WeatherFormatter
    formatter = do
      Either String WeatherInfo
    dat <- IO (Either String WeatherInfo)
    getter
      case Either String WeatherInfo
    dat of
        Right WeatherInfo
    wi ->
          case WeatherFormatter
    formatter of
            WeatherFormatter
    DefaultWeatherFormatter -> do
              let rawLabel :: Text
    rawLabel = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ StringTemplate String -> WeatherInfo -> String
    defaultFormatter StringTemplate String
    labelTpl WeatherInfo
    wi
              let rawTooltip :: Text
    rawTooltip = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ StringTemplate String -> WeatherInfo -> String
    defaultFormatter StringTemplate String
    tooltipTpl WeatherInfo
    wi
              Text
    lbl <- Text -> Int64 -> IO Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    markupEscapeText Text
    rawLabel (-Int64
    1)
              Text
    tooltip <- Text -> Int64 -> IO Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    markupEscapeText Text
    rawTooltip (-Int64
    1)
              (Text, Maybe Text) -> IO (Text, Maybe Text)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    lbl, Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    tooltip)
            WeatherFormatter WeatherInfo -> String
    f -> do
              let rawLabel :: Text
    rawLabel = String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ WeatherInfo -> String
    f WeatherInfo
    wi
              Text
    lbl <- Text -> Int64 -> IO Text
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Int64 -> m Text
    markupEscapeText Text
    rawLabel (-Int64
    1)
              (Text, Maybe Text) -> IO (Text, Maybe Text)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    lbl, Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    lbl)
        Left String
    err -> do
          String -> Priority -> String -> IO ()
    logM String
    "System.Taffybar.Widget.Weather" Priority
    ERROR (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Error in weather: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> ShowS
    forall a. Show a => a -> String
    show String
    err
          (Text, Maybe Text) -> IO (Text, Maybe Text)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text
    "N/A", Maybe Text
    forall a. Maybe a
    Nothing)

    -- | The NOAA URL to get data from
    baseUrl :: String
    baseUrl :: String
    baseUrl = String
    "https://tgftp.nws.noaa.gov/data/observations/metar/decoded"

    -- | A wrapper to allow users to specify a custom weather formatter.
    -- The default interpolates variables into a string as described
    -- above.  Custom formatters can do basically anything.
    data WeatherFormatter
      = WeatherFormatter (WeatherInfo -> String) -- ^ Specify a custom formatter for 'WeatherInfo'
      | DefaultWeatherFormatter -- ^ Use the default StringTemplate formatter

    -- | The configuration for the weather widget.  You can provide a custom
    -- format string through 'weatherTemplate' as described above, or you can
    -- provide a custom function to turn a 'WeatherInfo' into a String via the
    -- 'weatherFormatter' field.
    data WeatherConfig = WeatherConfig
      { WeatherConfig -> String
    weatherStation :: String -- ^ The weather station to poll. No default
      , WeatherConfig -> String
    weatherTemplate :: String -- ^ Template string, as described above.  Default: $tempF$ °F
      , WeatherConfig -> String
    weatherTemplateTooltip :: String -- ^ Template string, as described above.  Default: $tempF$ °F
      , WeatherConfig -> WeatherFormatter
    weatherFormatter :: WeatherFormatter -- ^ Default: substitute in all interpolated variables (above)
      , WeatherConfig -> Maybe String
    weatherProxy :: Maybe String -- ^ The proxy server, e.g. "http://proxy:port". Default: Nothing
      }

    -- | A sensible default configuration for the weather widget that just
    -- renders the temperature.
    defaultWeatherConfig :: String -> WeatherConfig
    defaultWeatherConfig :: String -> WeatherConfig
    defaultWeatherConfig String
    station =
      WeatherConfig
      { weatherStation :: String
    weatherStation = String
    station
      , weatherTemplate :: String
    weatherTemplate = String
    "$tempF$ °F"
      , weatherTemplateTooltip :: String
    weatherTemplateTooltip =
          [String] -> String
    unlines
            [ String
    "Station: $stationPlace$"
            , String
    "Time: $day$.$month$.$year$ $hour$"
            , String
    "Temperature: $tempF$ °F"
            , String
    "Pressure: $pressure$ hPa"
            , String
    "Wind: $wind$"
            , String
    "Visibility: $visibility$"
            , String
    "Sky Condition: $skyCondition$"
            , String
    "Dew Point: $dewPoint$"
            , String
    "Humidity: $humidity$"
            ]
      , weatherFormatter :: WeatherFormatter
    weatherFormatter = WeatherFormatter
    DefaultWeatherFormatter
      , weatherProxy :: Maybe String
    weatherProxy = Maybe String
    forall a. Maybe a
    Nothing
      }

    -- | Create a periodically-updating weather widget that polls NOAA.
    weatherNew :: MonadIO m
               => WeatherConfig -- ^ Configuration to render
               -> Double     -- ^ Polling period in _minutes_
               -> m GI.Gtk.Widget
    weatherNew :: forall (m :: * -> *).
    MonadIO m =>
    WeatherConfig -> Double -> m Widget
    weatherNew WeatherConfig
    cfg Double
    delayMinutes = IO Widget -> m Widget
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $ do
      -- TODO: add explicit proxy host/port to WeatherConfig and
      -- get rid of this ugly stringly-typed setting
      let usedProxy :: ProxyOverride
    usedProxy = case WeatherConfig -> Maybe String
    weatherProxy WeatherConfig
    cfg of
            Maybe String
    Nothing -> ProxyOverride
    noProxy
            Just String
    str ->
              let strToBs :: String -> ByteString
    strToBs = Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack
                  noHttp :: String
    noHttp = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    str (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix String
    "http://" String
    str
                  (ByteString
    phost, Int
    pport) = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char
    ':'Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=) String
    noHttp of
                    (String
    h, String
    "") -> (String -> ByteString
    strToBs String
    h, Int
    80) -- HTTP seems to assume 80 to be the default
                    (String
    h, Char
    ':':String
    p) -> (String -> ByteString
    strToBs String
    h, String -> Int
    forall a. Read a => String -> a
    read String
    p)
                    (String, String)
    _ -> String -> (ByteString, Int)
    forall a. HasCallStack => String -> a
    error String
    "unreachable: broken span"
              in Proxy -> ProxyOverride
    useProxy (Proxy -> ProxyOverride) -> Proxy -> ProxyOverride
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int -> Proxy
    Proxy ByteString
    phost Int
    pport
      Manager
    mgr <- ManagerSettings -> IO Manager
    newManager (ManagerSettings -> IO Manager) -> ManagerSettings -> IO Manager
    forall a b. (a -> b) -> a -> b
    $ ProxyOverride -> ManagerSettings -> ManagerSettings
    managerSetProxy ProxyOverride
    usedProxy ManagerSettings
    tlsManagerSettings
      let url :: String
    url = String -> String -> ShowS
    forall r. PrintfType r => String -> r
    printf String
    "%s/%s.TXT" String
    baseUrl (WeatherConfig -> String
    weatherStation WeatherConfig
    cfg)
      let getter :: IO (Either String WeatherInfo)
    getter = Manager -> String -> IO (Either String WeatherInfo)
    getWeather Manager
    mgr String
    url
      IO (Either String WeatherInfo)
    -> String -> String -> WeatherFormatter -> Double -> IO Widget
    forall (m :: * -> *).
    MonadIO m =>
    IO (Either String WeatherInfo)
    -> String -> String -> WeatherFormatter -> Double -> m Widget
    weatherCustomNew IO (Either String WeatherInfo)
    getter (WeatherConfig -> String
    weatherTemplate WeatherConfig
    cfg) (WeatherConfig -> String
    weatherTemplateTooltip WeatherConfig
    cfg)
        (WeatherConfig -> WeatherFormatter
    weatherFormatter WeatherConfig
    cfg) Double
    delayMinutes

    -- | Create a periodically-updating weather widget using custom weather getter
    weatherCustomNew
      :: MonadIO m
      => IO (Either String WeatherInfo) -- ^ Weather querying action
      -> String -- ^ Weather template
      -> String -- ^ Weather template
      -> WeatherFormatter -- ^ Weather formatter
      -> Double -- ^ Polling period in _minutes_
      -> m GI.Gtk.Widget
    weatherCustomNew :: forall (m :: * -> *).
    MonadIO m =>
    IO (Either String WeatherInfo)
    -> String -> String -> WeatherFormatter -> Double -> m Widget
    weatherCustomNew IO (Either String WeatherInfo)
    getter String
    labelTpl String
    tooltipTpl WeatherFormatter
    formatter Double
    delayMinutes = IO Widget -> m Widget
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
    forall a b. (a -> b) -> a -> b
    $ do
      let labelTpl' :: StringTemplate String
    labelTpl' = String -> StringTemplate String
    forall a. Stringable a => String -> StringTemplate a
    newSTMP String
    labelTpl
          tooltipTpl' :: StringTemplate String
    tooltipTpl' = String -> StringTemplate String
    forall a. Stringable a => String -> StringTemplate a
    newSTMP String
    tooltipTpl

      Widget
    l <- Double -> IO (Text, Maybe Text) -> IO Widget
    forall (m :: * -> *).
    MonadIO m =>
    Double -> IO (Text, Maybe Text) -> m Widget
    pollingLabelNewWithTooltip (Double
    delayMinutes Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    60)
           (IO (Either String WeatherInfo)
    -> StringTemplate String
    -> StringTemplate String
    -> WeatherFormatter
    -> IO (Text, Maybe Text)
    getCurrentWeather IO (Either String WeatherInfo)
    getter StringTemplate String
    labelTpl' StringTemplate String
    tooltipTpl' WeatherFormatter
    formatter)

      Widget -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    GI.Gtk.widgetShowAll Widget
    l
      Widget -> IO Widget
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Widget
    l