-
Notifications
You must be signed in to change notification settings - Fork 47
/
Utf8.hs
89 lines (82 loc) · 3.42 KB
/
Utf8.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
{-# 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 Text.Blaze.Builder.Core (Builder)
import qualified Text.Blaze.Builder 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 "</" is *not* in the external data.
String s -> if "</" `isInfixOf` s then mempty else B.fromString s
Text s -> if "</" `T.isInfixOf` s then mempty else B.fromText s
ByteString s -> if "</" `S.isInfixOf` s then mempty else B.fromByteString s
s -> 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 :: Html -- ^ HTML to render
-> (S.ByteString -> IO ())
-- ^ IO action to execute per rendered buffer
-> IO () -- ^ Resulting IO action
renderHtmlToByteStringIO = B.toByteStringIO . renderBuilder
{-# INLINE renderHtmlToByteStringIO #-}