Skip to content

Instantly share code, notes, and snippets.

@jaspervdj
Created March 15, 2010 07:31
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save jaspervdj/332603 to your computer and use it in GitHub Desktop.
A draft for the BlazeHtml API
<h1>A HTML combinator library proposition</h1>
> {-# LANGUAGE OverloadedStrings #-}
This is a proposal for a HTML combinator interface library. I'm writing this
document because I would like feedback and pointers on the API before I actually
start coding it.
> import Control.Monad.Reader
> import Control.Monad.State
> import Control.Monad
> import Data.Text (Text)
> import Data.Text.IO
> import GHC.Exts (IsString(..))
> import System.IO (Handle, stdout)
> import Data.Map (Map)
> import qualified Data.Text as T
> import qualified Data.Text.IO as IO
> import qualified Data.Map as M
We do not want to store our HTML in intermediate data structures, because that
would only cost us performance. Instead, you choose an `Outputter` who decides
what happens with the rendered HTML.
> type Outputter = Text -> IO ()
HTML element attributes are stored in a `Map` to avoid duplication of entries.
> type Attributes = Map Text Text
We now have a custom monad stack for HTML generation.
> type Html = ReaderT Outputter (StateT Attributes IO)
The following is a simple function which renders HTML element attributes.
> renderAttributes :: Attributes -> Text
> renderAttributes = M.foldWithKey append T.empty
> where
> append k v = T.append (k `T.append` "=\"" `T.append` v `T.append` "\" ")
Next comes a less straightforward function, rendering a leaf element, for
example an `<img>` element. Note that we take the attributes and drop them
immediately, so they are only used for the current element.
> renderLeafElement :: Text -> Html ()
> renderLeafElement tag = do
> outputter <- ask
> attributes <- get
> liftIO $ outputter $ "<" `T.append` tag `T.append` " "
> `T.append` renderAttributes attributes
> `T.append` "/>"
> put M.empty
The function that renders an element containing more html is very similar, in
such a way that it should probably be abstracted, but hey, this is only a draft.
> renderElement :: Text -> Html () -> Html ()
> renderElement tag inner = do
> outputter <- ask
> attributes <- get
> liftIO $ outputter $ "<" `T.append` tag `T.append` " "
> `T.append` renderAttributes attributes
> `T.append` ">"
> put M.empty
> inner
> liftIO $ outputter $ "</" `T.append` tag `T.append` ">"
Finally, let's define a function to just render text.
> renderText :: Text -> Html ()
> renderText text = do
> outputter <- ask
> liftIO $ outputter text
Because we like the `!` syntax for attributes from the original HTML package,
we use it here, too. This function just has to set the attributes in the state.
> (!) :: Html () -> [(Text, Text)] -> Html ()
> html ! attributes = do
> attributes' <- get
> put $ M.fromList attributes `M.union` attributes'
> html
The following functions are some common HTML elements for illustration purposes.
> em :: Html () -> Html ()
> em = renderElement "em"
> h1 :: Text -> Html ()
> h1 = renderElement "h1" . renderText
> img :: Text -> Text -> Html ()
> img src alt = renderLeafElement "img" ! [("src", src), ("alt", alt)]
> p :: Html () -> Html ()
> p = renderElement "p"
> text :: Text -> Html ()
> text = renderText
We need a state and a reader to run our HTML functions. I provide a very simple
default here for as an illustration. In real applications the Outputter could
write directly to a socket or the disk.
> renderDefault :: Html () -> IO ()
> renderDefault html = evalStateT (runReaderT html IO.putStr) M.empty
Okay, now we can finally look at our main function, which shows our monadic
interface for HTML combinators.
> main = renderDefault $ do
> h1 "BlazeHtml" ! [("id", "header")]
> img "logo.png" "BlazeHtml logo"
> p $ do text "BlazeHtml is a blazing fast HTML combinator library."
> em $ text "BlazeHtml uses a monadic interface."
> text "This gives us very readable code."
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment