{- | Simple stupid output of common types of html -} module Happstack.Helpers.HtmlOutput.Common where import Happstack.Server.SimpleHTTP import Control.Monad (mplus) import Text.StringTemplate import Text.StringTemplate.Helpers import Data.List import Safe (atMay) import Data.String.Utils import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L -- | 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] -- ^ optional header rows -> [[String]] -- ^ table cells -> Maybe Pagination -- ^ optional pagination -> String paintTable mbHeaderRows = case mbHeaderRows of Just rs -> paintTable' defTableF defTrF defSpacerRow (Just (rs,defTrF)) Nothing -> paintTable' defTableF defTrF defSpacerRow Nothing where defTableF rows = render1 [("rows",rows)] "