diff options
Diffstat (limited to 'cmd/Main.hs')
| -rw-r--r-- | cmd/Main.hs | 124 |
1 files changed, 31 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 |