haskellblaze-html

Is there a less awkward way to use blaze-html with a Reader monad?


The BlazeHtml tutorial suggests using a Reader monad for real-world templating with BlazeHtml, but without illustrating how this should be done. I tried following this recommendation. The result leaves me confused.

To illustrate, assume I have a simple User type, and I want to compose my HTML using separate functions, one for the layout, and another for a part of the HTML page where I display user information. If I use a Reader Monad, it looks like this:

data User = User {
    username :: Text
  , userId :: nt
  } deriving (Show)

userBox :: Reader User Html
userBox = do
  user <- ask
  return $ do
      dl $ do
        dt $ "Username"
        dd $ H.toHtml $ username user
        dt $ "UserId"
        dd $ H.toHtml $ userId user

page :: Reader User Html
page = do
  user <- ask
  return $ H.docTypeHtml $ do
    H.head $ title "Reader Monad Blaze Example"
    H.body $ do
      h1 $ "Hello world"
      runReader userBox user

Compare this to my version that doesn't use the Reader monad:

userBox :: User -> Html
userBox user = do
      dl $ do
        dt $ "Username"
        dd $ H.toHtml $ username user
        dt $ "UserId"
        dd $ H.toHtml $ userId user

page :: User -> Html
page user = do
  H.docTypeHtml $ do
    H.head $ title "Blaze Example, No Reader Monad"
    H.body $ do
      h1 $ "Hello world"
      userBox user

So I'm having trouble seeing how a Reader Monad can actually tighten up the templating code in real-world use cases. Am I missing something?


Solution

  • If you expand your types you'll see that

    page :: Reader User Html
         :: Reader User Markup
         :: Reader User (MarkupM ())
    

    So you might get more leverage by using a transformer stack.

    l :: (Html -> Html) -> ReaderT r MarkupM () -> ReaderT r MarkupM ()
    l = mapReaderT
    
    r :: Html -> ReaderT r MarkupM ()
    r = lift
    
    asksHtml :: ToMarkup a => (r -> a) -> ReaderT r MarkupM ()
    asksHtml f = ReaderT (asks (H.toHtml . f))
    
    userBox :: ReaderT User MarkupM ()
    userBox = do
          l dl $ do
            r $ dt "Username"
            l dd (asksHtml username)
            r $ dt "UserId"
            l dd (asksHtml userId)
    
    page :: ReaderT User MarkupM ()
    page = do
      l H.docTypeHtml $ do
        r $ H.head $ title "Reader Monad Blaze Example"
        l H.body $ do
          r $ h1 "Hello world"
          userBox