content: import Network.HTTP
  import Text.Parsec
  
  data YahooSearchItem = YahooSearchItem {
      itemUrl, itemTitle, itemContent :: String }
  
  data YahooSearch = YahooSearch {
      searchQuery :: String,
      searchPage :: Int,
      searchItems :: [YahooSearchItem] }
  
  -- URL for Yahoo! searches, without giving a page number
  yahooUrl = "http://search.yahoo.com/search?p="
  
  -- make an HTTP request and return a YahooSearch
  yahoo :: String -> IO YahooSearch
  yahoo q = simpleHTTP (getRequest $ yahooUrl ++ q) >>=
      getResponseBody >>= return . YahooSearch q 1 . items
  
  -- get some results and return the next page of results
  next :: YahooSearch -> IO YahooSearch
  next (YahooSearch q p _) =
      simpleHTTP (getRequest $
      -- add the page number to the search
      yahooUrl ++ q ++ "&b=" ++ show (p + 1)) >>=
      getResponseBody >>= return . YahooSearch q (p + 1) . items
  
  printResults :: YahooSearch -> IO ()
  printResults (YahooSearch q p items) = do
      putStrLn $ "Showing Yahoo! search results for query: " ++ q
      putStrLn $ "Page: " ++ show p
      putChar '\n'
      mapM_ printOne items
      where
          printOne (YahooSearchItem itemUrl itemTitle itemContent) = do
              putStrLn $ "URL   : " ++ itemUrl
              putStrLn $ "Title : " ++ itemTitle
              putStrLn $ "Abstr : " ++ itemContent
              putChar '\n'
  
  urlTag, titleTag, contentTag1, contentTag2, ignoreTag,
      ignoreText :: Parsec String () String
  
  -- parse a tag containing the URL of a search result
  urlTag = do { string "<a id=\"link-";
      many digit; string "\" class=\"yschttl spt\" href=\"";
      url <- manyTill anyChar (char '"'); manyTill anyChar (char '>');
      return url }
  
  -- the title comes after the URL tag, so parse it first, discard it
  -- and get the title text
  titleTag = do { urlTag; manyTill anyChar (try (string "</a>")) }
  
  -- parse a tag containing the description of the search result
  -- the tag can be named "sm-abs" or "abstr"
  contentTag1 = do { string "<div class=\"sm-abs\">";
      manyTill anyChar (try (string "</div>")) }
  
  contentTag2 = do { string "<div class=\"abstr\">";
      manyTill anyChar (try (string "</div>")) }
  
  -- parse a tag and discard it
  ignoreTag = do { char ('<'); manyTill anyChar (char '>');
      return "" }
  
  -- parse some text and discard it
  ignoreText = do { many1 (noneOf "<"); return "" }
  
  -- return only non-empty strings
  nonempty :: [String] -> Parsec String () [String]
  nonempty xs = return [ x | x <- xs, not (null x) ]
  
  -- a template to parse a whole source file looking for items of the
  -- same class
  parseCategory x = do
      res <- many x
      eof
      nonempty res
  
  urls, titles, contents :: Parsec String () [String]
  
  -- parse HTML source looking for URL tags of the search results
  urls = parseCategory url where
      url = (try urlTag) <|> ignoreTag <|> ignoreText
  
  -- parse HTML source looking for titles of the search results
  titles = parseCategory title where
      title = (try titleTag) <|> ignoreTag <|> ignoreText
  
  -- parse HTML source looking for descriptions of the search results
  contents = parseCategory content where
      content = (try contentTag1) <|> (try contentTag2) <|>
          ignoreTag <|> ignoreText
  
  -- parse the HTML source three times looking for URL, title and
  -- description of all search results and return them as a list of
  -- YahooSearchItem
  items :: String -> [YahooSearchItem]
  items q =
      let ignoreOrKeep = either (const []) id
          us = ignoreOrKeep $ parse urls "" q
          ts = ignoreOrKeep $ parse titles "" q
          cs = ignoreOrKeep $ parse contents "" q
      in [ YahooSearchItem { itemUrl = u, itemTitle = t, itemContent = c } |
          (u, t, c) <- zip3 us ts cs ]
  