{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StrictData #-}

module Main where

import Control.Monad (when)
import Control.Monad.Writer hiding (getFirst)
import Data.Aeson
import Data.Aeson.Types (Parser)
import qualified Data.ByteString.Lazy.Char8
import qualified Data.Char
import Data.List (isInfixOf)
import qualified Data.Map
import Data.Maybe (fromMaybe)
import qualified Data.Text
import GHC.Generics
import Network.Curl
import System.Exit (exitFailure)
import System.IO (hPutStrLn, stderr)
import Text.Printf (printf)

-- Date time that easily comparable.
data SillyTime = SillyTime
  { sillyTimeDate :: !String,
    sillyTimeAMPM :: !String,
    sillyTimeTime :: !String
  }
  deriving (Ord, Eq, Show)

data CurrentCondition = CurrentCondition
  { feelsLikeF :: !String,
    cloudCover :: !String,
    humidity :: !String,
    tempF :: !String,
    weatherDesc :: !String,
    windspeedMiles :: !String,
    winddir :: !String,
    observationTime :: !SillyTime
  }
  deriving (Generic, Show)

newtype NearestArea = NearestArea
  { areaName :: String
  }
  deriving (Generic, Show)

data Astronomy = Astronomy
  { sunrise :: !SillyTime,
    sunset :: !SillyTime
  }
  deriving (Generic, Show)

data Weather = Weather
  { currentCondition :: !CurrentCondition,
    nearestArea :: !NearestArea,
    astronomy :: !Astronomy
  }
  deriving (Generic, Show)

getFirst :: Parser [a] -> Parser a
getFirst ls = do
  l <- ls
  case l of
    (a : _) -> return a
    [] -> fail "No current conditions"

instance FromJSON CurrentCondition where
  parseJSON = withObject "CurrentCondition" $ \v ->
    CurrentCondition <$> v .: "FeelsLikeF"
      <*> v .: "cloudcover"
      <*> v .: "humidity"
      <*> v .: "temp_F"
      <*> ( withArray
              "WeatherDescriptions"
              ( \vs -> do
                  concat <$> mapM (withObject "Description" (.: "value")) vs
              )
              =<< (v .: "weatherDesc")
          )
      <*> v .: "windspeedMiles"
      <*> v .: "winddir16Point"
      <*> ( withText
              "observationTime"
              ( \txt -> case Data.Text.unpack <$> Data.Text.words txt of
                  [a, b, c] -> return (SillyTime a c b)
                  _ -> fail $ printf "1 Failed to parse SillyTime [%s]" (Data.Text.unpack txt)
              )
              =<< (v .: "localObsDateTime")
          )

instance FromJSON NearestArea where
  parseJSON = withObject "NearestArea" $ \v ->
    fmap NearestArea $ do
      (areaNames :: [Object]) <- v .: "areaName"
      concat <$> mapM (.: "value") areaNames

parseAstronomy :: String -> Value -> Parser Astronomy
parseAstronomy date = withObject "Astronomy" $ \v ->
  Astronomy <$> (withText "sunrise" toSillyTime =<< (v .: "sunrise")) <*> (withText "sunset" toSillyTime =<< (v .: "sunset"))
  where
    toSillyTime str =
      case Data.Text.unpack <$> Data.Text.words str of
        [a, b] -> return $ SillyTime date b a
        _ -> fail $ printf "2 Failed to parse SillyTime [%s]" (Data.Text.unpack str)

instance FromJSON Weather where
  parseJSON = withObject "Weather" $ \v ->
    Weather
      <$> getFirst (v .: "current_condition")
      <*> getFirst (v .: "nearest_area")
      <*> ( withObject
              "Timeline"
              ( \v -> do
                  d <- v .: "date"
                  parseAstronomy d =<< getFirst (v .: "astronomy")
              )
              =<< getFirst (v .: "weather")
          )

conditionsIconDay :: [(String -> Bool, String)]
conditionsIconDay =
  [ ((== "overcast"), fc "#808080" "\63070"),
    ((== "fair"), fc "a0a0a0" "🌑"),
    ((== "clear"), fc "#ddcf04" "\58125"),
    ((== "sunny"), fc "#ddcf04" "\58125"),
    ((== "mostly clear"), fc "#00a3c4" "\57894"),
    ((== "mostly sunny"), fc "#ddcf04" "\58124"),
    ((== "partly sunny"), fc "#ddcf04" "\58124"),
    ((== "fair"), fc "#a0a0a0" "\127761"),
    ((== "cloudy"), fc "#a0a0a0" "\64143"),
    ((== "overcast"), fc "#808080" "\63070"),
    ((== "partly cloudy"), fc "#a0a0a0" "\64148"),
    ((== "mostly cloudy"), fc "#808080" "\63070"),
    ((== "considerable cloudiness"), fc "#a0a0a0" "\64381"),
    (("snow" `isInfixOf`), fc "#a0a0f0" "\58138")
  ]

conditionsIconNight :: [(String -> Bool, String)]
conditionsIconNight =
  [ ((== "clear"), fc "#00a3c4" "\61830"),
    ((== "sunny"), fc "#00a3c4" "\61830"),
    ((== "mostly clear"), fc "#00a3c4" "\57894"),
    ((== "mostly sunny"), fc "#00a3c4" "\57894"),
    ((== "partly sunny"), fc "#00a3c4" "\57894"),
    ((== "fair"), fc "#808080" "\127761"),
    ((== "cloudy"), fc "#808080" "\64143"),
    ((== "overcast"), fc "#404040" "\63070"),
    ((== "partly cloudy"), fc "#a0a0a0" "\57894"),
    ((== "mostly cloudy"), fc "#808080" "\63070"),
    ((== "considerable cloudiness"), fc "#a0a0a0" "\64381")
  ]

handleWeather :: Weather -> String
handleWeather w = execWriter $ do
  tell $ lightGrey $ fn 3 $ areaName (nearestArea w)
  tell " "
  tell $
    lightGrey $
      fn 3 $
        case winddir (currentCondition w) of
          "NE" -> "\62785"
          "NNE" -> "\62785"
          "ENE" -> "\62785"
          "SE" -> "\62810"
          "SSE" -> "\62810"
          "ESE" -> "\62810"
          "NW" -> "\62786"
          "NNW" -> "\62786"
          "WNW" -> "\62786"
          "SW" -> "\62811"
          "SSW" -> "\62811"
          "WSW" -> "\62811"
          "N" -> "\62788"
          "S" -> "\62812"
          "W" -> "\62803"
          "E" -> "\62796"
          _ -> "?"

  tell " "
  tell $ lightGrey $ fn 3 $ windspeedMiles (currentCondition w) ++ "mph"
  tell " "

  let conditions = if isNight then conditionsIconNight else conditionsIconDay
  tell $
    fn 5 $
      fromMaybe "?" $
        findMatch (map Data.Char.toLower $ weatherDesc (currentCondition w)) conditions

  tell " "
  tell $ lightGrey $ fn 3 $ printf "%s°F" (tempF $ currentCondition w)
  where
    isNight =
      observationTime (currentCondition w) < sunrise (astronomy w)
        || observationTime (currentCondition w) > sunset (astronomy w)

    lightGrey = fc "#a0a0a0"

    fn :: Int -> String -> String
    fn = printf "<fn=%d>%s</fn>"

fc :: String -> String -> String
fc = printf "<fc=%s>%s</fc>"

findMatch :: a -> [(a -> Bool, b)] -> Maybe b
findMatch a ((f, b) : fs) | f a = Just b
findMatch a (_ : fs) = findMatch a fs
findMatch _ [] = Nothing

main :: IO ()
main = do
  (code, resp) <- curlGetString "https://wttr.in?format=j2" []
  when (code /= CurlOK) exitFailure

  case eitherDecode (Data.ByteString.Lazy.Char8.pack resp) of
    Left err -> hPutStrLn stderr $ printf "Failure to parse [%s]" err
    Right weather -> putStrLn $ handleWeather weather