    {-# LANGUAGE OverloadedStrings #-}

    -- | This is a simple weather widget that polls wttr.in to retrieve the weather,
    -- instead of relying on noaa data.
    --
    -- Useful if NOAA data doesn't cover your needs, or if you just like wttr.in
    -- better.
    --
    -- For more information on how to use wttr.in, see <https://wttr.in/:help>.
    module System.Taffybar.Widget.WttrIn (textWttrNew) where

    import Control.Exception as E (handle)
    import Control.Monad.IO.Class (MonadIO)
    import Data.ByteString (ByteString)
    import Data.ByteString.Lazy (toStrict)
    import Data.Maybe (isJust)
    import qualified Data.Text as T
    import Data.Text.Encoding (decodeUtf8)
    import GI.Gtk (Widget)
    import Network.HTTP.Client
      ( HttpException,
        Request (requestHeaders),
        Response (responseBody, responseStatus),
        defaultManagerSettings,
        httpLbs,
        newManager,
        parseRequest,
      )
    import Network.HTTP.Types.Status (statusIsSuccessful)
    import System.Log.Logger (Priority (ERROR), logM)
    import System.Taffybar.Widget.Generic.PollingLabel (pollingLabelNew)
    import Text.Regex (matchRegex, mkRegex)

    -- | Creates a GTK Label widget that polls the requested wttr.in url for weather
    -- information.
    --
    -- Not compatible with image endpoints and binary data, such as the %.png%
    -- endpoints.
    --
    -- > -- Yields a label with the text "London: ⛅️  +72°F". Updates every 60
    -- > -- seconds.
    -- > textWttrNew "http://wttr.in/London?format=3" 60
    textWttrNew ::
      MonadIO m =>
      -- | URL. All non-alphanumeric characters must be properly %-encoded.
      String ->
      -- | Update Interval (in seconds)
      Double ->
      m Widget
    textWttrNew :: forall (m :: * -> *). MonadIO m => [Char] -> Double -> m Widget
    textWttrNew [Char]
    url Double
    interval = Double -> IO Text -> m Widget
    forall (m :: * -> *). MonadIO m => Double -> IO Text -> m Widget
    pollingLabelNew Double
    interval ([Char] -> IO Text
    callWttr [Char]
    url)

    -- | IO Action that calls wttr.in as per the user's request.
    callWttr :: String -> IO T.Text
    callWttr :: [Char] -> IO Text
    callWttr [Char]
    url =
      let unknownLocation :: Text -> Bool
    unknownLocation Text
    rsp =
            -- checks for a common wttr.in bug
            case Text -> Text -> Maybe Text
    T.stripPrefix Text
    "Unknown location; please try" Text
    rsp of
              Maybe Text
    Nothing -> Bool
    False
              Just Text
    strippedRsp -> Text -> Int
    T.length Text
    strippedRsp Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Text -> Int
    T.length Text
    rsp
          isImage :: [Char] -> Bool
    isImage = Maybe [[Char]] -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe [[Char]] -> Bool)
    -> ([Char] -> Maybe [[Char]]) -> [Char] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Regex -> [Char] -> Maybe [[Char]]
    matchRegex ([Char] -> Regex
    mkRegex [Char]
    ".png")
          getResponseData :: Response ByteString -> (Bool, ByteString)
    getResponseData Response ByteString
    r =
            ( Status -> Bool
    statusIsSuccessful (Status -> Bool) -> Status -> Bool
    forall a b. (a -> b) -> a -> b
    $ Response ByteString -> Status
    forall body. Response body -> Status
    responseStatus Response ByteString
    r,
              ByteString -> ByteString
    toStrict (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Response ByteString -> ByteString
    forall body. Response body -> body
    responseBody Response ByteString
    r
            )
       in do
            Manager
    manager <- ManagerSettings -> IO Manager
    newManager ManagerSettings
    defaultManagerSettings
            Request
    request <- [Char] -> IO Request
    forall (m :: * -> *). MonadThrow m => [Char] -> m Request
    parseRequest [Char]
    url
            (Bool
    isOk, ByteString
    response) <-
              (HttpException -> IO (Bool, ByteString))
    -> IO (Bool, ByteString) -> IO (Bool, ByteString)
    forall e a. Exception e => (e -> IO a) -> IO a -> IO a
    handle
                HttpException -> IO (Bool, ByteString)
    logException
                ( Response ByteString -> (Bool, ByteString)
    getResponseData
                    (Response ByteString -> (Bool, ByteString))
    -> IO (Response ByteString) -> IO (Bool, ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Request -> Manager -> IO (Response ByteString)
    httpLbs
                      (Request
    request {requestHeaders :: RequestHeaders
    requestHeaders = [(HeaderName
    "User-Agent", ByteString
    "curl")]})
                      Manager
    manager
                )
            let body :: Text
    body = ByteString -> Text
    decodeUtf8 ByteString
    response
            Text -> IO Text
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Text -> IO Text) -> Text -> IO Text
    forall a b. (a -> b) -> a -> b
    $
              if Bool -> Bool
    not Bool
    isOk Bool -> Bool -> Bool
    || [Char] -> Bool
    isImage [Char]
    url Bool -> Bool -> Bool
    || Text -> Bool
    unknownLocation Text
    body
                then Text
    "✨"
                else Text
    body

    -- Logs an Http Exception and returns wttr.in's weather unknown label.
    logException :: HttpException -> IO (Bool, ByteString)
    logException :: HttpException -> IO (Bool, ByteString)
    logException HttpException
    e = do
      let errmsg :: [Char]
    errmsg = HttpException -> [Char]
    forall a. Show a => a -> [Char]
    show HttpException
    e
      [Char] -> Priority -> [Char] -> IO ()
    logM
        [Char]
    "System.Taffybar.Widget.WttrIn"
        Priority
    ERROR
        ([Char]
    "Warning: Couldn't call wttr.in. \n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    errmsg)
      (Bool, ByteString) -> IO (Bool, ByteString)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    False, ByteString
    "✨")