From 0b1981ef40404802a828f2a91ecadba3c2453034 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Sun, 19 Apr 2020 12:26:49 +0200 Subject: Add forecast weather API --- README.md | 32 +++++- cmd/Main.hs | 124 ++++++----------------- cmd/Print.hs | 125 ++++++++++++++++++++++++ lib/Web/OpenWeatherMap/API.hs | 26 ++++- lib/Web/OpenWeatherMap/Client.hs | 22 +++-- lib/Web/OpenWeatherMap/Types/City.hs | 21 ++++ lib/Web/OpenWeatherMap/Types/Coord.hs | 4 +- lib/Web/OpenWeatherMap/Types/Forecast.hs | 23 +++++ lib/Web/OpenWeatherMap/Types/ForecastWeather.hs | 20 ++++ openweathermap.cabal | 5 + 10 files changed, 296 insertions(+), 106 deletions(-) create mode 100644 cmd/Print.hs create mode 100644 lib/Web/OpenWeatherMap/Types/City.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Forecast.hs create mode 100644 lib/Web/OpenWeatherMap/Types/ForecastWeather.hs diff --git a/README.md b/README.md index 607c523..5269074 100644 --- a/README.md +++ b/README.md @@ -22,8 +22,9 @@ Usage ----- ``` -Usage: openweathermap ([-K|--api-key-file APIKEYFILE] | [-k|--api-key APIKEY]) - ((-c|--city CITY) | --lat NUM --lon NUM) [-d|--debug] +Usage: openweathermap [(-K|--api-key-file APIKEYFILE) | (-k|--api-key APIKEY)] + ((-c|--city CITY) | --lat NUM --lon NUM) + [(-n|--current) | (-f|--forecast)] [-d|--debug] Available options: -K,--api-key-file APIKEYFILE @@ -32,6 +33,8 @@ Available options: -c,--city CITY City name --lat NUM Latitude in decimal degrees --lon NUM Longitude in decimal degrees + -n,--current current weather (default) + -f,--forecast forecast weather -d,--debug Enable debug -h,--help Show this help text @@ -51,6 +54,31 @@ Norilsk,RU (69.35°, 88.2°): Clouds, H 100 %, P 753 mmHg, T +4 °C, ↓ 1 m $ openweathermap --lat 55.7522200 --lon 37.6155600 Moscow,RU (55.75°, 37.62°): Clear, H 45 %, P 762 mmHg, T +18..+21 °C, → 4 m/s + +$ openweathermap -c kaliningrad -f +Kaliningrad,RU (54.7065°, 20.511°) +2020-04-19 17:00:00 +0200: Clear, H 66 %, P 767 mmHg, T +7 °C, ↓ 7 m/s +2020-04-19 20:00:00 +0200: Clear, H 79 %, P 768 mmHg, T +4 °C, ↓ 5 m/s +2020-04-19 23:00:00 +0200: Clear, H 84 %, P 769 mmHg, T +3 °C, ↓ 4 m/s +2020-04-20 02:00:00 +0200: Clear, H 85 %, P 770 mmHg, T +3 °C, ↓ 3 m/s +2020-04-20 05:00:00 +0200: Clear, H 84 %, P 770 mmHg, T +2 °C, ↓ 3 m/s +2020-04-20 08:00:00 +0200: Clear, H 76 %, P 770 mmHg, T +5 °C, ↓ 4 m/s +2020-04-20 11:00:00 +0200: Clear, H 65 %, P 771 mmHg, T +8 °C, ↓ 4 m/s +2020-04-20 14:00:00 +0200: Clear, H 62 %, P 771 mmHg, T +9 °C, ↓ 4 m/s +... + +$ openweathermap --lat -12.0432 --lon -77.0282 -f +Lima,PE (-12.0432°, -77.0282°) +2020-04-19 10:00:00 -0500: Clear, H 70 %, P 764 mmHg, T +22..+24 °C, ↗ 3 m/s +2020-04-19 13:00:00 -0500: Clear, H 64 %, P 762 mmHg, T +23..+25 °C, ↗ 4 m/s +2020-04-19 16:00:00 -0500: Clouds, H 66 %, P 761 mmHg, T +23..+24 °C, ↑ 4 m/s +2020-04-19 19:00:00 -0500: Clouds, H 72 %, P 763 mmHg, T +22 °C, ↑ 4 m/s +2020-04-19 22:00:00 -0500: Clouds, H 72 %, P 764 mmHg, T +22 °C, ↑ 3 m/s +2020-04-20 01:00:00 -0500: Clouds, H 76 %, P 763 mmHg, T +21 °C, ↑ 2 m/s +2020-04-20 04:00:00 -0500: Clear, H 80 %, P 763 mmHg, T +20 °C, ↑ 3 m/s +2020-04-20 07:00:00 -0500: Clouds, H 79 %, P 764 mmHg, T +20 °C, ↑ 3 m/s +2020-04-20 10:00:00 -0500: Clouds, H 72 %, P 764 mmHg, T +21 °C, ↗ 3 m/s +... ``` diff --git a/cmd/Main.hs b/cmd/Main.hs index aeb5d6f..6349dde 100644 --- a/cmd/Main.hs +++ b/cmd/Main.hs @@ -5,7 +5,6 @@ module Main ) where import Control.Monad (when) -import Data.List (intercalate) import Data.Semigroup ((<>)) import Data.Version (showVersion) import System.Exit (die) @@ -17,6 +16,7 @@ import Options.Applicative , (<|>) , auto , execParser + , flag' , fullDesc , header , help @@ -33,14 +33,10 @@ import Options.Applicative import System.Directory (createDirectoryIfMissing) import System.Environment.XDG.BaseDir (getUserConfigDir, getUserConfigFile) -import Paths_openweathermap (version) -- from cabal import qualified Web.OpenWeatherMap.Client as Client -import qualified Web.OpenWeatherMap.Types.Coord as Coord -import qualified Web.OpenWeatherMap.Types.CurrentWeather as CurrentWeather -import qualified Web.OpenWeatherMap.Types.Main as Main -import qualified Web.OpenWeatherMap.Types.Sys as Sys -import qualified Web.OpenWeatherMap.Types.Weather as Weather -import qualified Web.OpenWeatherMap.Types.Wind as Wind + +import Paths_openweathermap (version) -- from cabal +import Print (printCurrectWeather, printForecastWeather) appName :: String appName = "openweathermap" @@ -77,15 +73,28 @@ parseApiKey = fromFile <|> inCmdLine strOption (long "api-key" <> short 'k' <> metavar "APIKEY" <> help "API key") +data Weather + = Current + | Forecast + +parseWeather :: Parser Weather +parseWeather = + flag' + Current + (long "current" <> short 'n' <> help "current weather (default)") <|> + flag' Forecast (long "forecast" <> short 'f' <> help "forecast weather") <|> + pure Current + data Config = Config { apikey :: Maybe ApiKey , location :: Client.Location + , weather :: Weather , debug :: Bool } parseConfig :: Parser Config parseConfig = - Config <$> optional parseApiKey <*> parseLocation <*> + Config <$> optional parseApiKey <*> parseLocation <*> parseWeather <*> switch (long "debug" <> short 'd' <> help "Enable debug") getApiKey :: Maybe ApiKey -> IO String @@ -95,93 +104,22 @@ getApiKey Nothing = do createDirectoryIfMissing True =<< getUserConfigDir appName getUserConfigFile appName "key" >>= getApiKey . Just . ApiKeyFile -showLocation :: CurrentWeather.CurrentWeather -> String -showLocation w = city ++ maybe "" ("," ++) country ++ " " ++ coords - where - name = CurrentWeather.name w - coord = CurrentWeather.coord w - country = Sys.country . CurrentWeather.sys $ w - city = - if name /= "" - then name - else "" - coords = - "(" ++ show (Coord.lat coord) ++ "°, " ++ show (Coord.lon coord) ++ "°)" - -showWeather :: [Weather.Weather] -> String -showWeather w = intercalate "," $ Weather.main <$> w - -showHumidity :: Main.Main -> String -showHumidity m = "H " ++ show hm ++ " %" - where - hm :: Int - hm = round . Main.humidity $ m - --- https://en.wikipedia.org/wiki/Millimeter_of_mercury -showPressure :: Main.Main -> String -showPressure m = "P " ++ show p ++ " mmHg" - where - hPa2mmHg hpa = hpa * 0.750061561303 - p :: Int - p = round . hPa2mmHg . Main.pressure $ m - --- https://stackoverflow.com/q/7490660/933161 -showWind :: Wind.Wind -> String -showWind w = dir ++ " " ++ show speed ++ " m/s" - where - speed :: Int - speed = round . Wind.speed $ w - deg = Wind.deg w - -- [ "N", "NE", "E", "SE", "S", "SW", "W", "NW" ] - dirs = ["↓", "↙", "←", "↖", "↑", "↗", "→", "↘"] - l = length dirs - sector = round $ (deg * fromIntegral l) / 360.0 - dir = dirs !! (sector `rem` l) - -showTemp :: Main.Main -> String -showTemp m = "T " ++ temp ++ " °C" - where - k2c k = k - 273.15 -- Kelvin to Celsius - tmax :: Int - tmin :: Int - tmax = round . k2c . Main.temp_max $ m - tmin = round . k2c . Main.temp_min $ m - show' t = - if t > 0 - then "+" ++ show t - else show t - temp = - if tmax /= tmin - then show' tmin ++ ".." ++ show' tmax - else show' tmin - -printWeather :: CurrentWeather.CurrentWeather -> IO () -printWeather w = putStrLn out - where - weather = showWeather $ CurrentWeather.weather w - place = showLocation w - mainw = CurrentWeather.main w - wind = CurrentWeather.wind w - out = - place ++ - ": " ++ - intercalate - ", " - [ weather - , showHumidity mainw - , showPressure mainw - , showTemp mainw - , showWind wind - ] - run :: Config -> IO () run cfg = do appid <- getApiKey . apikey $ cfg - Client.getWeather appid (location cfg) >>= \case - Left err -> die $ show err - Right weather -> do - when (debug cfg) $ hPrint stderr weather - printWeather weather + case weather cfg of + Current -> + Client.getWeather appid (location cfg) >>= \case + Left err -> die $ show err + Right cw -> do + when (debug cfg) $ hPrint stderr cw + printCurrectWeather cw + Forecast -> + Client.getForecast appid (location cfg) >>= \case + Left err -> die $ show err + Right fw -> do + when (debug cfg) $ hPrint stderr fw + printForecastWeather fw main :: IO () main = run =<< execParser opts diff --git a/cmd/Print.hs b/cmd/Print.hs new file mode 100644 index 0000000..dd97c45 --- /dev/null +++ b/cmd/Print.hs @@ -0,0 +1,125 @@ +module Print + ( printCurrectWeather + , printForecastWeather + ) where + +import Data.List (intercalate) +import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import Data.Time.LocalTime (TimeZone, minutesToTimeZone, utcToZonedTime) + +import qualified Web.OpenWeatherMap.Types.City as City +import qualified Web.OpenWeatherMap.Types.Coord as Coord +import qualified Web.OpenWeatherMap.Types.CurrentWeather as CW +import qualified Web.OpenWeatherMap.Types.Forecast as FC +import qualified Web.OpenWeatherMap.Types.ForecastWeather as FW +import qualified Web.OpenWeatherMap.Types.Main as Main +import qualified Web.OpenWeatherMap.Types.Sys as Sys +import qualified Web.OpenWeatherMap.Types.Weather as Weather +import qualified Web.OpenWeatherMap.Types.Wind as Wind + +printCurrectWeather :: CW.CurrentWeather -> IO () +printCurrectWeather cw = + putStrLn + (place ++ + ": " ++ + intercalate + ", " + [ w + , showHumidity mainw + , showPressure mainw + , showTemp mainw + , showWind wind + ]) + where + w = showWeather $ CW.weather cw + place = showLocation (CW.name cw) (Sys.country . CW.sys $ cw) (CW.coord cw) + mainw = CW.main cw + wind = CW.wind cw + +printForecastWeather :: FW.ForecastWeather -> IO () +printForecastWeather fw = do + let c = FW.city fw + tz = minutesToTimeZone (City.timezone c `div` 60) + place = showLocation (City.name c) (City.country c) (City.coord c) + putStrLn place + mapM_ putStrLn (showForecast tz <$> FW.list fw) + +showForecast :: TimeZone -> FC.Forecast -> String +showForecast tz fc = + localtime ++ + ": " ++ + intercalate + ", " + [ showWeather (FC.weather fc) + , showHumidity mainw + , showPressure mainw + , showTemp mainw + , showWind (FC.wind fc) + ] + where + localtime = + show . utcToZonedTime tz . posixSecondsToUTCTime . fromIntegral $ FC.dt fc + mainw = FC.main fc + +showLocation :: String -> Maybe String -> Coord.Coord -> String +showLocation name country coord = + name' ++ maybe "" ("," ++) country ++ " " ++ coords + where + coords = showCoord coord + name' = + if name /= "" + then name + else "" + +showCoord :: Coord.Coord -> String +showCoord coord = + "(" ++ + maybe "?" show (Coord.lat coord) ++ + "°, " ++ maybe "?" show (Coord.lon coord) ++ "°)" + +showWeather :: [Weather.Weather] -> String +showWeather w = intercalate "," $ Weather.main <$> w + +showHumidity :: Main.Main -> String +showHumidity m = "H " ++ show hm ++ " %" + where + hm :: Int + hm = round . Main.humidity $ m + +-- https://en.wikipedia.org/wiki/Millimeter_of_mercury +showPressure :: Main.Main -> String +showPressure m = "P " ++ show p ++ " mmHg" + where + hPa2mmHg hpa = hpa * 0.750061561303 + p :: Int + p = round . hPa2mmHg . Main.pressure $ m + +-- https://stackoverflow.com/q/7490660/933161 +showWind :: Wind.Wind -> String +showWind w = dir ++ " " ++ show speed ++ " m/s" + where + speed :: Int + speed = round . Wind.speed $ w + deg = Wind.deg w + -- [ "N", "NE", "E", "SE", "S", "SW", "W", "NW" ] + dirs = ["↓", "↙", "←", "↖", "↑", "↗", "→", "↘"] + l = length dirs + sector = round $ (deg * fromIntegral l) / 360.0 + dir = dirs !! (sector `rem` l) + +showTemp :: Main.Main -> String +showTemp m = "T " ++ temp ++ " °C" + where + k2c k = k - 273.15 -- Kelvin to Celsius + tmax :: Int + tmin :: Int + tmax = round . k2c . Main.temp_max $ m + tmin = round . k2c . Main.temp_min $ m + show' t = + if t > 0 + then "+" ++ show t + else show t + temp = + if tmax /= tmin + then show' tmin ++ ".." ++ show' tmax + else show' tmin diff --git a/lib/Web/OpenWeatherMap/API.hs b/lib/Web/OpenWeatherMap/API.hs index 8a1690e..6d06421 100644 --- a/lib/Web/OpenWeatherMap/API.hs +++ b/lib/Web/OpenWeatherMap/API.hs @@ -8,6 +8,8 @@ For API key (a.k.a appid) refer to . module Web.OpenWeatherMap.API ( weatherByName , weatherByCoord + , forecastByName + , forecastByCoord ) where import Data.Proxy (Proxy(..)) @@ -16,14 +18,22 @@ import Servant.API ((:<|>)(..), (:>), Get, JSON, QueryParam) import Servant.Client (ClientM, client) import Web.OpenWeatherMap.Types.CurrentWeather (CurrentWeather) +import Web.OpenWeatherMap.Types.ForecastWeather (ForecastWeather) type GetCurrentWeather = AppId :> Get '[ JSON] CurrentWeather +type GetForecastWeather = AppId :> Get '[ JSON] ForecastWeather + type AppId = QueryParam "appid" String -type API +type Current = "weather" :> QueryParam "q" String :> GetCurrentWeather :<|> "weather" :> QueryParam "lat" Double :> QueryParam "lon" Double :> GetCurrentWeather +type Forecast + = "forecast" :> QueryParam "q" String :> GetForecastWeather :<|> "forecast" :> QueryParam "lat" Double :> QueryParam "lon" Double :> GetForecastWeather + +type API = Current :<|> Forecast + -- | Request current weather in the city. weatherByName :: Maybe String -- ^ City name, e. g. \"Moscow\" or \"Moscow,ru\". @@ -35,4 +45,16 @@ weatherByCoord :: -> Maybe Double -- ^ Longitude, e. g. 37.6155600 for Moscow. -> Maybe String -- ^ API key. -> ClientM CurrentWeather -weatherByName :<|> weatherByCoord = client (Proxy :: Proxy API) +-- | Request forecast weather in the city. +forecastByName :: + Maybe String -- ^ City name, e. g. \"Moscow\" or \"Moscow,ru\". + -> Maybe String -- ^ API key. + -> ClientM ForecastWeather +-- | Request current weather at the geographic coordinates (in decimal degrees). +forecastByCoord :: + Maybe Double -- ^ Latitude, e. g. 55.7522200 for Moscow. + -> Maybe Double -- ^ Longitude, e. g. 37.6155600 for Moscow. + -> Maybe String -- ^ API key. + -> ClientM ForecastWeather +(weatherByName :<|> weatherByCoord) :<|> (forecastByName :<|> forecastByCoord) = + client (Proxy :: Proxy API) diff --git a/lib/Web/OpenWeatherMap/Client.hs b/lib/Web/OpenWeatherMap/Client.hs index c7ad7b6..445e2a4 100644 --- a/lib/Web/OpenWeatherMap/Client.hs +++ b/lib/Web/OpenWeatherMap/Client.hs @@ -4,6 +4,7 @@ High-level client functions perfoming requests to OpenWeatherMap API. module Web.OpenWeatherMap.Client ( Location(..) , getWeather + , getForecast ) where import Network.HTTP.Client (defaultManagerSettings, newManager) @@ -11,7 +12,6 @@ import Servant.Client ( BaseUrl(BaseUrl) , ClientEnv , ClientError - , ClientM , Scheme(Http) , mkClientEnv , runClientM @@ -19,6 +19,7 @@ import Servant.Client import qualified Web.OpenWeatherMap.API as API import Web.OpenWeatherMap.Types.CurrentWeather (CurrentWeather) +import Web.OpenWeatherMap.Types.ForecastWeather (ForecastWeather) -- | Various way to specify location. data Location @@ -33,13 +34,20 @@ getWeather :: -> Location -> IO (Either ClientError CurrentWeather) getWeather appid loc = defaultEnv >>= runClientM (api loc appid) + where + api (Name city) = API.weatherByName (Just city) . Just + api (Coord lat lon) = API.weatherByCoord (Just lat) (Just lon) . Just -api :: - Location - -> String -- ^ API key. - -> ClientM CurrentWeather -api (Name city) = API.weatherByName (Just city) . Just -api (Coord lat lon) = API.weatherByCoord (Just lat) (Just lon) . Just +-- | Make a request to OpenWeatherMap API +-- and return forecast weather in given location. +getForecast :: + String -- ^ API key. + -> Location + -> IO (Either ClientError ForecastWeather) +getForecast appid loc = defaultEnv >>= runClientM (api loc appid) + where + api (Name city) = API.forecastByName (Just city) . Just + api (Coord lat lon) = API.forecastByCoord (Just lat) (Just lon) . Just defaultEnv :: IO ClientEnv defaultEnv = do diff --git a/lib/Web/OpenWeatherMap/Types/City.hs b/lib/Web/OpenWeatherMap/Types/City.hs new file mode 100644 index 0000000..bb6cd6d --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/City.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.City + ( City(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + +import Web.OpenWeatherMap.Types.Coord (Coord) + +data City = City + { name :: String + , country :: Maybe String + , coord :: Coord + , timezone :: Int + , sunset :: Int + , sunrise :: Int + } deriving (Show, Generic, FromJSON) diff --git a/lib/Web/OpenWeatherMap/Types/Coord.hs b/lib/Web/OpenWeatherMap/Types/Coord.hs index 517c532..0751964 100644 --- a/lib/Web/OpenWeatherMap/Types/Coord.hs +++ b/lib/Web/OpenWeatherMap/Types/Coord.hs @@ -10,6 +10,6 @@ import GHC.Generics (Generic) import Data.Aeson (FromJSON) data Coord = Coord - { lon :: Double - , lat :: Double + { lon :: Maybe Double + , lat :: Maybe Double } deriving (Show, Generic, FromJSON) diff --git a/lib/Web/OpenWeatherMap/Types/Forecast.hs b/lib/Web/OpenWeatherMap/Types/Forecast.hs new file mode 100644 index 0000000..3434930 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Forecast.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Forecast + ( Forecast(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + +import Web.OpenWeatherMap.Types.Clouds (Clouds) +import Web.OpenWeatherMap.Types.Main (Main) +import Web.OpenWeatherMap.Types.Weather (Weather) +import Web.OpenWeatherMap.Types.Wind (Wind) + +data Forecast = Forecast + { dt :: Int + , clouds :: Clouds + , main :: Main + , weather :: [Weather] + , wind :: Wind + } deriving (Show, Generic, FromJSON) diff --git a/lib/Web/OpenWeatherMap/Types/ForecastWeather.hs b/lib/Web/OpenWeatherMap/Types/ForecastWeather.hs new file mode 100644 index 0000000..fa8e50a --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/ForecastWeather.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.ForecastWeather + ( ForecastWeather(..) + ) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + +import Web.OpenWeatherMap.Types.City (City) +import Web.OpenWeatherMap.Types.Forecast (Forecast) + +-- | Response to requests for forecast weather. +-- Refer to . +data ForecastWeather = ForecastWeather + { list :: [Forecast] + , city :: City + } deriving (Show, Generic, FromJSON) diff --git a/openweathermap.cabal b/openweathermap.cabal index f4a9c76..dad65c2 100644 --- a/openweathermap.cabal +++ b/openweathermap.cabal @@ -34,9 +34,12 @@ library exposed-modules: Web.OpenWeatherMap.API Web.OpenWeatherMap.Client + Web.OpenWeatherMap.Types.City Web.OpenWeatherMap.Types.Clouds Web.OpenWeatherMap.Types.Coord Web.OpenWeatherMap.Types.CurrentWeather + Web.OpenWeatherMap.Types.Forecast + Web.OpenWeatherMap.Types.ForecastWeather Web.OpenWeatherMap.Types.Main Web.OpenWeatherMap.Types.Sys Web.OpenWeatherMap.Types.Weather @@ -47,12 +50,14 @@ executable openweathermap ghc-options: -Wall -static hs-source-dirs: cmd main-is: Main.hs + other-modules: Print if flag(cmd) build-depends: base >= 4.9 && < 5 , directory , openweathermap , optparse-applicative >= 0.13.0.0 + , time , xdg-basedir else buildable: False -- cgit v1.2.3