Render.hs

-- |
-- Module:     Web.Page.Render
-- Copyright:  (c) 2014 Ertugrul Soeylemez
-- License:    BSD3
-- Maintainer: Ertugrul Soeylemez <ertesx@gmx.de>
--
-- This module provides the functionality to render web pages.  This is
-- the process to construct and then render a web page:
--
--  1. Use a writer monad to construct a 'Widget', which represents a
--     web page component and is usually constructed from multiple
--     smaller components,
--
--  2. use one of the rendering functions to render a widget to a
--     'Page', which represents a rendered web page, but still abstracts
--     over the exact set of documents (everything inline or a set of
--     separate documents for markup, script and style),
--
--  3. turn the page into a set of documents that you can deliver to the
--     client, for example by using 'inlinePage'.
--
-- The motivation for rendering to separate documents is that most web
-- pages consist of dynamic markup, but the stylesheet and script is
-- mostly static.  The way 'Page' works you can have widgets with
-- batteries included and still render to separate documents to utilise
-- the client's cache better.
--
-- Helper functions for doing that are defined in this module, but
-- framework-specific support is necessary to make this work.

module Web.Page.Render
    ( -- * Rendering pages
      Page(..),
      renderWidget,

      -- * Single document
      inlinePage
    )
    where

import qualified Clay
import qualified Data.ByteString.Lazy as Bl
import qualified Data.Map.Strict as M
import qualified Data.Text.Lazy as Tl
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import qualified Text.PrettyPrint.Leijen.Text as Pp
import Data.Foldable (foldMap)
import Data.Monoid
import Data.Text (Text)
import Language.Javascript.JMacro (renderJs)
import Text.Blaze.Html
import Text.Blaze.Html.Renderer.Utf8
import Web.Page.Widget


-- | Rendered pages.  This type supports rendering to multiple documents
-- like an HTML document, as explained above.
--
-- If you're running a low-traffic site and don't want to afford the
-- complexity, then you can just include the stylesheets and scripts
-- inline by using the 'inlinePage' function.  Except for external
-- script and style URLs this will give you a self-contained document
-- that you can deliver to the client.
--
-- The 'pageHtml' field is the function that takes the markup for the
-- script and the style respectively and returns a lazy bytestring that
-- you can send as @text/html@ to the client.  The other two fields are
-- the rendered script and stylesheet.  The markup is UTF-8-encoded,
-- which you should indicate in the @content-type@ header, if you
-- deliver via HTTP.

data Page =
    Page {
      pageHtml   :: Html -> Html -> Bl.ByteString,  -- ^ Markup document.
      pageScript :: Tl.Text,                        -- ^ Page script.
      pageStyle  :: Tl.Text                         -- ^ Page stylesheet.
    }


-- | Render the given page to a single self-contained document,
-- including the script and stylesheet inline.

inlinePage :: Page -> Bl.ByteString
inlinePage p = pageHtml p scInc stInc
    where
    Page { pageScript = sc,
           pageStyle  = st
         } = p

    scInc | Tl.null sc = mempty
          | otherwise  = H.script (toHtml sc)

    stInc | Tl.null st = mempty
          | otherwise  = H.style (toHtml st)


-- | This is the most general rendering function for widgets.

renderWidget ::
    (Ord k)
    => [k]               -- ^ Sections to render.
    -> ([Text] -> Text)  -- ^ Title renderer.
    -> Widget k Text     -- ^ Widget to render.
    -> Page
renderWidget ss renderTitle w =
    Page { pageHtml   = \scInc stInc -> renderHtml (html scInc stInc),
           pageScript = Pp.displayT . Pp.renderOneLine . renderJs . _wScript $ w,
           pageStyle  = Clay.renderWith Clay.compact [] . _wStyle $ w }

    where
    html :: Html -> Html -> Html
    html scInc stInc =
        H.docType <>
        H.html (H.head headH <>
                H.body bodyH)

        where
        bodyH =
            foldMap section ss <>
            foldMap scLink (_wScriptLinks w) <>
            scInc

        headH =
            H.title (toHtml title) <>
            _wHead w <>
            foldMap stLink (_wStyleLinks w) <>
            stInc

        section =
            maybe mempty id .
            (`M.lookup` _wSections w)

        scLink url = H.script mempty ! A.src (toValue url)

        stLink url =
            H.link ! A.rel "stylesheet"
                   ! A.href (toValue url)

        title = renderTitle . maybe [] id . getLast . _wTitle $ w