{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS -fno-warn-name-shadowing -fno-warn-unused-do-bind #-} module Text.Blaze.Extra where import Control.Monad import Data.Monoid import Prelude hiding (head,div) import Text.Blaze.Html5 as H hiding (map) import Text.Blaze.Html5.Attributes as A import Text.Blaze.Internal (Attributable) import Network.URI.Params import Network.URI import Text.Printf import Data.List (intercalate) -- | Add an class to an element. (!.) :: (Attributable h) => h -> AttributeValue -> h elem !. className = elem ! class_ className -- | Add an id to an element. (!#) :: (Attributable h) => h -> AttributeValue -> h elem !# idName = elem ! A.id idName -- | Render a list of lines (separated by \n) to HTML. linesToHtml :: String -> Html linesToHtml str = forM_ (lines str) $ \line -> do toHtml line; br -- | Intercalate some HTML. htmlIntercalate :: Html -> [Html] -> Html htmlIntercalate _ [x] = x htmlIntercalate sep (x:xs) = do x; sep; htmlIntercalate sep xs htmlIntercalate _ [] = mempty -- | Make a list of html into a comma separated html. htmlCommas :: [Html] -> Html htmlCommas = htmlIntercalate ", " -- | Set a parameter of a URI, as an attribute. hrefSet :: URI -> String -> String -> Attribute hrefSet uri key value = hrefURI updated where updated = updateUrlParam key value uri -- | Provide a URI as an attribute for href. hrefURI :: URI -> Attribute hrefURI uri = href (toValue (showURI uri)) where showURI URI{..} = uriPath ++ uriQuery -- | Create an href from a path and association list of parameters. -- Usage: -- -- @hrefAssoc \"/search\" [(\"query\", \"foo\"), (\"mode\", \"bar\")]@ -- -- Creates: @href \"/search?query=foo&mode=bar\"@ hrefAssoc :: String -> [(String,String)] -> Attribute hrefAssoc path qs = href (toValue uri) where uri = "/" ++ path ++ "?" ++ intercalate "&" (map (uncurry (printf "%s=%s")) qs) -- | Link to a CSS stylesheet. css :: H.AttributeValue -> H.Html css link = H.link ! A.rel "stylesheet" ! A.type_ "text/css" ! A.href link -- | Link to a javscript file. js :: H.AttributeValue -> H.Html js link = H.script ! A.type_ "text/JavaScript" ! A.src link $ "" -- | Create a link. linkTo :: H.AttributeValue -> H.Html -> H.Html linkTo url = H.a ! A.href url -- | Create a form with method = \"POST\" that posts to the given url. postForm :: String -> H.Html -> H.Html postForm uri = H.form ! A.action (H.toValue uri) ! A.method "post"