module WeatherApi.WWOnline where
import Network.HTTP
import Network.URI
import WeatherApi hiding (humidity)
import Codec.Binary.UTF8.String (encodeString)
import Data.ByteString.Char8 (pack, unpack)
import Data.Aeson
import Data.Aeson.TH
import Data.Attoparsec hiding (Result(..))
import Data.Maybe
import Control.Applicative
import qualified Data.Vector as V
import WeatherApi.Util
apiUrl = "http://free.worldweatheronline.com/feed/weather.ashx?"
type ApiKey = String
instance FromJSON Weather where
parseJSON (Object o) = do
Object d <- o .: "data"
Object c <- return . V.head =<< d .: "current_condition"
Weather <$>
(read <$> c .: "temp_F") <*>
(read <$> c .: "temp_C") <*>
c .: "humidity" <*>
c .: "windspeedKmph" <*>
getDesc c
where getDesc c = c .: "weatherDesc" >>= (.: "value") . V.head
initApi :: ApiKey -> Config
initApi key =
let params = [("format", "json"), ("key", key)]
urn c = urlEncodeVars $ params ++ [("q", encodeString c)]
in Config { apiHost = "free.worldweatheronline.com"
, apiPort = 80
, queryFun = makeQueryFun urn
}
retrieve s urn =
case parseURI $ apiUrl ++ urn of
Nothing -> return $ Left $ NetworkError "Invalid URL"
Just uri -> get s uri
get s uri = do
eresp <- sendHTTP s (Request uri GET [] "")
case eresp of
Left err -> return $ Left $ NetworkError $ show err
Right res -> return $ Right $ rspBody res
makeQueryFun :: (String -> String)
-> (HandleStream String)
-> String
-> IO ApiResponse
makeQueryFun q stream city =
do
resp <- retrieve stream $ q city
case resp of
Left err -> return $ Left err
Right c -> do
let v = fromJust $ maybeResult $ parse json $ pack c
return $ case fromJSON v :: Result Weather of
Error e -> Left $ ParseError $ "Can't parse data: " ++ e
Success v -> Right v