{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}

module Web.OpenWeatherMap.Types.CurrentWeather
  ( CurrentWeather(..)
  ) where

import GHC.Generics (Generic)
import Prelude hiding (id)

import Data.Aeson (FromJSON)

import Web.OpenWeatherMap.Types.Clouds (Clouds)
import Web.OpenWeatherMap.Types.Coord (Coord)
import Web.OpenWeatherMap.Types.Main (Main)
import Web.OpenWeatherMap.Types.Sys (Sys)
import Web.OpenWeatherMap.Types.Weather (Weather)
import Web.OpenWeatherMap.Types.Wind (Wind)

-- | Response to requests for current weather.
-- Refer to <https://openweathermap.org/current>.
data CurrentWeather =
  CurrentWeather
    { CurrentWeather -> Coord
coord :: Coord
    , CurrentWeather -> [Weather]
weather :: [Weather]
    , CurrentWeather -> String
base :: String
    , CurrentWeather -> Main
main :: Main
    , CurrentWeather -> Wind
wind :: Wind
    , CurrentWeather -> Clouds
clouds :: Clouds
    , CurrentWeather -> Int
dt :: Int
    , CurrentWeather -> Sys
sys :: Sys
    , CurrentWeather -> Int
timezone :: Int
    , CurrentWeather -> Int
id :: Int
    , CurrentWeather -> String
name :: String
    , CurrentWeather -> Int
cod :: Int
    }
  deriving (Int -> CurrentWeather -> ShowS
[CurrentWeather] -> ShowS
CurrentWeather -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CurrentWeather] -> ShowS
$cshowList :: [CurrentWeather] -> ShowS
show :: CurrentWeather -> String
$cshow :: CurrentWeather -> String
showsPrec :: Int -> CurrentWeather -> ShowS
$cshowsPrec :: Int -> CurrentWeather -> ShowS
Show, forall x. Rep CurrentWeather x -> CurrentWeather
forall x. CurrentWeather -> Rep CurrentWeather x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CurrentWeather x -> CurrentWeather
$cfrom :: forall x. CurrentWeather -> Rep CurrentWeather x
Generic, Value -> Parser [CurrentWeather]
Value -> Parser CurrentWeather
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CurrentWeather]
$cparseJSONList :: Value -> Parser [CurrentWeather]
parseJSON :: Value -> Parser CurrentWeather
$cparseJSON :: Value -> Parser CurrentWeather
FromJSON)