added more API requests and getting dates
This commit is contained in:
parent
56c2235925
commit
6c2b12c89b
@ -11,7 +11,8 @@ This project makes use of the following dependencies (specified in `profun.cabal
|
||||
* http-client-tls (for API requests)
|
||||
* http-conduit (for API requests)
|
||||
* aeson (JSON parsing)
|
||||
* Chart
|
||||
* Chart-diagrams
|
||||
* Chart (for generating plot)
|
||||
* Chart-diagrams (for generating plot)
|
||||
* bytestring (for ByteString type)
|
||||
* utf8-string (for conversion from String to ByteString)
|
||||
* time (for getting date)
|
||||
|
89
app/Main.hs
89
app/Main.hs
@ -3,16 +3,46 @@ import Network.HTTP.Simple
|
||||
import System.Environment (lookupEnv)
|
||||
import Plot
|
||||
import Data.ByteString.UTF8 (fromString) --to convert acquired API key to ByteString
|
||||
import Data.Time
|
||||
|
||||
|
||||
data WhichDay = Yesterday | Today | Tomorrow
|
||||
deriving (Show, Eq)
|
||||
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
apiKey <- getWeatherKey
|
||||
let todayRequest = apiRequestBuilder apiKey "today"
|
||||
response <- httpJSON todayRequest :: IO (Response ())
|
||||
generatePlot 20 100 25 --example
|
||||
putStrLn $ show todayRequest
|
||||
putStrLn $ show $ getResponseStatusCode response
|
||||
|
||||
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
|
||||
|
||||
--apiResponse <- httpJSON "http://httpbin.org/get" :: IO (Response ()) -- specifying type as httpJSON return value is ambigious
|
||||
|
||||
|
||||
@ -24,16 +54,49 @@ getWeatherKey = do
|
||||
Just a -> return a
|
||||
Nothing -> error "API key not set in environmental variables!" -- exception thrown (but not handled) per project requirement
|
||||
|
||||
apiRequestBuilder :: String -> String -> Request
|
||||
apiRequestBuilder apiKey day =
|
||||
|
||||
apiRequestCity :: String -> String -> Request
|
||||
apiRequestCity apiKey city =
|
||||
setRequestHost "api.weatherapi.com"
|
||||
$ setRequestPath path
|
||||
$ setRequestPath "/v1/search.json"
|
||||
$ setRequestMethod "GET"
|
||||
$ setRequestQueryString [("q", Just "Poznan"), ("key", Just (fromString apiKey))]
|
||||
$ setRequestQueryString [("key", Just (fromString apiKey)), ("q", Just (fromString city))]
|
||||
$ setRequestPort 443
|
||||
$ setRequestSecure True
|
||||
$ defaultRequest
|
||||
where path
|
||||
| day == "yesterday" = "/v1/"
|
||||
| day == "tomorrow" = "/v1/"
|
||||
| otherwise = "/v1/current.json"
|
||||
|
||||
|
||||
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 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
|
File diff suppressed because one or more lines are too long
Before Width: | Height: | Size: 103 KiB After Width: | Height: | Size: 98 KiB |
@ -72,7 +72,8 @@ executable profun
|
||||
Chart-diagrams ^>=1.9.5,
|
||||
aeson ^>=2.2.2.0,
|
||||
bytestring ^>=0.12.1.0,
|
||||
utf8-string ^>=1.0.2
|
||||
utf8-string ^>=1.0.2,
|
||||
time ^>=1.12.2
|
||||
|
||||
-- Directories containing source files.
|
||||
hs-source-dirs: app
|
||||
|
Loading…
Reference in New Issue
Block a user