]>
Commit | Line | Data |
---|---|---|
675085c2 JG |
1 | {-# LANGUAGE DeriveFunctor #-} |
2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | |
3 | {-# LANGUAGE FlexibleInstances #-} | |
4 | {-# LANGUAGE RankNTypes #-} | |
5 | {-# LANGUAGE CPP #-} | |
6 | #if MIN_VERSION_blaze_markup(0,7,1) | |
7 | #define PRE_BUILDER | |
8 | #endif | |
9 | module Text.BlazeT.Internal | |
10 | ( | |
95eb4d6a JG |
11 | -- * Entities exported only by the @blazeT@ version of this module |
12 | MarkupT(..) | |
13 | ,MarkupI | |
14 | ,mapMarkupT | |
15 | -- ** Specializations for @blaze-markup@ backwards compatibility | |
16 | ,MarkupM | |
17 | ,Markup | |
18 | ,Markup2 | |
19 | -- ** Running | |
20 | ,runMarkupT | |
21 | ,runMarkup | |
22 | ,runWith | |
23 | -- ** Executing | |
24 | ,execMarkupT | |
25 | ,execMarkup | |
26 | ,execWith | |
27 | -- ** Wrappers | |
28 | ,wrapMarkupT | |
29 | ,wrapMarkupT2 | |
30 | ,wrapMarkup | |
31 | ,wrapMarkup2 | |
32 | , | |
33 | ||
34 | -- * Entities exported also by "Text.Blaze.Internal" | |
35 | -- $descr1 | |
36 | ||
37 | -- ** Important types. | |
38 | Text.Blaze.ChoiceString (..) | |
39 | , Text.Blaze.StaticString (..) | |
40 | -- , MarkupM | |
41 | -- , Markup | |
42 | , Text.Blaze.Tag | |
43 | , Text.Blaze.Attribute | |
44 | , Text.Blaze.AttributeValue | |
45 | ||
46 | -- ** Creating custom tags and attributes. | |
675085c2 JG |
47 | , customParent |
48 | , customLeaf | |
95eb4d6a JG |
49 | , Text.Blaze.attribute |
50 | , Text.Blaze.dataAttribute | |
51 | , Text.Blaze.customAttribute | |
675085c2 | 52 | |
95eb4d6a | 53 | -- ** Converting values to Markup. |
675085c2 JG |
54 | , text |
55 | , preEscapedText | |
56 | , lazyText | |
57 | , preEscapedLazyText | |
58 | , textBuilder | |
59 | , preEscapedTextBuilder | |
60 | , string | |
61 | , preEscapedString | |
62 | , unsafeByteString | |
63 | , unsafeLazyByteString | |
64 | ||
95eb4d6a | 65 | -- ** Comments |
4dc7c9b2 JG |
66 | , textComment |
67 | , lazyTextComment | |
68 | , stringComment | |
69 | , unsafeByteStringComment | |
70 | , unsafeLazyByteStringComment | |
95eb4d6a JG |
71 | |
72 | -- ** Converting values to tags. | |
73 | , Text.Blaze.textTag | |
74 | , Text.Blaze.stringTag | |
75 | ||
76 | -- ** Converting values to attribute values. | |
77 | , Text.Blaze.textValue | |
78 | , Text.Blaze.preEscapedTextValue | |
79 | , Text.Blaze.lazyTextValue | |
80 | , Text.Blaze.preEscapedLazyTextValue | |
81 | , Text.Blaze.textBuilderValue | |
82 | , Text.Blaze.preEscapedTextBuilderValue | |
83 | , Text.Blaze.stringValue | |
84 | , Text.Blaze.preEscapedStringValue | |
85 | , Text.Blaze.unsafeByteStringValue | |
86 | , Text.Blaze.unsafeLazyByteStringValue | |
87 | ||
88 | -- ** Setting attributes | |
89 | , Text.Blaze.Attributable | |
90 | , (Text.Blaze.!) | |
91 | , (Text.Blaze.!?) | |
92 | ||
93 | -- ** Modifying Markup elements | |
675085c2 JG |
94 | , contents |
95 | , external | |
96 | ||
95eb4d6a | 97 | -- ** Querying Markup elements |
675085c2 JG |
98 | , null |
99 | ||
675085c2 JG |
100 | ) where |
101 | ||
95eb4d6a | 102 | import Control.Arrow |
675085c2 JG |
103 | import Control.Monad.Identity |
104 | import Control.Monad.Trans.Class | |
105 | import Control.Monad.Writer.Strict | |
106 | import qualified Data.ByteString as BS | |
107 | import qualified Data.ByteString.Lazy as BL | |
108 | import Data.String | |
109 | import qualified Data.Text as T | |
110 | import qualified Data.Text.Lazy as LT | |
111 | import qualified Data.Text.Lazy.Builder as LTB | |
95eb4d6a JG |
112 | import qualified Text.Blaze |
113 | import qualified Text.Blaze.Internal as Text.Blaze | |
114 | ||
115 | {- | Everything is build around the simple @newtype@ definition of the | |
116 | 'MarkupT' transformer, which makes use the 'Monoid' instance of Blaze | |
bd93b7c0 | 117 | 'Text.Blaze.Markup' and is simply a 'WriterT' writing Blaze |
95eb4d6a JG |
118 | 'Text.Blaze.Markup': |
119 | -} | |
120 | newtype MarkupT m a= MarkupT { fromMarkupT :: WriterT Text.Blaze.Markup m a } | |
675085c2 JG |
121 | deriving (Functor |
122 | #if MIN_VERSION_base(4,8,0) | |
123 | ,Applicative | |
124 | #endif | |
125 | ,Monad | |
95eb4d6a | 126 | ,MonadWriter Text.Blaze.Markup |
675085c2 JG |
127 | ,MonadTrans |
128 | ) | |
129 | ||
95eb4d6a JG |
130 | type MarkupI a = MarkupT Identity a |
131 | ||
675085c2 JG |
132 | -- | Map both the return value and markup of a computation using the |
133 | -- given function | |
95eb4d6a | 134 | mapMarkupT :: (m (a,Text.Blaze.Markup) -> n (b,Text.Blaze.Markup)) -> MarkupT m a -> MarkupT n b |
675085c2 JG |
135 | mapMarkupT f = MarkupT . mapWriterT f . fromMarkupT |
136 | {-# INLINE mapMarkupT #-} | |
137 | ||
95eb4d6a JG |
138 | type MarkupM a = forall m . Monad m => MarkupT m a |
139 | type Markup = MarkupM () | |
675085c2 JG |
140 | type Markup2 = forall m . Monad m => MarkupT m () -> MarkupT m () |
141 | ||
95eb4d6a | 142 | runMarkupT :: MarkupT m a -> m (a,Text.Blaze.Markup) |
675085c2 JG |
143 | runMarkupT = runWriterT . fromMarkupT |
144 | {-# INLINE runMarkupT #-} | |
145 | ||
95eb4d6a JG |
146 | -- | run the MarkupT and return a pair consisting of the result of the |
147 | -- computation and the blaze markup rendered with a blaze renderer | |
148 | -- like 'Text.BlazeT.Renderer.Text.renderHtml' | |
cdfc5a07 JG |
149 | runWith :: Monad m => (MarkupI () -> c) -> MarkupT m a -> m (a, c) |
150 | runWith renderer = liftM (second $ renderer . wrapMarkup) . runMarkupT | |
95eb4d6a JG |
151 | {-# INLINE runWith #-} |
152 | ||
153 | execMarkupT :: Monad m => MarkupT m a -> m Text.Blaze.Markup | |
675085c2 JG |
154 | execMarkupT = liftM snd . runMarkupT |
155 | {-# INLINE execMarkupT #-} | |
156 | ||
cdfc5a07 | 157 | execWith :: Monad m => (MarkupI () -> c) -> MarkupT m a -> m c |
95eb4d6a JG |
158 | execWith renderer = liftM snd . runWith renderer |
159 | {-# INLINE execWith #-} | |
160 | ||
161 | runMarkup :: MarkupI a -> (a, Text.Blaze.Markup) | |
675085c2 JG |
162 | runMarkup = runIdentity . runMarkupT |
163 | {-# INLINE runMarkup #-} | |
164 | ||
95eb4d6a | 165 | execMarkup :: MarkupI a -> Text.Blaze.Markup |
675085c2 JG |
166 | execMarkup = snd . runMarkup |
167 | {-# INLINE execMarkup #-} | |
168 | ||
95eb4d6a JG |
169 | -- | Wrapper for 'Text.Blaze.Markup' is simply |
170 | -- 'tell' | |
171 | wrapMarkupT :: Monad m => Text.Blaze.Markup -> MarkupT m () | |
675085c2 JG |
172 | wrapMarkupT = tell |
173 | {-# INLINE wrapMarkupT #-} | |
174 | ||
95eb4d6a | 175 | wrapMarkup :: Text.Blaze.Markup -> Markup |
675085c2 JG |
176 | wrapMarkup = wrapMarkupT |
177 | {-# INLINE wrapMarkup #-} | |
178 | ||
95eb4d6a JG |
179 | |
180 | -- | Wrapper for functions that modify 'Text.Blaze.Markup' is simply | |
181 | -- 'censor' | |
182 | wrapMarkupT2 :: Monad m => (Text.Blaze.Markup -> Text.Blaze.Markup) | |
675085c2 JG |
183 | -> MarkupT m a -> MarkupT m a |
184 | wrapMarkupT2 = censor | |
185 | {-# INLINE wrapMarkupT2 #-} | |
186 | ||
95eb4d6a | 187 | wrapMarkup2 :: (Text.Blaze.Markup -> Text.Blaze.Markup) -> Markup2 |
675085c2 JG |
188 | wrapMarkup2 = wrapMarkupT2 |
189 | {-# INLINE wrapMarkup2 #-} | |
190 | ||
cdfc5a07 JG |
191 | |
192 | instance (Monad m,Monoid a) => Monoid (MarkupT m a) where | |
193 | mempty = return mempty | |
194 | {-# INLINE mempty #-} | |
195 | a `mappend` b = do {a' <- a; b >>= return . (mappend a')} | |
196 | {-# INLINE mappend #-} | |
197 | ||
198 | ||
199 | instance Monad m => Text.Blaze.Attributable (MarkupT m a) where | |
200 | h ! a = wrapMarkupT2 (Text.Blaze.! a) h | |
201 | {-# INLINE (!) #-} | |
202 | ||
203 | instance Monad m => Text.Blaze.Attributable (a -> MarkupT m b) where | |
204 | h ! a = \x -> wrapMarkupT2 (Text.Blaze.! a) $ h x | |
205 | {-# INLINE (!) #-} | |
206 | ||
207 | instance Monad m => IsString (MarkupT m ()) where | |
208 | fromString = wrapMarkup . fromString | |
209 | {-# INLINE fromString #-} | |
210 | ||
675085c2 | 211 | unsafeByteString :: BS.ByteString -> Markup |
95eb4d6a | 212 | unsafeByteString = wrapMarkup . Text.Blaze.unsafeByteString |
675085c2 JG |
213 | {-# INLINE unsafeByteString #-} |
214 | ||
215 | -- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this | |
216 | -- is an unsafe operation. | |
217 | -- | |
218 | unsafeLazyByteString :: BL.ByteString -- ^ Value to insert | |
219 | -> Markup -- ^ Resulting HTML fragment | |
95eb4d6a | 220 | unsafeLazyByteString = wrapMarkup . Text.Blaze.unsafeLazyByteString |
675085c2 JG |
221 | {-# INLINE unsafeLazyByteString #-} |
222 | ||
223 | external :: Monad m => MarkupT m a -> MarkupT m a | |
95eb4d6a | 224 | external = wrapMarkupT2 Text.Blaze.external |
675085c2 JG |
225 | {-# INLINE external #-} |
226 | ||
227 | contents :: Monad m => MarkupT m a -> MarkupT m a | |
95eb4d6a | 228 | contents = wrapMarkupT2 Text.Blaze.contents |
675085c2 JG |
229 | {-# INLINE contents #-} |
230 | ||
95eb4d6a JG |
231 | customParent ::Text.Blaze.Tag -> Markup2 |
232 | customParent = wrapMarkup2 . Text.Blaze.customParent | |
675085c2 JG |
233 | {-# INLINE customParent #-} |
234 | ||
95eb4d6a JG |
235 | customLeaf :: Text.Blaze.Tag -> Bool -> Markup |
236 | customLeaf = fmap wrapMarkup . Text.Blaze.customLeaf | |
675085c2 JG |
237 | {-# INLINE customLeaf #-} |
238 | ||
239 | preEscapedText :: T.Text -> Markup | |
95eb4d6a | 240 | preEscapedText = wrapMarkup . Text.Blaze.preEscapedText |
675085c2 JG |
241 | {-# INLINE preEscapedText #-} |
242 | ||
243 | preEscapedLazyText :: LT.Text -> Markup | |
95eb4d6a | 244 | preEscapedLazyText = wrapMarkup . Text.Blaze.preEscapedLazyText |
675085c2 JG |
245 | {-# INLINE preEscapedLazyText #-} |
246 | ||
247 | preEscapedTextBuilder :: LTB.Builder -> Markup | |
248 | textBuilder :: LTB.Builder -> Markup | |
249 | ||
250 | #ifdef PRE_BUILDER | |
95eb4d6a JG |
251 | preEscapedTextBuilder = wrapMarkup . Text.Blaze.preEscapedTextBuilder |
252 | textBuilder = wrapMarkup . Text.Blaze.textBuilder | |
675085c2 JG |
253 | {-# INLINE preEscapedTextBuilder #-} |
254 | {-# INLINE textBuilder #-} | |
255 | #else | |
256 | preEscapedTextBuilder = error "This function needs blaze-markup 0.7.1.0" | |
257 | textBuilder = error "This function needs blaze-markup 0.7.1.0" | |
258 | #endif | |
259 | ||
260 | preEscapedString :: String -> Markup | |
95eb4d6a | 261 | preEscapedString = wrapMarkup . Text.Blaze.preEscapedString |
675085c2 JG |
262 | {-# INLINE preEscapedString #-} |
263 | ||
264 | string :: String -> Markup | |
95eb4d6a | 265 | string = wrapMarkup . Text.Blaze.string |
675085c2 JG |
266 | {-# INLINE string #-} |
267 | ||
268 | text :: T.Text -> Markup | |
95eb4d6a | 269 | text = wrapMarkup . Text.Blaze.text |
675085c2 JG |
270 | {-# INLINE text #-} |
271 | ||
272 | lazyText :: LT.Text -> Markup | |
95eb4d6a | 273 | lazyText = wrapMarkup . Text.Blaze.lazyText |
675085c2 | 274 | {-# INLINE lazyText #-} |
95eb4d6a | 275 | |
4dc7c9b2 JG |
276 | |
277 | textComment :: T.Text -> Markup | |
278 | textComment = wrapMarkup . Text.Blaze.textComment | |
279 | ||
280 | lazyTextComment :: LT.Text -> Markup | |
281 | lazyTextComment = wrapMarkup . Text.Blaze.lazyTextComment | |
282 | ||
283 | stringComment :: String -> Markup | |
284 | stringComment = wrapMarkup . Text.Blaze.stringComment | |
285 | ||
286 | unsafeByteStringComment :: BS.ByteString -> Markup | |
287 | unsafeByteStringComment = wrapMarkup . Text.Blaze.unsafeByteStringComment | |
288 | ||
289 | unsafeLazyByteStringComment :: BL.ByteString -> Markup | |
290 | unsafeLazyByteStringComment = wrapMarkup . Text.Blaze.unsafeLazyByteStringComment | |
291 | ||
95eb4d6a JG |
292 | -- $descr1 |
293 | -- The following is an adaptation of all "Text.Blaze.Internal" exports to | |
294 | -- @blazeT@ types. | |
295 | -- | |
296 | -- Entities that are reexported from "Text.Blaze.Internal" have the original | |
297 | -- documentation attached to them. | |
298 | -- | |
299 | -- Entities that had to be adapted are tagged with \"(Adapted)\". For | |
300 | -- their documentation consult the "Text.Blaze.Internal" documentation. |