HXT/Practical/Weather1

{-# LANGUAGE Arrows, NoMonomorphismRestriction #-} import Text.XML.HXT.Arrow import Network.HTTP import Network.URI weatherDataURL = "http://www.weather.gov/data/current_obs/KAGC.xml" retrieveWeatherData = do case parseURI weatherDataURL of Nothing -> ioError . userError $ "Invalid URL" Just uri -> get uri get uri = do eresp <- simpleHTTP (Request uri GET [] "") case eresp of Left _ -> ioError . userError $ "Failed to get " ++ show uri Right res -> return $ rspBody res parseXML doc = readString [(a_validate,v_0)] doc data Weather = Weather { location, observationTime, summary, windDirection :: String, temperature, humidity, dewpoint, heatIndex, pressure, windSpeed, visibility :: Float } deriving (Eq, Show) atTag tag = deep (isElem >>> hasName tag) text = getChildren >>> getText textAtTag tag = atTag tag >>> text getWeather = atTag "current_observation" >>> proc x -> do loc <- textAtTag "location" -< x obsTime <- textAtTag "observation_time" -< x summ <- textAtTag "weather" -< x windDir <- textAtTag "wind_dir" -< x temp <- textAtTag "temp_c" -< x humi <- textAtTag "relative_humidity" -< x wind <- textAtTag "wind_mph" -< x pres <- textAtTag "pressure_mb" -< x dew <- textAtTag "dewpoint_c" -< x heat <- textAtTag "heat_index_c" -< x vis <- textAtTag "visibility_mi" -< x returnA -< Weather { location = loc, observationTime = obsTime, summary = summ, windDirection = windDir, temperature = read temp, humidity = read humi, windSpeed = read wind * 1.61, pressure = read pres, dewpoint = read dew, heatIndex = read heat, visibility = read vis * 1.61 } -- GHCi test: -- Main> retrieveWeatherData >>= \ doc -> runX (parseXML doc >>> getWeather) main = do doc <- retrieveWeatherData xml <- return $ parseXML doc result <- runX (xml >>> getWeather) case result of [] -> putStrLn "Unable to parse weather data." w:_ -> print w