Difference between revisions of "HXT/Practical/Weather1"
Jump to navigation
Jump to search
UweSchmidt (talk | contribs) m |
(Use block markup for multiline code) |
||
(2 intermediate revisions by 2 users not shown) | |||
Line 1: | Line 1: | ||
− | < |
+ | <haskell> |
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-} |
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-} |
||
import Text.XML.HXT.Core |
import Text.XML.HXT.Core |
||
Line 5: | Line 5: | ||
import Network.URI |
import Network.URI |
||
− | weatherDataURL = "http://www.weather.gov/ |
+ | weatherDataURL = "http://www.weather.gov/xml/current_obs/KAGC.xml" |
retrieveWeatherData = do |
retrieveWeatherData = do |
||
Line 27: | Line 27: | ||
temperature, humidity, |
temperature, humidity, |
||
− | dewpoint |
+ | dewpoint, |
pressure, windSpeed, |
pressure, windSpeed, |
||
visibility :: Float } |
visibility :: Float } |
||
Line 47: | Line 47: | ||
pres <- textAtTag "pressure_mb" -< x |
pres <- textAtTag "pressure_mb" -< x |
||
dew <- textAtTag "dewpoint_c" -< x |
dew <- textAtTag "dewpoint_c" -< x |
||
− | heat <- textAtTag "heat_index_c" -< x |
||
vis <- textAtTag "visibility_mi" -< x |
vis <- textAtTag "visibility_mi" -< x |
||
returnA -< Weather |
returnA -< Weather |
||
Line 59: | Line 58: | ||
pressure = read pres, |
pressure = read pres, |
||
dewpoint = read dew, |
dewpoint = read dew, |
||
− | heatIndex = read heat, |
||
visibility = read vis * 1.61 } |
visibility = read vis * 1.61 } |
||
Line 72: | Line 70: | ||
[] -> putStrLn "Unable to parse weather data." |
[] -> putStrLn "Unable to parse weather data." |
||
w:_ -> print w |
w:_ -> print w |
||
− | </ |
+ | </haskell> |
Latest revision as of 16:04, 11 October 2011
{-# LANGUAGE Arrows, NoMonomorphismRestriction #-}
import Text.XML.HXT.Core
import Network.HTTP
import Network.URI
weatherDataURL = "http://www.weather.gov/xml/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 [ withValidate no
, withRemoveWS yes
] doc
data Weather = Weather
{ location, observationTime,
summary, windDirection :: String,
temperature, humidity,
dewpoint,
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
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,
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