102 lines
3.4 KiB
Haskell
102 lines
3.4 KiB
Haskell
{-# 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
|