--------------------------------------------------------------------
-- |
-- 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" ]