Initial version 0.0.00.0.0

16 files changed, 559 insertions, 0 deletions

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 <sam@hocevar.net>
+
+ 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 <https://openweathermap.org/api>.
+
+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 "<unknown>"
+    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 <http://openweathermap.org/appid>.
+-}
+
+{-# 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 <https://openweathermap.org/current>.
+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 <pashev.igor@gmail.com>
+copyright: 2017, Igor Pashev <pashev.igor@gmail.com>
+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: []
+