Data commit

Task/Yahoo-search-interface/Oz/yahoo-search-interface.oz

@@ -0,0 +1,147 @@
+declare
+  [HTTPClient] = {Module.link ['x-ozlib://mesaros/net/HTTPClient.ozf']}
+  [StringX] = {Module.link ['x-oz://system/String.ozf']}
+  [Regex] = {Module.link ['x-oz://contrib/regex']}
+
+  %% Displays page 1 and 3 of the search results.
+  %% The user can request and display more with context menu->Actions->Make Needed.
+  proc {ExampleUsage}
+     Pages = {YahooSearch "Rosetta code"}
+  in
+     {Inspector.configure widgetShowStrings true}
+     {ForAll {Nth Pages 1} Value.makeNeeded}
+     {ForAll {Nth Pages 3} Value.makeNeeded}
+     %% Display the infinite list of search result pages.
+     {Inspect Pages}
+  end
+
+  %% Returns a lazy list of pages.
+  %% A page is a lazy list of entries like this: result(url:U title:T content:C).
+  fun {YahooSearch Query}
+     FetchURL = {CreateURLFetcher}
+
+     fun {Page Nr}
+	StartResult = (Nr-1)*10+1
+	%% only retrieve it when really needed
+	Doc = {Value.byNeed fun {$}
+			       {FetchURL "http://search.yahoo.com/search"
+				["p"#Query "b"#{Int.toString StartResult}]}
+			    end}
+	RE = "<a class=\"yschttl spt\" href="
+     in
+	%% Lazily returns results.
+	%% In this way it is possible to build the pages list structure
+	%% without creating the single elements
+	%% (e.g. retrieve page 1 and 3 but not 2).
+	for Match in {Regex.allMatches RE Doc} yield:Yield do
+	   Xs = {List.drop Doc Match.0.2}
+	in
+	   {Yield {ParseEntry Xs}}	
+	end
+     end
+  in
+     for PageNr in 1;PageNr+1 yield:Yield do
+	{Yield {Page PageNr}}
+     end
+  end
+
+  fun {CreateURLFetcher}
+     Client = {New HTTPClient.cgiGET
+	       init(inPrms(toFile:false toStrm:true)
+		    httpReqPrms
+		   )}
+     %% close when no longer used
+     {Finalize.register Client proc {$ C} {C closeAll(true)} end}
+
+     fun {FetchURL Url Params}
+	OutParams
+     in
+	{Client getService(Url Params ?OutParams ?_)}
+	OutParams.sOut
+     end
+  in
+     FetchURL
+  end
+
+  %% Xs: String containing HtmL
+  %% Result: "result(url:U title:T content:C)" or "parseError"
+  fun {ParseEntry Xs}
+     proc {Parse Root}
+	R1 R2 R3 R4 R4 R5 R6 R7
+	Url = {Fix {QuotedString Xs R1}}
+	{Const ">" R1 R2}
+	Title = {Fix {Until "</a>" R2 R3}}
+	{Const "</h3></div>" R3 R4}
+	choice
+	   %% "enchanted" result?
+	   {Const "<div class=\"sm-bd sm-nophoto\" id=\"sm-bd-4-1\">" R4 R5}
+	   {Until "</div>" R5 R6 _}
+	[] %% result with links into document
+	   {Const "<div class=\"sm-bd sm-r\" id=\"sm-bd-8-1\">" R4 R5}
+	   {Until "</ul></div>" R5 R6 _}
+	[] %% PDF file
+	   {Const "<div class=\"format\">" R4 R5}
+	   {Until "</a></div>" R5 R6 _}
+	[] %% With Review
+	   {Const "<div class=\"sm-bd sm-r\" id=\"sm-bd-9-1\">" R4 R5}
+	   R6 = nil %% no nice abstract when a review is there
+	[] %% normal result
+	   R6 = R4
+	end
+	Abstract =
+	choice
+	   {Const "<div class=\"abstr\">" R6 R7}
+	   {Fix {Until "</div>" R7 _}}
+	[] {Const "<div class=\"sm-abs\">" R6 R7}
+	   {Fix {Until "</div>" R7 _}}
+	[] ""
+	end
+     in
+	Root = result(url:Url title:Title content:Abstract)
+     end
+  in
+     {CondSelect {SearchOne Parse} 1 parseError}
+  end
+
+  %% Result: contents of Xs until M is found.
+  %% Xs = {Append M Yr}
+  fun {Until M Xs ?Yr}
+     L R
+  in
+     {List.takeDrop Xs {Length M} L R}
+     if L == M then Yr = R nil
+     elsecase Xs of X|Xr then X|{Until M Xr Yr}
+     [] nil then Yr = nil nil
+     end
+  end
+
+  %% Asserts that Xs starts with C. Returns the remainder in Ys.
+  proc {Const C Xs ?Ys}
+     {List.takeDrop Xs {Length C} C Ys}
+  end
+
+  %% Assert that a quoted string follows.
+  %% Returns the unquoted string and binds Ys to the remainder of Xs.
+  fun {QuotedString &"|Xs ?Ys}
+     fun {Loop Xs Ys}
+	case Xs of &\\|&"|Xr then  &\\|&"|{Loop Xr Ys}
+	[] &"|Xr then Ys = Xr nil
+	[] X|Xr then X|{Loop Xr Ys}
+	end
+     end
+  in
+     {Loop Xs Ys}
+  end
+
+  %% Remove formatting tags.
+  fun {Fix Xs}
+     {Until "</a></h3>"
+      {FoldL ["<b>" "</b>" "<wbr />" "<wbr>" "<b>...</b>"]
+       fun {$ Ys Z}
+	  {StringX.replace Ys Z ""}
+       end
+       Xs}
+      _}
+  end
+in
+  {ExampleUsage}