Weather.hs

{-# LANGUAGE OverloadedStrings #-}

module Net.Weather
       ( Observation(..)
       , APIKey
       , City
       , State
       , getConditions
       ) where

import Control.Monad
import Control.Applicative

import Data.Text (Text)
import Data.Aeson
import Data.ByteString.Lazy.Char8 (pack)
import Network.HTTP (getResponseBody, simpleHTTP, getRequest)

import qualified Data.HashMap.Strict as H

-- | Observation data.
data Observation =
  Observation { obsTime        :: String  -- ^ The time the observation was taken.
              , obsWeather     :: String  -- ^ Description of the weather.
              , obsTemp        :: Float   -- ^ Temperature (F).
              , obsRelHumidity :: String  -- ^ Relative humidity (%).
              , obsWind        :: String  -- ^ Wind condition.
              , obsFeelsLike   :: String  -- ^ What it feels like.
              } deriving (Show)

instance FromJSON Observation where
  parseJSON (Object v) = Observation
                         <$> v .: "observation_time"
                         <*> v .: "weather"
                         <*> v .: "temp_f"
                         <*> v .: "relative_humidity"
                         <*> v .: "wind_string"
                         <*> v .: "feelslike_string"
  parseJSON _          = mzero

-- | API key. Obtain yours at http://wunderground.com.
type APIKey = String

-- | City name (e.g. Detroit).
type City = String

-- | State abbreviation (e.g. MI for Michigan).
type State = String

-- | Get the current weather conditions of a city.
getConditions :: APIKey -> City -> State -> IO (Maybe Observation)
getConditions key city state = do
  obj <- evalJSONRequest $ conditionsQuery key city state
  return $ obj >>= getProperty "current_observation"

-- Fetch a property from a JSON object.
getProperty :: FromJSON a => Text -> Value -> Maybe a
getProperty property (Object v) = do
  val <- H.lookup property v
  case fromJSON val of
   Error _   -> Nothing
   Success x -> Just x
getProperty _ _                 = Nothing

-- Evaluate a JSON request and return the parsed object.
evalJSONRequest :: FromJSON a => String -> IO (Maybe a)
evalJSONRequest request = do
  body <- getResponseBody <=< simpleHTTP $ getRequest request
  return . decode $ pack body

-- The query used to get weather conditions.
conditionsQuery :: String -> String -> String -> String
conditionsQuery key city state =
  "http://api.wunderground.com/api/" ++ key
  ++ "/conditions/q/" ++ state
  ++ "/" ++ city ++ ".json"