Add forecast weather API

2 files changed, 156 insertions, 93 deletions

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 "<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
+  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 "<unknown>"
+
+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