{-# 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 (pollingLabelWithVariableDelayAndRefresh)
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 = IO (Text, Maybe Text, Double) -> Bool -> m Widget
forall (m :: * -> *).
MonadIO m =>
IO (Text, Maybe Text, Double) -> Bool -> m Widget
pollingLabelWithVariableDelayAndRefresh IO (Text, Maybe Text, Double)
action Bool
True
  where action :: IO (Text, Maybe Text, Double)
action = do
          rsp <- [Char] -> IO Text
callWttr [Char]
url
          return (rsp, Nothing, interval)

-- | 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 LazyByteString -> (Bool, ByteString)
getResponseData Response LazyByteString
r =
        ( Status -> Bool
statusIsSuccessful (Status -> Bool) -> Status -> Bool
forall a b. (a -> b) -> a -> b
$ Response LazyByteString -> Status
forall body. Response body -> Status
responseStatus Response LazyByteString
r,
          LazyByteString -> ByteString
toStrict (LazyByteString -> ByteString) -> LazyByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response LazyByteString -> LazyByteString
forall body. Response body -> body
responseBody Response LazyByteString
r
        )
   in do
        manager <- ManagerSettings -> IO Manager
newManager ManagerSettings
defaultManagerSettings
        request <- parseRequest url
        (isOk, response) <-
          handle
            logException
            ( getResponseData
                <$> httpLbs
                  (request {requestHeaders = [("User-Agent", "curl")]})
                  manager
            )
        let body = ByteString -> Text
decodeUtf8 ByteString
response
        return $
          if not isOk || isImage url || unknownLocation body
            then "✨"
            else 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
"✨")