Initial data commit

Task/Rosetta-Code-Count-examples/Haskell/rosetta-code-count-examples-1.hs

@@ -0,0 +1,37 @@
+import Network.Browser
+import Network.HTTP
+import Network.URI
+import Data.List
+import Data.Maybe
+import Text.XML.Light
+import Control.Arrow
+
+justifyR w = foldl ((.return).(++).tail) (replicate w ' ')
+showFormatted t n = t ++ ": " ++ justifyR 4 (show n)
+
+getRespons url = do
+    rsp <- Network.Browser.browse $ do
+      setAllowRedirects True
+      setOutHandler $ const (return ())     -- quiet
+      request $ getRequest url
+    return $ rspBody $ snd rsp
+
+getNumbOfExampels p = do
+  let pg = intercalate "_" $ words p
+  rsp <- getRespons $ "http://www.rosettacode.org/w/index.php?title=" ++ pg ++ "&action=raw"
+  let taskPage = rsp
+      countEx = length $ filter (=="=={{header|") $ takeWhile(not.null) $ unfoldr (Just. (take 11 &&& drop 1)) taskPage
+  return countEx
+
+progTaskExamples = do
+  rsp <- getRespons "http://www.rosettacode.org/w/api.php?action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500&format=xml"
+
+  let xmls = onlyElems $ parseXML $ rsp
+      tasks = concatMap (map (fromJust.findAttr (unqual "title")). filterElementsName (== unqual "cm")) xmls
+
+  taskxx <- mapM getNumbOfExampels tasks
+  let ns = taskxx
+      tot = sum ns
+
+  mapM_ putStrLn $ zipWith showFormatted tasks ns
+  putStrLn $ ("Total: " ++) $ show tot

Task/Rosetta-Code-Count-examples/Haskell/rosetta-code-count-examples-2.hs

@@ -0,0 +1,10 @@
+*Main> progTaskExamples
+100 doors:   56
+24 game:   11
+24 game Player:    9
+99 Bottles of Beer:   73
+Abstract type:   23
+Ackermann Function:   61
+Active object:    9
+...
+Total: 9156

Task/Rosetta-Code-Count-examples/Haskell/rosetta-code-count-examples-3.hs

@@ -0,0 +1,82 @@
+$define RCINDEX "http://rosettacode.org/mw/api.php?format=xml&action=query&list=categorymembers&cmtitle=Category:Programming_Tasks&cmlimit=500"
+$define RCTASK  "http://rosettacode.org/mw/index.php?action=raw&title="
+$define RCUA    "User-Agent: Unicon Rosetta 0.1"
+$define RCXUA   "X-Unicon: http://unicon.org/"
+$define TASKTOT "* Total Tasks *"
+$define TOTTOT  "* Total Headers*"
+
+link strings
+link hexcvt
+
+procedure main(A)   # simple single threaded read all at once implementation
+    Tasks := table(0)
+    every task := taskNames() do {
+       Tasks[TASKTOT] +:= 1                            # count tasks
+       every lang := languages(task) do {              # count languages
+          Tasks[task] +:= 1
+          Tasks[TOTTOT] +:= 1
+          }
+       }
+    every insert(O := set(),key(Tasks))                # extract & sort keys
+    O := put(sort(O--set(TOTTOT,TASKTOT)),TASKTOT,TOTTOT)  # move totals to end
+    every write(k := !O, " : ", Tasks[k]," examples.") # report
+end
+
+# Generate task names
+procedure taskNames()
+    continue := ""
+    while \(txt := ReadURL(RCINDEX||continue)) do {
+        txt ? {
+            while tab(find("<cm ") & find(s :="title=\"")+*s) do
+                suspend tab(find("\""))\1
+            if tab(find("cmcontinue=")) then {
+                continue := "&"||tab(upto(' \t'))
+                }
+            else break
+            }
+        }
+end
+
+# Generate language headers in a task
+procedure languages(task)
+    static WS
+    initial WS := ' \t'
+    page := ReadURL(RCTASK||CleanURI(task))
+    page ? while (tab(find("\n==")),tab(many(WS))|"",tab(find("{{"))) do {
+               header := tab(find("=="))
+               header ? {
+                   while tab(find("{{header|")) do {
+                       suspend 2(="{{header|",tab(find("}}")))\1
+                       }
+                   }
+               }
+end
+
+procedure CleanURI(u)                  #: clean up a URI
+    static tr,dxml                     # xml & http translation
+    initial {
+       tr := table()
+       every c := !string(~(&digits++&letters++'-_.!~*()/\'`')) do
+          tr[c] := "%"||hexstring(ord(c),2)
+       every /tr[c := !string(&cset)] := c
+       tr[" "] := "_"                                      # wiki convention
+       every push(dxml := [],"&#"||right(ord(c := !"&<>'\""),3,"0")||";",c)
+       }
+
+    dxml[1] := u                       # insert URI as 1st arg
+    u := replacem!dxml                 # de-xml it
+    every (c := "") ||:= tr[!u]        # reencode everything
+    c := replace(c,"%3E","'")          # Hack to put single quotes back in
+    c := replace(c,"%26quot%3B","\"")  # Hack to put double quotes back in
+    return c
+end
+
+procedure ReadURL(url)                 #: read URL into string
+    page := open(url,"m",RCUA,RCXUA) | stop("Unable to open ",url)
+    text := ""
+    if page["Status-Code"] < 300 then while text ||:= reads(page,-1)
+    else write(&errout,image(url),": ",
+                       page["Status-Code"]," ",page["Reason-Phrase"])
+    close(page)
+    return text
+end