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.  The
-- following is the process to construct and then render a web page:
--
--  1. __Construction__:  Use a writer monad to construct a 'Widget',
--     which represents a web page component and is usually constructed
--     from multiple smaller components.
--
--  2. __Rendering__:  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. __Realisation__:  Realise the page as a set of documents that you
--     can deliver to the client, for example by using 'realiseInline'.
--
-- The motivation for rendering to separate documents is that most web
-- pages consist of dynamic markup, but the stylesheet and script are
-- 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,
      titleMajor,
      titleMinor,

      -- * Realising pages
      realiseInline
    )
    where

import qualified Clay
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 Blaze.ByteString.Builder (Builder)
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 realising a page as multiple
-- documents like an HTML document, a separate script and a separate
-- stylesheet, 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 'realiseInline' 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 builder 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, although a @meta@ element is included as a fallback.

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


-- | Realise the given page as a single self-contained document,
-- including the script and stylesheet inline.  The resulting string is
-- UTF-8-encoded and contains a @meta@ element to indicate that.  Read
-- the documentation of 'Page' for details.

realiseInline :: Page -> Builder
realiseInline 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.  The title
-- renderer receives the title chunks from outermost to innermost.
--
-- If you use type-safe routing and/or a sectioned or otherwise
-- non-'Html' body type, you should first apply the necessary
-- transformations to perform the routing and/or flattening or
-- conversion of the body.
--
-- Note that 'Widget' is a family of applicative functors.  There are
-- also predefined functions to assist you with this transformation.
-- See the "Web.Page.Route" module and the 'mapLinksA', 'mapLinksM' and
-- 'flattenBody' functions.

renderWidget ::
    ([Text] -> Tl.Text)  -- ^ Title renderer.
    -> Widget Text Html  -- ^ Widget to render.
    -> Page
renderWidget renderTitle w =
    Page { pageHtml   = \scInc stInc -> renderHtmlBuilder (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 =
            _wBody w <>
            foldMap scLink (_wScriptLinks w) <>
            scInc

        headH =
            H.title (toHtml title) <>
            H.meta ! A.charset "UTF-8" <>
            _wHead w <>
            foldMap stLink (_wStyleLinks w) <>
            stInc

        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


-- | Intercalate the given title chunks using the given separator,
-- highest level title first.  For most web sites 'titleMinor' is
-- preferable.
--
-- >>> titleMajor " - " ["site", "department", "page"]
-- "site - department - page"

titleMajor :: Text -> [Text] -> Tl.Text
titleMajor sep = Tl.intercalate (Tl.fromStrict sep) . map Tl.fromStrict


-- | Intercalate the given title chunks using the given separator,
-- lowest level title first.  This is much more common on web sites than
-- 'titleMajor', because it's usually more convenient for the user to
-- have the page title in the leftmost position (think about browser tab
-- captions and title bars).
--
-- >>> titleMinor " - " ["site", "department", "page"]
-- "page - department - site"

titleMinor :: Text -> [Text] -> Tl.Text
titleMinor sep = titleMajor sep . reverse