Source code in the haskell programming language

{-# 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


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