diff --git a/Text/Blaze/Renderer/Text.hs b/Text/Blaze/Renderer/Text.hs new file mode 100644 --- /dev/null +++ b/Text/Blaze/Renderer/Text.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | A renderer that produces a lazy 'L.Text' value, using the Text Builder. +-- +module Text.Blaze.Renderer.Text + ( renderHtml + , renderHtmlWith + ) where + +import Data.Monoid (mappend, mempty) +import Data.List (isInfixOf) + +import Data.Text (Text) +import qualified Data.Text as T +import Data.Text.Encoding (decodeUtf8) +import qualified Data.Text.Lazy as L +import Data.ByteString (ByteString) +import qualified Data.ByteString as S (isInfixOf) + +import Text.Blaze.Internal +import Data.Text.Lazy.Builder (Builder) +import qualified Data.Text.Lazy.Builder as B + +-- | Escape HTML entities in a text value +-- +escapeHtmlEntities :: Text -- ^ Text to escape + -> Builder -- ^ Resulting text builder +escapeHtmlEntities = T.foldr escape mempty + where + escape :: Char -> Builder -> Builder + escape '<' b = B.fromText "<" `mappend` b + escape '>' b = B.fromText ">" `mappend` b + escape '&' b = B.fromText "&" `mappend` b + escape '"' b = B.fromText """ `mappend` b + escape '\'' b = B.fromText "'" `mappend` b + escape x b = B.singleton x `mappend` b + +-- | Render a 'ChoiceString'. TODO: Optimization possibility, apply static +-- argument transformation. +-- +fromChoiceString :: (ByteString -> Text) -- ^ Decoder for bytestrings + -> ChoiceString -- ^ String to render + -> Builder -- ^ Resulting builder +fromChoiceString _ (Static s) = B.fromText $ getText s +fromChoiceString _ (String s) = escapeHtmlEntities $ T.pack s +fromChoiceString _ (Text s) = escapeHtmlEntities s +fromChoiceString d (ByteString s) = B.fromText $ d s +fromChoiceString d (PreEscaped x) = case x of + String s -> B.fromText $ T.pack s + Text s -> B.fromText s + s -> fromChoiceString d s +fromChoiceString d (External x) = case x of + -- Check that the sequence " if " if " if " fromChoiceString d s +fromChoiceString d (AppendChoiceString x y) = + fromChoiceString d x `mappend` fromChoiceString d y +fromChoiceString _ EmptyChoiceString = mempty +{-# INLINE fromChoiceString #-} + +-- | Render some 'Html' to a Text 'Builder'. +-- +renderBuilder :: (ByteString -> Text) -- ^ Decoder for bytestrings + -> Html -- ^ HTML to render + -> Builder -- ^ Resulting builder +renderBuilder d = go mempty + where + go :: Builder -> HtmlM b -> Builder + go attrs (Parent open close content) = + B.fromText (getText open) + `mappend` attrs + `mappend` B.singleton '>' + `mappend` go mempty content + `mappend` B.fromText (getText close) + go attrs (Leaf begin end) = + B.fromText (getText begin) + `mappend` attrs + `mappend` B.fromText (getText end) + go attrs (AddAttribute key value h) = + go (B.fromText (getText key) + `mappend` fromChoiceString d value + `mappend` B.singleton '"' + `mappend` attrs) h + go attrs (AddCustomAttribute key value h) = + go (fromChoiceString d key + `mappend` fromChoiceString d value + `mappend` B.singleton '"' + `mappend` attrs) h + go _ (Content content) = fromChoiceString d 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 Text value. If there are any ByteString's in the +-- input HTML, this function will consider them as UTF-8 encoded values and +-- decode them that way. +-- +renderHtml :: Html -- ^ HTML to render + -> L.Text -- ^ Resulting 'L.ByteString' +renderHtml = renderHtmlWith decodeUtf8 +{-# INLINE renderHtml #-} + +-- | Render HTML to a lazy Text value. This function allows you to specify what +-- should happen with ByteString's in the input HTML. You can decode them or +-- drop them, this depends on the application... +-- +renderHtmlWith :: (ByteString -> Text) -- ^ Decoder for ByteString's. + -> Html -- ^ HTML to render + -> L.Text -- Resulting lazy text +renderHtmlWith d = B.toLazyText . renderBuilder d diff --git a/Text/Blaze/Renderer/Utf8.hs b/Text/Blaze/Renderer/Utf8.hs --- a/Text/Blaze/Renderer/Utf8.hs +++ b/Text/Blaze/Renderer/Utf8.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Text.Blaze.Renderer.Utf8 - ( renderHtml + ( renderHtmlBuilder + , renderHtml , renderHtmlToByteStringIO ) where @@ -41,9 +42,9 @@ -- | Render some 'Html' to a 'Builder'. -- -renderBuilder :: Html -- ^ HTML to render - -> Builder -- ^ Resulting builder -renderBuilder = go mempty +renderHtmlBuilder :: Html -- ^ HTML to render + -> Builder -- ^ Resulting builder +renderHtmlBuilder = go mempty where go :: Builder -> HtmlM b -> Builder go attrs (Parent open close content) = @@ -52,7 +53,7 @@ `mappend` B.fromChar '>' `mappend` go mempty content `mappend` B.copyByteString (getUtf8ByteString close) - go attrs (Leaf begin end) = + go attrs (Leaf begin end) = B.copyByteString (getUtf8ByteString begin) `mappend` attrs `mappend` B.copyByteString (getUtf8ByteString end) @@ -70,21 +71,21 @@ go attrs (Append h1 h2) = go attrs h1 `mappend` go attrs h2 go _ Empty = mempty {-# NOINLINE go #-} -{-# INLINE renderBuilder #-} +{-# INLINE renderHtmlBuilder #-} -- | Render HTML to a lazy UTF-8 encoded 'L.ByteString.' -- renderHtml :: Html -- ^ HTML to render -> L.ByteString -- ^ Resulting 'L.ByteString' -renderHtml = B.toLazyByteString . renderBuilder +renderHtml = B.toLazyByteString . renderHtmlBuilder {-# INLINE renderHtml #-} -- | Repeatedly render HTML to a buffer and process this buffer using the given -- IO action. -- -renderHtmlToByteStringIO :: (S.ByteString -> IO ()) +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 +renderHtmlToByteStringIO io = B.toByteStringIO io . renderHtmlBuilder {-# INLINE renderHtmlToByteStringIO #-} diff --git a/blaze-html.cabal b/blaze-html.cabal --- a/blaze-html.cabal +++ b/blaze-html.cabal @@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented. -Version: 0.3.0.2 +Version: 0.3.0.4 -- A short (one-line) description of the package. Synopsis: A blazingly fast HTML combinator library. @@ -71,6 +71,7 @@ Text.Blaze.Renderer.String Text.Blaze.Renderer.Pretty Text.Blaze.Renderer.Utf8 + Text.Blaze.Renderer.Text -- Packages needed in order to build this package. Build-depends: base >= 4 && < 5,