today response decoding
This commit is contained in:
parent
bcc8c40243
commit
2be73d329d
82
app/DataTypes.hs
Normal file
82
app/DataTypes.hs
Normal file
@ -0,0 +1,82 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE OverloadedStrings #-} --needed for ByteString arguments
|
||||
module DataTypes where
|
||||
import Data.Aeson
|
||||
import GHC.Generics
|
||||
import qualified Data.ByteString.Lazy.Char8 as BL
|
||||
|
||||
|
||||
data Location = Location
|
||||
{ name :: String
|
||||
, region :: String
|
||||
, country :: String
|
||||
, lat :: Float
|
||||
, lon :: Float
|
||||
, tz_id :: String
|
||||
, localtime_epoch :: Int
|
||||
, localtime :: String
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
data Current = Current
|
||||
{ temp_c :: Float
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
data TodayResponse = TodayResponse
|
||||
{ location :: Location
|
||||
, current :: Current
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
data Day = Day
|
||||
{ avgtemp_c :: Float
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
data ForecastDay = ForecastDay
|
||||
{ day :: Day
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
data Forecast = Forecast
|
||||
{ forecastday :: [ForecastDay]
|
||||
} deriving (Show, Generic)
|
||||
|
||||
|
||||
-- data YesterdayResponse = YesterdayResponse
|
||||
-- { location :: Location
|
||||
-- , forecast :: Forecast
|
||||
-- } deriving (Show, Generic)
|
||||
|
||||
|
||||
instance FromJSON Location
|
||||
instance ToJSON Location
|
||||
instance FromJSON Current
|
||||
instance ToJSON Current
|
||||
instance FromJSON TodayResponse
|
||||
instance ToJSON TodayResponse
|
||||
instance FromJSON Day
|
||||
instance ToJSON Day
|
||||
instance FromJSON ForecastDay
|
||||
instance ToJSON ForecastDay
|
||||
instance FromJSON Forecast
|
||||
instance ToJSON Forecast
|
||||
-- instance FromJSON YesterdayResponse
|
||||
-- instance ToJSON YesterdayResponse
|
||||
|
||||
|
||||
todayDecode :: BL.ByteString -> IO TodayResponse
|
||||
todayDecode jsonBody = do
|
||||
let decoded = decode jsonBody :: Maybe TodayResponse
|
||||
case decoded of
|
||||
Just decoded -> return decoded
|
||||
Nothing -> error "Invalid JSON"
|
||||
|
||||
|
||||
-- yesterdayDecode :: BL.ByteString -> IO YesterdayResponse
|
||||
-- yesterdayDecode jsonBody = do
|
||||
-- let decoded = decode jsonBody :: Maybe YesterdayResponse
|
||||
-- case decoded of
|
||||
-- Just decoded -> return decoded
|
||||
-- Nothing -> error "Invalid JSON"
|
33
app/Main.hs
33
app/Main.hs
@ -1,9 +1,11 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} --needed for ByteString arguments
|
||||
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
|
||||
import Data.Time as T
|
||||
|
||||
import Plot
|
||||
import DataTypes
|
||||
|
||||
|
||||
data WhichDay = Yesterday | Today | Tomorrow
|
||||
@ -30,20 +32,23 @@ main = do
|
||||
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 yesterdayRequest = apiRequestBuilder apiKey Yesterday city yesterdayDate
|
||||
-- yesterdayResponse <- httpLBS yesterdayRequest
|
||||
-- print $ getResponseStatusCode yesterdayResponse
|
||||
|
||||
-- yesterdayDecoded <- yesterdayDecode $ getResponseBody yesterdayResponse
|
||||
-- print yesterdayDecoded
|
||||
|
||||
let todayRequest = apiRequestBuilder apiKey Today city todayDate
|
||||
todayResponse <- httpLBS todayRequest
|
||||
putStrLn $ show todayRequest
|
||||
putStrLn $ show $ getResponseStatusCode todayResponse
|
||||
print $ getResponseStatusCode todayResponse
|
||||
|
||||
let tomorrowRequest = apiRequestBuilder apiKey Tomorrow city tomorrowDate
|
||||
tomorrowResponse <- httpLBS tomorrowRequest
|
||||
putStrLn $ show tomorrowRequest
|
||||
putStrLn $ show $ getResponseStatusCode tomorrowResponse
|
||||
todayDecoded <- todayDecode $ getResponseBody todayResponse
|
||||
print todayDecoded
|
||||
|
||||
-- let tomorrowRequest = apiRequestBuilder apiKey Tomorrow city tomorrowDate
|
||||
-- tomorrowResponse <- httpLBS tomorrowRequest
|
||||
-- print $ getResponseStatusCode tomorrowResponse
|
||||
|
||||
--apiResponse <- httpJSON "http://httpbin.org/get" :: IO (Response ()) -- specifying type as httpJSON return value is ambigious
|
||||
|
||||
@ -91,7 +96,7 @@ apiRequestBuilder apiKey day city date =
|
||||
}
|
||||
|
||||
|
||||
getCurrentDate :: IO Day
|
||||
getCurrentDate :: IO T.Day
|
||||
getCurrentDate = do
|
||||
currentTime <- getCurrentTime
|
||||
timeZone <- getCurrentTimeZone
|
||||
@ -100,5 +105,5 @@ getCurrentDate = do
|
||||
return currentDate
|
||||
|
||||
|
||||
formatDate :: Day -> String
|
||||
formatDate :: T.Day -> String
|
||||
formatDate = formatTime defaultTimeLocale "%Y-%m-%d"
|
@ -59,6 +59,7 @@ executable profun
|
||||
|
||||
-- Modules included in this executable, other than Main.
|
||||
other-modules: Plot
|
||||
DataTypes
|
||||
|
||||
-- LANGUAGE extensions used by modules in this package.
|
||||
-- other-extensions:
|
||||
|
Loading…
Reference in New Issue
Block a user