[Haskell]http-conduit/xml-conduitでLivedoor Weather Web Serviceをクロール

lwws_crawler.hs

{-# LANGUAGE OverloadedStrings #-}

{-
  Livedoor Weather Web Service / LWWS Clawler
    http://weather.livedoor.com/weather_hacks/webservice.html

   using xml-conduit
     xml-conduit : http://www.yesodweb.com/book/xml
     Haskellでスクレイピング - html-conduit/xml-conduitの使い方 - Programming Experimental Laboratory : http://d.hatena.ne.jp/nebutalab/20120805/1344204068
-}

import System
import Control.Monad.IO.Class (liftIO)
import Network.HTTP.Conduit
import Control.Monad
import Data.Conduit
import Data.XML.Types
import Text.XML.Cursor
import qualified Text.XML as CX
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

weather :: Int -> String -> IO CX.Document
weather city day = runResourceT $ do
    manager <- liftIO $ newManager def
    request <- liftIO $ parseUrl $ "http://weather.livedoor.com/forecast/webservice/rest/v1" ++ "?city=" ++ show city ++ "&day=" ++ day
    response <- http request manager
    responseBody response $$ CX.sinkDoc CX.def


putTag ::  Cursor -> Name -> IO ()
putTag cursor tag = TIO.putStr $ T.concat [nameLocalName tag , T.pack " : " ,  T.unlines $ cursor $/ element tag &// content]

main :: IO [()]
main = do
  [city, day] <- getArgs
  doc <- weather (read city) day
  let cursor = fromDocument doc
  let tags = ["title", "link", "forecastday", "day", "forecastdate", "publictime", "telop", "description"]

  Prelude.sequence $ liftM (putTag cursor) tags