--------------------------------------------------------------------
-- |
-- Module : hackage2hwn
-- Copyright : (c) Galois, Inc. 2007-2008
-- License : BSD3
--
-- Maintainer: Don Stewart <dons@galois.com>
-- Stability : provisional
--
-- Pulls the RSS feed from Hackage, pretty prints it in a form suitable for
-- inclusion in the Haskell Weekly News.
--
--------------------------------------------------------------------
module Main (main) where
import Data.Maybe
import Data.List
import Data.Char
import Data.Function
import qualified Data.Map as M
import Network.Curl.Download
import Text.HTML.TagSoup
import Text.Feed.Import
import Text.RSS.Syntax
import Text.Feed.Types
import System.IO.Unsafe
import Debug.Trace
-- current url
-- last week's url
url = "file:///home/dons/aur.xml"
main = do
Right src <- openURIString url
let Just (RSSFeed is) = parseFeedString src
mapM_ (\(c, x) -> do
putStrLn "<h3>"
putStr (case c of Just n -> toUpper (head n) : tail n
Nothing -> "Nothing")
putStrLn "</h3><ul>"
mapM_ (putStr . pprRSS) x
putStrLn "</ul>"
)
(clean . map (\x -> (x, findCategory x)) . rssItems . rssChannel $ is)
pprRSS :: RSSItem -> String
pprRSS r = concat [("<li>" ++ "<a href=\"" ++ url ++ "\">"++ title ++ "</a>: " ++ synopsis ++ "</li>")]
where
title = fromJust $ rssItemTitle $ r
Just url = rssItemLink $ r
-- May not be the actual synopsis. Parse the .cabal file instead?
synopsis = init . tail $ last [ e | TagText e <- parseTags
(fromJust . rssItemDescription $ r) ]
-- supposed to remove dupes...
clean :: [(RSSItem,Maybe Category)] -> [ (Maybe Category, [RSSItem]) ]
clean xs = [ (c, map fst g) | g <- groups
, let (h,c) = head g
]
where
groups =
groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ nubBy (
\(x,_) (y,_) ->
let a = takeWhile (\c -> c /= ' ' && not (isDigit c)) . fromJust $ rssItemTitle x
b = takeWhile (\c -> c /= ' ' && not (isDigit c)) . fromJust $ rssItemTitle y
in a == b ) xs
type Category = String
--
-- Roll your own hackage query bot
--
findCategory :: RSSItem -> Maybe Category
findCategory item = unsafePerformIO $ do
x <- openURIString url
case x of
Left err -> print err >> return Nothing
Right x -> do
let ys = parseTags x
ct = head . tail $ dropWhile (\x -> x /= "Category") [ x | TagText x <- ys ]
tag = normalise ct
return tag
where
Just url = rssItemLink item
normalise ct | l `elem` tags = Just l
| otherwise = rewrite ct
where
l = map toLower ct
-- rewrite
rewrite s = case M.lookup s table of
Just t -> t
Nothing -> Nothing
where
table = M.fromList
[ ("Compilers/Interpreters", Just "compilers")
, ("Data Structures", Just "data")
, ("Composition", Just "algorithm")
, ("Distribution", Just "devel")
, ("Development", Just "devel")
, ("Game", Just "games")
, ("FRP", Just "control") -- no tag!
, ("Monads", Just "control") -- no tag!
, ("Foreign Bindings", Nothing) -- meaningless
, ("User Interfaces", Just "gui")
, ("source-tools", Just "devel")
--
, ("Executables", Nothing) -- no tag!
, ("Home page", Nothing) -- no tag!
, ("Upload date", Nothing) -- no tag!
]
-- valid tags
tags =
["algorithm",
"audio",
"compilers",
"concurrency",
"control",
"codec",
"cryptography",
"data",
"database",
"devel",
"games",
"graphics",
"gui",
"language",
"math",
"music",
"network",
"sound",
"system",
"testing",
"text",
"types",
"web",
"xml" ]