{- | Simple stupid output of common types of html -} module HAppS.Helpers.HtmlOutput.Common where import HAppS.Server.SimpleHTTP import Control.Monad import Text.StringTemplate import Text.StringTemplate.Helpers import Data.List import Safe (atMay) -- | fullUrlLink \"http://www.google.com\" -- | for when you want a link that the anchor text is the full url. eg, for displaying a url for darcs get. fullUrlLink :: FilePath -> String fullUrlLink url = simpleLink (url,url) -- | simpleLink (\"http://www.google.com\",\"google is a nice way to look for information\") simpleLink :: (FilePath,String) -> String simpleLink (url,anchortext) = render1 [("url",url),("anchortext",anchortext)] "$anchortext$" {- | like simpleLink, but a link tag is class=attention if class attention is defined via css you can get some useful behavior. I typically do something like the following, in a global css file: a.attention:link {color: orange} a.attention:active {color: orange} a.attention:visited {color: orange} a.attention:hover {color: orange} -} simpleAttentionLink :: (String, String) -> String simpleAttentionLink (url,anchortext) = render1 [("url",url),("anchortext",anchortext)] "$anchortext$" {- | width and height args blank blank if you don't want to specify this simpleImage (url, alttext) (width, height) = ... -} simpleImage :: (FilePath,String) -> (String,String) -> String simpleImage (url, alttext) (width, height) = render1 [("url",url),("alttext",alttext),("width",width),("height",height)] "" -- | format a list of text vertically by putting list items in paragraphs paintVHtml :: [String] -> String paintVHtml = concatMap p where p s = render1 [("s",s)] "
$s$
" {- | paintTable mbHeaderCells datacells mbPagination = ... mbHeaderCells: text for header cells, if you want them. Can use html formatting if desired. pagination also optional -} paintTable :: Maybe [String] -> [[String]] -> Maybe Pagination -> String paintTable _ [] _ = "" paintTable mbHeaderCells datacells mbPagination = let trows = maybe rows ( (++rows) . paintHeaderTr) mbHeaderCells where rows = paintTrs tableCells tableCells :: [[String]] tableCells = maybe datacells (getPaginatedCells datacells) mbPagination paginationBar :: String paginationBar = maybe "" (paintPaginationBar datacells) mbPagination in ( table trows ) ++ paginationBar where paintHeaderTr hc = tr . concat . (map (td {-. biggerfont -} ) ) $ hc paintTrs cells = concat . map (tr . concat) . ( (map . map) td ) $ cells tr x = "