Data commit

Task/Rosetta-Code-Rank-languages-by-popularity/Haskell/rosetta-code-rank-languages-by-popularity-1.hs

@@ -0,0 +1,102 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+import Data.Aeson
+import Network.HTTP.Base (urlEncode)
+import Network.HTTP.Conduit (simpleHttp)
+import Data.List (sortBy, groupBy)
+import Data.Function (on)
+import Data.Map (Map, toList)
+
+-- Record representing a single language.
+data Language =
+    Language {
+        name      :: String,
+        quantity  :: Int
+    } deriving (Show)
+
+-- Make Language an instance of FromJSON for parsing of query response.
+instance FromJSON Language where
+    parseJSON (Object p) = do
+        categoryInfo <- p .:? "categoryinfo"
+
+        let quantity = case categoryInfo of
+                           Just ob -> ob .: "size"
+                           Nothing -> return 0
+
+            name = p .: "title"
+
+        Language <$> name <*> quantity
+
+-- Record representing entire response to query.
+-- Contains collection of languages and optional continuation string.
+data Report =
+    Report {
+        continue    :: Maybe String,
+        languages   :: Map String Language
+    } deriving (Show)
+
+-- Make Report an instance of FromJSON for parsing of query response.
+instance FromJSON Report where
+    parseJSON (Object p) = do
+        querycontinue <- p .:? "query-continue"
+
+        let continue
+                = case querycontinue of
+                      Just ob -> fmap Just $
+                                     (ob .: "categorymembers") >>=
+                                     (   .: "gcmcontinue")
+                      Nothing -> return Nothing
+
+            languages = (p .: "query") >>= (.: "pages")
+
+        Report <$> continue <*> languages
+
+-- Pretty print a single language
+showLanguage :: Int -> Bool -> Language -> IO ()
+showLanguage rank tie (Language languageName languageQuantity) =
+    let rankStr = show rank
+    in putStrLn $ rankStr ++ "." ++
+                      replicate (4 - length rankStr) ' ' ++
+                      (if tie then " (tie)" else "      ") ++
+                      " " ++ drop 9 languageName ++
+                      " - " ++ show languageQuantity
+
+-- Pretty print languages with common rank
+showRanking :: (Int,  [Language]) -> IO ()
+showRanking (ranking, languages) =
+    mapM_ (showLanguage ranking $ length languages > 1) languages
+
+-- Sort and group languages by rank, then pretty print them.
+showLanguages :: [Language] -> IO ()
+showLanguages allLanguages =
+    mapM_ showRanking $
+          zip [1..] $
+          groupBy ((==) `on` quantity) $
+          sortBy (flip compare `on` quantity) allLanguages
+
+-- Mediawiki api style query to send to rosettacode.org
+queryStr = "http://rosettacode.org/mw/api.php?" ++
+           "format=json" ++
+           "&action=query" ++
+           "&generator=categorymembers" ++
+           "&gcmtitle=Category:Programming%20Languages" ++
+           "&gcmlimit=100" ++
+           "&prop=categoryinfo"
+
+-- Issue query to get a list of Language descriptions
+runQuery :: [Language] -> String -> IO ()
+runQuery ls query = do
+    Just (Report continue langs) <- decode <$> simpleHttp query
+    let accLanguages = ls ++ map snd (toList langs)
+
+    case continue of
+        -- If there is no continue string we are done so display the accumulated languages.
+        Nothing -> showLanguages accLanguages
+
+        -- If there is a continue string, recursively continue the query.
+        Just continueStr -> do
+            let continueQueryStr = queryStr ++ "&gcmcontinue=" ++ urlEncode continueStr
+            runQuery accLanguages continueQueryStr
+
+main :: IO ()
+main = runQuery [] queryStr

Task/Rosetta-Code-Rank-languages-by-popularity/Haskell/rosetta-code-rank-languages-by-popularity-2.hs

@@ -0,0 +1,35 @@
+import Network.Browser
+import Network.HTTP
+import Network.URI
+import Data.List
+import Data.Maybe
+import Text.XML.Light
+import Control.Arrow
+import Data.Ord
+
+getRespons url = do
+    rsp <- Network.Browser.browse $ do
+      setAllowRedirects True
+      setOutHandler $ const (return ())     -- quiet
+      request $ getRequest url
+    return $ rspBody $ snd rsp
+
+
+mostPopLang = do
+  rsp <-getRespons $ "http://www.rosettacode.org/w/api.php?action=query&list=" ++
+		    "categorymembers&cmtitle=Category:Programming_Languages&cmlimit=500&format=xml"
+  mbrs <- getRespons "http://www.rosettacode.org/w/index.php?title=Special:Categories&limit=5000"
+  let xmls = onlyElems $ parseXML rsp
+      langs = concatMap (map ((\\"Category:"). fromJust.findAttr (unqual "title")). filterElementsName (== unqual "cm")) xmls
+
+  let catMbr = second (read.takeWhile(/=' '). drop 6). break (=='<'). drop 1. dropWhile(/='>') . drop 5
+      catNmbs :: [(String, Int)]
+      catNmbs = map catMbr $ filter (isPrefixOf "<li>") $ lines mbrs
+      printFmt (n,(l,m)) = putStrLn $ take 6 (show n ++ ".     ") ++ (show m) ++ "  " ++ l
+      toMaybe (a,b) =
+	case b of
+	  Just x -> Just (a,x)
+	  _ -> Nothing
+
+  mapM_ printFmt $  zip [1..] $ sortBy (flip (comparing snd))
+    $ mapMaybe (toMaybe. (id &&& flip lookup catNmbs)) langs