Data commit

Task/Yahoo-search-interface/Haskell/yahoo-search-interface-1.hs

@@ -0,0 +1,105 @@
+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 ]

Task/Yahoo-search-interface/Haskell/yahoo-search-interface-2.hs

@@ -0,0 +1,43 @@
+link printf,strings
+
+procedure main()
+YS := YahooSearch("rosettacode")
+every 1 to 2 do {   # 2 pages
+   YS.readnext()
+   YS.showinfo()
+   }
+end
+
+class YahooSearch(urlpat,page,response)  #: class for Yahoo Search
+
+   method readnext()    #: read the next page of search results
+      self.page +:= 1   # can't find as w|w/o self
+      readurl()
+   end
+
+   method readurl()     #: read the url
+      url := sprintf(self.urlpat,(self.page-1)*10+1)
+      m := open(url,"m")  | stop("Unable to open : ",url)
+      every (self.response := "") ||:= |read(m)
+      close(m)
+      self.response := deletec(self.response,"\x00") # kill stray NULs
+   end
+
+   method showinfo()    #: show the info of interest
+      self.response ? repeat {
+         (tab(find("<")) & ="<a class=\"yschttl spt\" href=\"") | break
+         url   := tab(find("\"")) & tab(find(">")+1)
+         title := tab(find("<")) & ="</a></h3></div>"
+         tab(find("<")) & =("<div class=\"abstr\">" | "<div class=\"sm-abs\">")
+         abstr := tab(find("<")) & ="</div>"
+
+         printf("\nTitle : %i\n",title)
+         printf("URL   : %i\n",url)
+         printf("Abstr : %i\n",abstr)
+         }
+   end
+
+initially(searchtext)    #: initialize each instance
+   urlpat := sprintf("http://search.yahoo.com/search?p=%s&b=%%d",searchtext)
+   page := 0
+end