{-# LANGUAGE OverloadedStrings #-} module Text.Blaze.Renderer.Utf8 ( renderHtml , renderHtmlToByteStringIO ) where import Data.Monoid (mappend, mempty) import Data.List (isInfixOf) import qualified Data.ByteString.Lazy as L import qualified Data.Text as T (isInfixOf) import qualified Data.ByteString as S (ByteString, isInfixOf) import Text.Blaze.Internal import Blaze.ByteString.Builder (Builder) import qualified Blaze.ByteString.Builder as B import qualified Blaze.ByteString.Builder.Html.Utf8 as B -- | Render a 'ChoiceString'. -- fromChoiceString :: ChoiceString -- ^ String to render -> Builder -- ^ Resulting builder fromChoiceString (Static s) = B.copyByteString $ getUtf8ByteString s fromChoiceString (String s) = B.fromHtmlEscapedString s fromChoiceString (Text s) = B.fromHtmlEscapedText s fromChoiceString (ByteString s) = B.fromByteString s fromChoiceString (PreEscaped x) = case x of String s -> B.fromString s Text s -> B.fromText s s -> fromChoiceString s fromChoiceString (External x) = case x of -- Check that the sequence " if " if " if " fromChoiceString s fromChoiceString (AppendChoiceString x y) = fromChoiceString x `mappend` fromChoiceString y fromChoiceString EmptyChoiceString = mempty {-# INLINE fromChoiceString #-} -- | Render some 'Html' to a 'Builder'. -- renderBuilder :: Html -- ^ HTML to render -> Builder -- ^ Resulting builder renderBuilder = go mempty where go :: Builder -> HtmlM b -> Builder go attrs (Parent open close content) = B.copyByteString (getUtf8ByteString open) `mappend` attrs `mappend` B.fromChar '>' `mappend` go mempty content `mappend` B.copyByteString (getUtf8ByteString close) go attrs (Leaf begin end) = B.copyByteString (getUtf8ByteString begin) `mappend` attrs `mappend` B.copyByteString (getUtf8ByteString end) go attrs (AddAttribute key value h) = go (B.copyByteString (getUtf8ByteString key) `mappend` fromChoiceString value `mappend` B.fromChar '"' `mappend` attrs) h go attrs (AddCustomAttribute key value h) = go (fromChoiceString key `mappend` fromChoiceString value `mappend` B.fromChar '"' `mappend` attrs) h go _ (Content content) = fromChoiceString content go attrs (Append h1 h2) = go attrs h1 `mappend` go attrs h2 go _ Empty = mempty {-# NOINLINE go #-} {-# INLINE renderBuilder #-} -- | Render HTML to a lazy UTF-8 encoded 'L.ByteString.' -- renderHtml :: Html -- ^ HTML to render -> L.ByteString -- ^ Resulting 'L.ByteString' renderHtml = B.toLazyByteString . renderBuilder {-# INLINE renderHtml #-} -- | Repeatedly render HTML to a buffer and process this buffer using the given -- IO action. -- renderHtmlToByteStringIO :: (S.ByteString -> IO ()) -- ^ IO action to execute per rendered buffer -> Html -- ^ HTML to render -> IO () -- ^ Resulting IO action renderHtmlToByteStringIO io = B.toByteStringIO io . renderBuilder {-# INLINE renderHtmlToByteStringIO #-}