2024-05-25 20:21:38 +02:00
|
|
|
{-# LANGUAGE OverloadedStrings #-} --needed for ByteString arguments
|
2024-05-25 14:32:43 +02:00
|
|
|
import Network.HTTP.Simple
|
2024-05-25 20:21:38 +02:00
|
|
|
import System.Environment (lookupEnv)
|
2024-05-25 20:00:14 +02:00
|
|
|
import Plot
|
2024-05-25 21:14:54 +02:00
|
|
|
import Data.ByteString.UTF8 (fromString) --to convert acquired API key to ByteString
|
2024-05-26 00:18:03 +02:00
|
|
|
import Data.Time
|
|
|
|
|
|
|
|
|
|
|
|
data WhichDay = Yesterday | Today | Tomorrow
|
|
|
|
deriving (Show, Eq)
|
2024-05-25 20:00:14 +02:00
|
|
|
|
2024-05-25 14:32:43 +02:00
|
|
|
|
|
|
|
main :: IO ()
|
|
|
|
main = do
|
2024-05-25 20:21:38 +02:00
|
|
|
apiKey <- getWeatherKey
|
2024-05-26 00:18:03 +02:00
|
|
|
|
|
|
|
putStrLn "Enter a city name: "
|
|
|
|
city <- getLine
|
|
|
|
|
|
|
|
let cityRequest = apiRequestCity apiKey city
|
|
|
|
cityResponse <- httpLBS cityRequest
|
|
|
|
|
|
|
|
if getResponseBody cityResponse == "[]"
|
|
|
|
then error "City not found!"
|
|
|
|
else do
|
|
|
|
currentDate <- getCurrentDate
|
|
|
|
let yesterdayDate = formatDate $ addDays (-1) currentDate
|
|
|
|
let todayDate = formatDate currentDate
|
|
|
|
let tomorrowDate = formatDate $ addDays 1 currentDate
|
|
|
|
|
|
|
|
let yesterdayRequest = apiRequestBuilder apiKey Yesterday city yesterdayDate
|
|
|
|
yesterdayResponse <- httpLBS yesterdayRequest
|
|
|
|
putStrLn $ show yesterdayRequest
|
|
|
|
putStrLn $ show $ getResponseStatusCode yesterdayResponse
|
|
|
|
|
|
|
|
let todayRequest = apiRequestBuilder apiKey Today city todayDate
|
|
|
|
todayResponse <- httpLBS todayRequest
|
|
|
|
putStrLn $ show todayRequest
|
|
|
|
putStrLn $ show $ getResponseStatusCode todayResponse
|
|
|
|
|
|
|
|
let tomorrowRequest = apiRequestBuilder apiKey Tomorrow city tomorrowDate
|
|
|
|
tomorrowResponse <- httpLBS tomorrowRequest
|
|
|
|
putStrLn $ show tomorrowRequest
|
|
|
|
putStrLn $ show $ getResponseStatusCode tomorrowResponse
|
|
|
|
|
2024-05-25 20:21:38 +02:00
|
|
|
--apiResponse <- httpJSON "http://httpbin.org/get" :: IO (Response ()) -- specifying type as httpJSON return value is ambigious
|
2024-05-25 14:32:43 +02:00
|
|
|
|
2024-05-25 20:21:38 +02:00
|
|
|
|
2024-05-25 21:14:54 +02:00
|
|
|
--apiKey is stored in an env variable, not something that should be pushed onto git
|
2024-05-25 20:21:38 +02:00
|
|
|
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
|
|
|
|
|
2024-05-26 00:18:03 +02:00
|
|
|
|
|
|
|
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 =
|
2024-05-25 20:21:38 +02:00
|
|
|
setRequestHost "api.weatherapi.com"
|
|
|
|
$ setRequestPath path
|
|
|
|
$ setRequestMethod "GET"
|
2024-05-26 00:18:03 +02:00
|
|
|
$ setRequestQueryString query
|
2024-05-25 20:21:38 +02:00
|
|
|
$ setRequestPort 443
|
|
|
|
$ setRequestSecure True
|
|
|
|
$ defaultRequest
|
2024-05-26 00:18:03 +02:00
|
|
|
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 Day
|
|
|
|
getCurrentDate = do
|
|
|
|
currentTime <- getCurrentTime
|
|
|
|
timeZone <- getCurrentTimeZone
|
|
|
|
let localTime = utcToLocalTime timeZone currentTime
|
|
|
|
let currentDate = localDay localTime
|
|
|
|
return currentDate
|
|
|
|
|
|
|
|
|
|
|
|
formatDate :: Day -> String
|
|
|
|
formatDate date = formatTime defaultTimeLocale "%Y-%m-%d" date
|