packages feed

himerge-0.17.9: src/Render.hs

{-
    Functions to parse and render the HTML/CSS code.
    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
-}

module Render (render, htmltemp)
    where

import Util
import Data.Char
    (isSpace)

csstemplate, htmltemp :: FilePath
csstemplate = "/usr/share/doc/himerge-" ++ hversion ++ "/himerge.css"
htmltemp = "hweb.html"

render :: String -> String
render = html . concatMap body . splitPackages
	 . lines . cleanOutput

html :: String -> String
html contents = "<html>\n<head>\n" 
		++ "<link title=\"new\" rel=\"stylesheet\" \
		   \ href=\"" ++ csstemplate ++ "\" type=\"text/css\">"
		++ "</head>\n<body>"
		++ contents ++ "\n<hr><center><a href=\"//http://www.haskell.org/himerge\">himerge</a>\n</body>\n</html>"

body :: [String] -> String
body [] = []
body (('*':' ':xs):xss) = "<p class=\"newshead\" lang=\"en\"><b>" 
			  ++ xs ++ "</b></p>\n<ul>" 
			  ++ makeMenu xss
body ((y@('[':_)):xss) = "overlay: " ++ y ++ "<br>" ++ makeMenu xss
body (_:xss) = body xss

makeMenu :: [String] -> String
makeMenu xs@(('[':_):_) = body xs -- check for overlays.
makeMenu ys = concatMap menu ys ++ "</ul>"
    where
    menu xs = let (label, value) = (break (== ':') xs) 
		  in
		  if null value
		     then label
		     else "<li><strong>" ++ label ++ "</strong> => " 
			  ++ searchValues (tail value) ++ "</li>\n"

splitPackages :: [String] -> [[String]]
splitPackages listp = let (pkg, pkgs) = break (null . words) listp
			  in
			  case pkgs of
			    [] -> [pkg]
			    (_:rst) -> pkg : splitPackages rst

searchValues :: String -> String
{- | Highlight the package link.
   Add '//' to the link name to avoid accesing the page
   from the mozembed. -}
searchValues = makelink . dropWhile isSpace 
    where
    makelink xss@('h':'t':'t':'p':':':'/':'/':_) = weblink xss
    makelink xss@('h':'t':'t':'p':'s':':':'/':'/':_) = weblink xss
    makelink xss@('f':'t':'p':':':'/':'/':_) = weblink xss
    makelink xss@('f':'t':'p':'s':':':'/':'/':_) = weblink xss
    makelink xs = xs

weblink :: String -> String
weblink link = "<a href=\"//" ++ link ++ "\">" ++ link ++ "</a>"