-- Common wrapper for HTML pages
module Distribution.Server.Pages.Template
( hackagePage
, hackagePageWith
, hackagePageWithHead
) where
import Text.XHtml.Strict
--TODO: replace all this with external templates
-- | Create top-level HTML document by wrapping the Html with boilerplate.
hackagePage :: String -> [Html] -> Html
hackagePage = hackagePageWithHead []
hackagePageWithHead :: [Html] -> String -> [Html] -> Html
hackagePageWithHead headExtra docTitle docContent =
hackagePageWith headExtra docTitle docSubtitle docContent bodyExtra
where
docSubtitle = anchor ! [href introductionURL] << "Hackage :: [Package]"
bodyExtra = []
hackagePageWith :: [Html] -> String -> Html -> [Html] -> [Html] -> Html
hackagePageWith headExtra docTitle docSubtitle docContent bodyExtra =
toHtml [ header << (docHead ++ headExtra)
, body << (docBody ++ bodyExtra) ]
where
docHead = [ thetitle << ("Hackage: " ++ docTitle)
, thelink ! [ rel "stylesheet"
, href stylesheetURL
, thetype "text/css"] << noHtml
-- if Search is enabled
, thelink ! [ rel "search", href "/packages/opensearch.xml"
, thetype "application/opensearchdescription+xml"
, title "Hackage" ] << noHtml
]
docBody = [ thediv ! [identifier "page-header"] << docHeader
, thediv ! [identifier "content"] << docContent ]
docHeader = [ navigationBar
, paragraph ! [theclass "caption"] << docSubtitle ]
navigationBar :: Html
navigationBar =
ulist ! [theclass "links", identifier "page-menu"]
<< map (li <<)
[ anchor ! [href introductionURL] << "Home"
, form ! [action "/packages/search", theclass "search", method "get"]
<< [ button ! [thetype "submit"] << "Search", spaceHtml
, input ! [thetype "text", name "terms" ] ]
, anchor ! [href pkgListURL] << "Browse"
, anchor ! [href recentAdditionsURL] << "What's new"
, anchor ! [href uploadURL] << "Upload"
, anchor ! [href accountsURL] << "User accounts"
]
stylesheetURL :: URL
stylesheetURL = "/static/hackage.css"
-- URL of the package list
pkgListURL :: URL
pkgListURL = "/packages/"
-- URL of the upload form
introductionURL :: URL
introductionURL = "/"
-- URL of the upload form
uploadURL :: URL
uploadURL = "/upload"
-- URL about user accounts, including the form to change passwords
accountsURL :: URL
accountsURL = "/accounts"
-- URL of the admin front end
adminURL :: URL
adminURL = "/admin"
-- URL of the list of recent additions to the database
recentAdditionsURL :: URL
recentAdditionsURL = "/recent"