110 lines
4.2 KiB
Haskell
110 lines
4.2 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-} --needed for ByteString arguments
|
|
import Network.HTTP.Simple
|
|
import System.Environment (lookupEnv)
|
|
import Data.ByteString.UTF8 (fromString) --to convert acquired API key to ByteString
|
|
import Data.Time as T
|
|
|
|
import Plot
|
|
import qualified DataTypes as DT
|
|
|
|
|
|
data WhichDay = Yesterday | Today | Tomorrow
|
|
deriving (Show, Eq)
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
apiKey <- getWeatherKey
|
|
|
|
generatePlot 20 35 25 --example
|
|
|
|
putStrLn "Enter a city name: "
|
|
city <- getLine
|
|
|
|
let cityRequest = apiRequestCity apiKey city
|
|
cityResponse <- httpLBS cityRequest
|
|
|
|
if getResponseBody cityResponse == "[]" || getResponseStatusCode cityResponse /= 200
|
|
then error "City not found!"
|
|
else do
|
|
currentDate <- getCurrentDate
|
|
|
|
--request for yesterday's weather
|
|
let yesterdayDate = formatDate $ addDays (-1) currentDate
|
|
let yesterdayRequest = apiRequestBuilder apiKey Yesterday city yesterdayDate
|
|
yesterdayResponse <- httpLBS yesterdayRequest
|
|
print $ getResponseStatusCode yesterdayResponse
|
|
yesterdayDecoded <- DT.weatherDecode $ getResponseBody yesterdayResponse
|
|
print yesterdayDecoded
|
|
|
|
--request for today's weather
|
|
let todayDate = formatDate currentDate
|
|
let todayRequest = apiRequestBuilder apiKey Today city todayDate
|
|
todayResponse <- httpLBS todayRequest
|
|
print $ getResponseStatusCode todayResponse
|
|
todayDecoded <- DT.weatherDecode $ getResponseBody todayResponse
|
|
print todayDecoded
|
|
|
|
--request for tomorrow's weather
|
|
let tomorrowDate = formatDate $ addDays 1 currentDate
|
|
let tomorrowRequest = apiRequestBuilder apiKey Tomorrow city tomorrowDate
|
|
tomorrowResponse <- httpLBS tomorrowRequest
|
|
print $ getResponseStatusCode tomorrowResponse
|
|
tomorrowDecoded <- DT.weatherDecode $ getResponseBody tomorrowResponse
|
|
print tomorrowDecoded
|
|
|
|
|
|
--apiKey is stored in an env variable, not something that should be pushed onto git
|
|
getWeatherKey :: IO String
|
|
getWeatherKey = do
|
|
result <- lookupEnv "WEATHER_API_KEY"
|
|
case result of
|
|
Just a -> return a
|
|
Nothing -> error "API key not set in environmental variables!" -- exception thrown (but not handled) per project requirement
|
|
|
|
|
|
apiRequestCity :: String -> String -> Request
|
|
apiRequestCity apiKey city =
|
|
setRequestHost "api.weatherapi.com"
|
|
$ setRequestPath "/v1/search.json"
|
|
$ setRequestMethod "GET"
|
|
$ setRequestQueryString [("key", Just (fromString apiKey)), ("q", Just (fromString city))]
|
|
$ setRequestPort 443
|
|
$ setRequestSecure True
|
|
$ defaultRequest
|
|
|
|
|
|
apiRequestBuilder :: String -> WhichDay -> String -> String -> Request
|
|
apiRequestBuilder apiKey day city date =
|
|
setRequestHost "api.weatherapi.com"
|
|
$ setRequestPath path
|
|
$ setRequestMethod "GET"
|
|
$ setRequestQueryString query
|
|
$ setRequestPort 443
|
|
$ setRequestSecure True
|
|
$ defaultRequest
|
|
where {
|
|
path
|
|
| day == Yesterday = "/v1/history.json"
|
|
| day == Today = "/v1/current.json"
|
|
| day == Tomorrow = "/v1/forecast.json"
|
|
| otherwise = error "Invalid day argument!";
|
|
query
|
|
| day == Yesterday = [("key", Just (fromString apiKey)), ("q", Just (fromString city)), ("dt", Just (fromString date))]
|
|
| day == Today = [("key", Just (fromString apiKey)), ("q", Just (fromString city))]
|
|
| day == Tomorrow = [("key", Just (fromString apiKey)), ("q", Just (fromString city)), ("dt", Just (fromString date)), ("days", Just (fromString "1"))]
|
|
| otherwise = error "Invalid day argument!";
|
|
}
|
|
|
|
|
|
getCurrentDate :: IO T.Day
|
|
getCurrentDate = do
|
|
currentTime <- getCurrentTime
|
|
timeZone <- getCurrentTimeZone
|
|
let localTime = utcToLocalTime timeZone currentTime
|
|
let currentDate = localDay localTime
|
|
return currentDate
|
|
|
|
|
|
formatDate :: T.Day -> String
|
|
formatDate = formatTime defaultTimeLocale "%Y-%m-%d" |