content: 
  -- | A renderer that produces a native Haskell 'String', mostly meant for
  -- debugging purposes.
  --
  {-# LANGUAGE OverloadedStrings #-}
  module Text.Blaze.Renderer.String
      ( -- fromChoiceString
      -- , renderMarkup
        renderHtml
      ) where
  
  import qualified Data.ByteString         as S
  import qualified Data.ByteString.Char8   as SBC
  import qualified Data.HashMap.Strict     as HMS
  import           Data.List               (isInfixOf)
  import           Data.Monoid
  import qualified Data.Text               as T
  
  import Text.Blaze.Internal
  
  -- | Escape predefined XML entities in a string
  --
  escapeMarkupEntities :: String  -- ^ String to escape
                     -> String  -- ^ String to append
                     -> String  -- ^ Resulting string
  escapeMarkupEntities []     k = k
  escapeMarkupEntities (c:cs) k = case c of
      '<'  -> '&' : 'l' : 't' : ';'             : escapeMarkupEntities cs k
      '>'  -> '&' : 'g' : 't' : ';'             : escapeMarkupEntities cs k
      '&'  -> '&' : 'a' : 'm' : 'p' : ';'       : escapeMarkupEntities cs k
      '"'  -> '&' : 'q' : 'u' : 'o' : 't' : ';' : escapeMarkupEntities cs k
      '\'' -> '&' : '#' : '3' : '9' : ';'       : escapeMarkupEntities cs k
      x    -> x                                 : escapeMarkupEntities cs k
  
  -- | Render a 'ChoiceString'.
  --
  fromChoiceString :: ChoiceString  -- ^ String to render
                   -> String        -- ^ String to append
                   -> String        -- ^ Resulting string
  fromChoiceString (Static s)     = getString s
  fromChoiceString (String s)     = escapeMarkupEntities s
  fromChoiceString (Text s)       = escapeMarkupEntities $ T.unpack s
  fromChoiceString (ByteString s) = (SBC.unpack s ++)
  fromChoiceString (PreEscaped x) = case x of
      String s -> (s ++)
      Text   s -> (\k -> T.foldr (:) k s)
      s        -> fromChoiceString s
  fromChoiceString (External x) = case x of
      -- Check that the sequence "</" is *not* in the external data.
      String s     -> if "</" `isInfixOf` s then id else (s ++)
      Text   s     -> if "</" `T.isInfixOf` s then id else (\k -> T.foldr (:) k s)
      ByteString s -> if "</" `S.isInfixOf` s then id else (SBC.unpack s ++)
      s            -> fromChoiceString s
  fromChoiceString (AppendChoiceString x y) =
      fromChoiceString x . fromChoiceString y
  fromChoiceString EmptyChoiceString = id
  
  -- | Render some 'Markup' to an appending 'String'.
  --
  renderString
      :: Markup ev  -- ^ Markup to render
      -> String     -- ^ String to append
      -> String     -- ^ Resulting String
  renderString =
      go id
    where
      go :: (String -> String) -> MarkupM ev b -> String -> String
      go attrs html = case html of
          MapActions _f content ->
              go attrs content
          OnEvent _ev content ->
              -- TODO (meiersi): add more details about the event handler registered.
              go attrs content
          Parent _ open close content ->
              getString open . attrs . ('>' :) . go id content . getString close
          CustomParent tag content ->
              ('<' :) . fromChoiceString tag . attrs . ('>' :) .
              go id content .
              ("</" ++) . fromChoiceString tag . ('>' :)
          Leaf _ begin end ->
              getString begin . attrs . getString end
          CustomLeaf tag close ->
              ('<' :) . fromChoiceString tag . attrs .
              (if close then (" />" ++) else ('>' :))
          AddAttribute _ key value h ->
              let attrs' = getString key . fromChoiceString value
                         . ('"' :) . attrs
              in go attrs' h
          AddBoolAttribute key value h ->
              let attrs' = (' ' :) . getString key . ("=\"" ++)
                         . ((if value then "true" else "false") ++) . ('"' :) .  attrs
              in go attrs' h
          AddCustomAttribute key value h ->
              let attrs' = (' ' :) . fromChoiceString key . ("=\"" ++)
                         . fromChoiceString value . ('"' :) .  attrs
              in go attrs' h
          AddObjectAttribute key object h ->
              let attrs' = (' ' :) . getString key . ("=\"" ++)
                         . ((T.unpack $ renderMap object) ++) . ('"' :) .  attrs
              in go attrs' h
          Content content -> fromChoiceString content
          Append h1 h2    -> go attrs h1 . go attrs h2
          Empty           -> id
  
  -- | Render a text-text map to the form used in CSS. Eg:
  --
  -- >>> renderMap $ fromList [("foo", "bar"), ("baz", "qux")]
  -- "foo: bar; baz: qux; "
  --
  --  TODO (asayers): Escape ':' and ';' characters.
  renderMap :: HMS.HashMap T.Text T.Text -> T.Text
  renderMap =
      HMS.foldlWithKey' (\acc key val -> acc <> key <> ": " <> val <> "; ") ""
  
  -- | Render markup to a lazy 'String'.
  --
  renderMarkup :: Show ev => Markup ev -> String
  renderMarkup html =
      renderString html ""
  
  renderHtml :: Show ev => Markup ev -> String
  renderHtml = renderMarkup
  