From 6f6e3d8ec76c59d6f403725e9b2a22b8f6680714 Mon Sep 17 00:00:00 2001 From: Igor Pashev Date: Wed, 7 Jun 2017 16:24:05 +0300 Subject: Initial version 0.0.0 --- .gitignore | 4 + ChangeLog.md | 5 + LICENSE | 13 ++ README.md | 57 ++++++++ cmd/Main.hs | 173 +++++++++++++++++++++++++ lib/Web/OpenWeatherMap/API.hs | 45 +++++++ lib/Web/OpenWeatherMap/Client.hs | 49 +++++++ lib/Web/OpenWeatherMap/Types/Clouds.hs | 16 +++ lib/Web/OpenWeatherMap/Types/Coord.hs | 17 +++ lib/Web/OpenWeatherMap/Types/CurrentWeather.hs | 35 +++++ lib/Web/OpenWeatherMap/Types/Main.hs | 23 ++++ lib/Web/OpenWeatherMap/Types/Sys.hs | 19 +++ lib/Web/OpenWeatherMap/Types/Weather.hs | 19 +++ lib/Web/OpenWeatherMap/Types/Wind.hs | 17 +++ openweathermap.cabal | 59 +++++++++ stack.yaml | 8 ++ 16 files changed, 559 insertions(+) create mode 100644 .gitignore create mode 100644 ChangeLog.md create mode 100644 LICENSE create mode 100644 README.md create mode 100644 cmd/Main.hs create mode 100644 lib/Web/OpenWeatherMap/API.hs create mode 100644 lib/Web/OpenWeatherMap/Client.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Clouds.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Coord.hs create mode 100644 lib/Web/OpenWeatherMap/Types/CurrentWeather.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Main.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Sys.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Weather.hs create mode 100644 lib/Web/OpenWeatherMap/Types/Wind.hs create mode 100644 openweathermap.cabal create mode 100644 stack.yaml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..dbaee1d --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +/.stack-work +/dist +/dist-newstyle +cabal.*.local diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 index 0000000..fcf20a8 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +0.0.0 +===== + + * Initial version. + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..c6c7def --- /dev/null +++ b/LICENSE @@ -0,0 +1,13 @@ + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + Version 2, December 2004 + + Copyright (C) 2004 Sam Hocevar + + Everyone is permitted to copy and distribute verbatim or modified + copies of this license document, and changing it is allowed as long + as the name is changed. + + DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. You just DO WHAT THE FUCK YOU WANT TO. diff --git a/README.md b/README.md new file mode 100644 index 0000000..ad4f07b --- /dev/null +++ b/README.md @@ -0,0 +1,57 @@ +OpenWeatherMap +============== + +OpenWeatherMap is a haskell library to access . + +Requirements +============ + +OpenWeatherMap is written in Haskell with [GHC](http://www.haskell.org/ghc/). +All required Haskell libraries are listed in [openweathermap.cabal](ldapply.cabal). +Use [cabal-install](http://www.haskell.org/haskellwiki/Cabal-Install) to fetch +and build all pre-requisites automatically. + + +Command-line utility +==================== + +The command-line utility `openweathermap` provides a means +to get human readable weather infromation. + +Usage +----- + +``` +Usage: openweathermap ([-K|--api-key-file APIKEYFILE] | [-k|--api-key APIKEY]) + ((-c|--city CITY) | --lat NUM --lon NUM) [-d|--debug] + +Available options: + -K,--api-key-file APIKEYFILE + Read API key from this file + -k,--api-key APIKEY API key + -c,--city CITY City name + --lat NUM Latitude in decimal degrees + --lon NUM Longitude in decimal degrees + -d,--debug Enable debug + -h,--help Show this help text + +``` +By default, `openweathermap` reads the API key +from the `$XDG_CONFIG_HOME/openweathermap/key` file, where +[`$XDG_CONFIG_HOME`](https://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html) +is typically `~/.config` on Linux systems. + + +Examples +-------- + +``` +$ openweathermap -c norilsk +Norilsk,RU (69.35°, 88.2°): Clouds, H 100 %, P 753 mmHg, T +4 °C, ↓ 1 m/s + +$ 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 +``` + + + diff --git a/cmd/Main.hs b/cmd/Main.hs new file mode 100644 index 0000000..645ac4b --- /dev/null +++ b/cmd/Main.hs @@ -0,0 +1,173 @@ +{-# LANGUAGE LambdaCase #-} + +module Main ( + main +) where + +import Control.Monad (when) +import Data.List (intercalate) +import Data.Semigroup ((<>)) +import Data.Version (showVersion) +import System.Exit (die) +import System.IO (IOMode(ReadMode), hGetLine, hPrint, stderr, withFile) + +import Options.Applicative ( + (<**>), (<|>), Parser, auto, execParser, fullDesc, header, help, helper, + info, long, metavar, option, optional, short, strOption, switch + ) +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 + +appName :: String +appName = "openweathermap" + +parseLocation :: Parser Client.Location +parseLocation = byName <|> byCoord + where + byName = Client.Name <$> strOption + ( long "city" + <> short 'c' + <> metavar "CITY" + <> help "City name" ) + + byCoord = Client.Coord + <$> option auto + ( long "lat" + <> metavar "NUM" + <> help "Latitude in decimal degrees" ) + <*> option auto + ( long "lon" + <> metavar "NUM" + <> help "Longitude in decimal degrees" ) + + +data ApiKey + = ApiKeyFile FilePath + | ApiKey String + +parseApiKey :: Parser ApiKey +parseApiKey = fromFile <|> inCmdLine + where + fromFile = ApiKeyFile <$> strOption + ( long "api-key-file" + <> short 'K' + <> metavar "APIKEYFILE" + <> help "Read API key from this file" ) + + inCmdLine = ApiKey <$> strOption + ( long "api-key" + <> short 'k' + <> metavar "APIKEY" + <> help "API key" ) + + +data Config = Config + { apikey :: Maybe ApiKey + , location :: Client.Location + , debug :: Bool + } + +parseConfig :: Parser Config +parseConfig = Config + <$> optional parseApiKey + <*> parseLocation + <*> switch (long "debug" <> short 'd' <> help "Enable debug") + +getApiKey :: Maybe ApiKey -> IO String +getApiKey (Just (ApiKey key)) = return key +getApiKey (Just (ApiKeyFile f)) = withFile f ReadMode hGetLine +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 + +main :: IO () +main = run =<< execParser opts + where + opts = info (parseConfig <**> helper) (fullDesc <> header desc) + desc = "openweathermap " + ++ showVersion version + ++ " - command-line client for https://openweathermap.org/api" + diff --git a/lib/Web/OpenWeatherMap/API.hs b/lib/Web/OpenWeatherMap/API.hs new file mode 100644 index 0000000..0c1e282 --- /dev/null +++ b/lib/Web/OpenWeatherMap/API.hs @@ -0,0 +1,45 @@ +{-| +Direct API functions. +For API key (a.k.a appid) refer to . +-} + +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} + +module Web.OpenWeatherMap.API ( + weatherByName, + weatherByCoord +) where + +import Data.Proxy (Proxy(..)) + +import Servant.API ((:>), (:<|>)(..), JSON, Get, QueryParam) +import Servant.Client (client) +import Servant.Common.Req (ClientM) + +import Web.OpenWeatherMap.Types.CurrentWeather (CurrentWeather) + + +type GetCurrentWeather = AppId :> Get '[JSON] CurrentWeather +type AppId = QueryParam "appid" String + +type API + = "weather" :> QueryParam "q" String :> GetCurrentWeather + :<|> "weather" :> QueryParam "lat" Double :> QueryParam "lon" Double + :> GetCurrentWeather + +-- | Request current weather in the city. +weatherByName + :: Maybe String -- ^ City name, e. g. \"Moscow\" or \"Moscow,ru\". + -> Maybe String -- ^ API key. + -> ClientM CurrentWeather + +-- | Request current weather at the geographic coordinates (in decimal degrees). +weatherByCoord + :: Maybe Double -- ^ Latitude, e. g. 55.7522200 for Moscow. + -> Maybe Double -- ^ Longitude, e. g. 37.6155600 for Moscow. + -> Maybe String -- ^ API key. + -> ClientM CurrentWeather + +weatherByName :<|> weatherByCoord = client (Proxy :: Proxy API) + diff --git a/lib/Web/OpenWeatherMap/Client.hs b/lib/Web/OpenWeatherMap/Client.hs new file mode 100644 index 0000000..7804ef2 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Client.hs @@ -0,0 +1,49 @@ +{-| +High-level client functions perfoming requests to OpenWeatherMap API. +-} +module Web.OpenWeatherMap.Client ( + Location(..), + getWeather +) where + +import Network.HTTP.Client (newManager, defaultManagerSettings) +import Servant.Client (ClientEnv(..), runClientM, ServantError) +import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..)) +import Servant.Common.Req (ClientM) + +import Web.OpenWeatherMap.Types.CurrentWeather (CurrentWeather) +import qualified Web.OpenWeatherMap.API as API + + +-- | Various way to specify location. +data Location + = Name String -- ^ City name. + | Coord Double Double -- ^ Geographic coordinates: latitude and longitude. + + +-- | Make a request to OpenWeatherMap API +-- and return current weather in given location. +getWeather + :: String -- ^ API key. + -> Location + -> IO (Either ServantError CurrentWeather) +getWeather appid loc = + defaultEnv >>= runClientM (api loc appid) + +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 + +defaultEnv :: IO ClientEnv +defaultEnv = do + manager <- newManager defaultManagerSettings + return $ ClientEnv manager baseUrl + +-- XXX openweathermap.org does not support HTTPS, +-- XXX appid is passed in clear text. Oops. +baseUrl :: BaseUrl +baseUrl = BaseUrl Http "api.openweathermap.org" 80 "/data/2.5" + diff --git a/lib/Web/OpenWeatherMap/Types/Clouds.hs b/lib/Web/OpenWeatherMap/Types/Clouds.hs new file mode 100644 index 0000000..78a6e97 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Clouds.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Clouds ( + Clouds(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +data Clouds = Clouds + { all :: Double + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/Coord.hs b/lib/Web/OpenWeatherMap/Types/Coord.hs new file mode 100644 index 0000000..d9a9f21 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Coord.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Coord ( + Coord(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +data Coord = Coord + { lon :: Double + , lat :: Double + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/CurrentWeather.hs b/lib/Web/OpenWeatherMap/Types/CurrentWeather.hs new file mode 100644 index 0000000..26572a7 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/CurrentWeather.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.CurrentWeather ( + CurrentWeather(..) +) where + +import Prelude hiding (id) +import GHC.Generics (Generic) + +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 . +data CurrentWeather = CurrentWeather + { coord :: Coord + , weather :: [Weather] + , base :: String + , main :: Main + , wind :: Wind + , clouds :: Clouds + , dt :: Int + , sys :: Sys + , id :: Int + , name :: String + , cod :: Int + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/Main.hs b/lib/Web/OpenWeatherMap/Types/Main.hs new file mode 100644 index 0000000..21b1951 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Main.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Main ( + Main(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +{-# ANN module "HLint: ignore Use camelCase" #-} +data Main = Main + { temp :: Double + , pressure :: Double + , humidity :: Double + , temp_min :: Double + , temp_max :: Double + , sea_level :: Maybe Double + , grnd_level :: Maybe Double + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/Sys.hs b/lib/Web/OpenWeatherMap/Types/Sys.hs new file mode 100644 index 0000000..03b223c --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Sys.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Sys ( + Sys(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +data Sys = Sys + { message :: Double + , country :: Maybe String + , sunrise :: Int + , sunset :: Int + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/Weather.hs b/lib/Web/OpenWeatherMap/Types/Weather.hs new file mode 100644 index 0000000..090fe0f --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Weather.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Weather ( + Weather(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +data Weather = Weather + { id :: Int + , main :: String + , description :: String + , icon :: String + } deriving (Show, Generic, FromJSON) + diff --git a/lib/Web/OpenWeatherMap/Types/Wind.hs b/lib/Web/OpenWeatherMap/Types/Wind.hs new file mode 100644 index 0000000..8481e62 --- /dev/null +++ b/lib/Web/OpenWeatherMap/Types/Wind.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} + +module Web.OpenWeatherMap.Types.Wind ( + Wind(..) +) where + +import GHC.Generics (Generic) + +import Data.Aeson (FromJSON) + + +data Wind = Wind + { speed :: Double + , deg :: Double + } deriving (Show, Generic, FromJSON) + diff --git a/openweathermap.cabal b/openweathermap.cabal new file mode 100644 index 0000000..dca75ca --- /dev/null +++ b/openweathermap.cabal @@ -0,0 +1,59 @@ +name: openweathermap +version: 0.0.0 +synopsis: Access data at OpenWeatherMap +description: Client library and command-line utility to access + OpenWeatherMap https://openweathermap.org +license: PublicDomain +license-file: LICENSE +author: Igor Pashev +maintainer: Igor Pashev +copyright: 2017, Igor Pashev +category: Web +build-type: Simple +extra-source-files: README.md ChangeLog.md +cabal-version: >= 1.20 + +source-repository head + type: git + location: https://github.com/ip1981/openweathermap.git + +flag cmd + description: Build a command-line utility. + default: True + +library + default-language: Haskell2010 + ghc-options: -Wall + hs-source-dirs: lib + build-depends: + base >= 4.9 && < 5 + , aeson + , http-client + , servant + , servant-client >= 0.9 + exposed-modules: + Web.OpenWeatherMap.API + Web.OpenWeatherMap.Client + Web.OpenWeatherMap.Types.Clouds + Web.OpenWeatherMap.Types.Coord + Web.OpenWeatherMap.Types.CurrentWeather + Web.OpenWeatherMap.Types.Main + Web.OpenWeatherMap.Types.Sys + Web.OpenWeatherMap.Types.Weather + Web.OpenWeatherMap.Types.Wind + +executable openweathermap + default-language: Haskell2010 + ghc-options: -Wall -static + hs-source-dirs: cmd + main-is: Main.hs + if flag(cmd) + build-depends: + base >= 4.9 && < 5 + , directory + , openweathermap + , optparse-applicative >= 0.13.0.0 + , xdg-basedir + else + buildable: False + diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..2b0a8d6 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,8 @@ +resolver: lts-8.17 +packages: +- '.' + +extra-deps: [] +flags: {} +extra-package-dbs: [] + -- cgit v1.2.3