weather-api 0.2.0 → 0.3.0
raw patch · 5 files changed
+88/−75 lines, 5 filesdep +aesondep +attoparsecdep +bytestringdep −hxt
Dependencies added: aeson, attoparsec, bytestring, vector
Dependencies removed: hxt
Files
- WeatherApi.hs +5/−1
- WeatherApi/Google.hs +0/−71
- WeatherApi/Util.hs +5/−0
- WeatherApi/WWOnline.hs +70/−0
- weather-api.cabal +8/−3
WeatherApi.hs view
@@ -59,7 +59,11 @@ , condition :: String } deriving (Eq, Show) -data ApiError = NotFoundError String | NetworkError String deriving Show+data ApiError = NotFoundError String+ | NetworkError String+ | ParseError String+ deriving Show+ type ApiResponse = Either ApiError Weather mkWeatherHandler c@(Config apiHost apiPort queryFun) =
− WeatherApi/Google.hs
@@ -1,71 +0,0 @@-{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}-module WeatherApi.Google (initApi) where--import Text.XML.HXT.Core-import Network.HTTP-import Network.URI-import WeatherApi-import Control.Monad (liftM)-import Codec.Binary.UTF8.String--apiUrl = "http://www.google.com/ig/api?"--type Lang = String-type Enc = String---- | Make config for use with WeatherApi functions-initApi :: Lang -> Enc -> Config-initApi lang enc =- let params = [("hl", lang), ("oe", enc)]- urn c = urlEncodeVars $ params ++ [("weather", encodeString c)]- in Config { apiHost = "www.google.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--atTag tag = deep (isElem >>> hasName tag)-dataAtTag tag = atTag tag >>> getAttrValue "data"--parseWeather = atTag "current_conditions" >>>- proc x -> do- tempF' <- dataAtTag "temp_f" -< x- tempC' <- dataAtTag "temp_c" -< x- humidity' <- dataAtTag "humidity" -< x- windCondition' <- dataAtTag "wind_condition" -< x- condition' <- dataAtTag "condition" -< x- returnA -< Weather- { tempF = read tempF'- , tempC = read tempC'- , humidity = humidity'- , windCondition = windCondition'- , condition = condition'- }--parseXML = readString [ withValidate no- , withRemoveWS yes- ]---- | This return function witch will actualy retrieve and parse weather from stream-makeQueryFun :: (String -> String) -> (HandleStream String) -> String -> IO ApiResponse-makeQueryFun q stream city =- do- resp <- retrieve stream $ q city- case liftM parseXML resp of- Left a -> return $ Left a- Right a -> do- r <- runX(a >>> parseWeather)- case r of- [] -> return $ Left $ NotFoundError "can't retrieve weather"- (x:xs) -> return $ Right x
+ WeatherApi/Util.hs view
@@ -0,0 +1,5 @@+module WeatherApi.Util where++mapName "data_" = "data"+mapName "type_" = "type"+mapName other = other
+ WeatherApi/WWOnline.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}+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++-- | Make config for use with WeatherApi functions+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++-- | This return function witch will actualy retrieve and parse weather from stream+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
weather-api.cabal view
@@ -1,5 +1,5 @@ Name: weather-api-Version: 0.2.0+Version: 0.3.0 Synopsis: Weather api implemented in haskell Description: This library implement generic api for retrieving weather@@ -15,12 +15,17 @@ Cabal-version: >= 1.6 Library- Exposed-modules: WeatherApi, WeatherApi.Google+ Exposed-modules: WeatherApi, WeatherApi.WWOnline+ Other-modules:+ WeatherApi.Util Build-depends: base == 4.* ,network == 2.3.*- ,hxt == 9.2.* ,HTTP == 4000.2.* ,utf8-string == 0.3.7+ ,aeson == 0.6.*+ ,bytestring == 0.9.*+ ,attoparsec == 0.10.*+ ,vector == 0.10.* source-repository head type: git