@@ -25,9 +25,8 @@ import Control.Monad.Ref
2525import Control.Monad.State.Strict
2626import Control.Monad.Trans.Control
2727import Data.ByteString (ByteString)
28−import qualified Data.ByteString as BS
29−import Data.ByteString.Builder (toLazyByteString)
30−import qualified Data.ByteString.Lazy as BL
28+import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
29+import qualified Data.ByteString.Lazy as LBS
3130import Data.Default
3231import Data.Dependent.Map (DMap)
3332import qualified Data.Dependent.Map as DMap
@@ -50,9 +49,8 @@ import Reflex.PerformEvent.Class
5049import Reflex.PostBuild.Class
5150import Reflex.Spider
5251
53−
5452newtype StaticDomBuilderT t m a = StaticDomBuilderT
55− { unStaticDomBuilderT :: StateT [Behavior t ByteString] m a -- Accumulated Html will be in reversed order
53+ { unStaticDomBuilderT :: StateT [Behavior t Builder] m a -- Accumulated Html will be in reversed order
5654 }
5755 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
5856
@@ -61,14 +59,14 @@ instance PrimMonad m => PrimMonad (StaticDomBuilderT x m) where
6159 primitive = lift . primitive
6260
6361instance MonadTransControl (StaticDomBuilderT t) where
64− type StT (StaticDomBuilderT t) a = StT (StateT [Behavior t ByteString]) a
62+ type StT (StaticDomBuilderT t) a = StT (StateT [Behavior t Builder]) a
6563 liftWith = defaultLiftWith StaticDomBuilderT unStaticDomBuilderT
6664 restoreT = defaultRestoreT StaticDomBuilderT
6765
6866instance MonadTrans (StaticDomBuilderT t) where
6967 lift = StaticDomBuilderT . lift
7068
71−runStaticDomBuilderT :: (Monad m, Reflex t) => StaticDomBuilderT t m a -> m (a, Behavior t ByteString)
69+runStaticDomBuilderT :: (Monad m, Reflex t) => StaticDomBuilderT t m a -> m (a, Behavior t Builder)
7270runStaticDomBuilderT (StaticDomBuilderT a) = do
7371 (result, a') <- runStateT a []
7472 return (result, mconcat $ reverse a')
@@ -148,15 +146,15 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB
148146 let result0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (_, v)) -> k :=> Identity v) children0
149147 result' = ffor children' $ \(PatchDMap p) -> PatchDMap $
150148 mapKeyValuePairsMonotonic (\(WrapArg k :=> mv) -> k :=> fmap snd mv) p
151− outputs0 :: DMap k (Constant (Behavior t ByteString))
149+ outputs0 :: DMap k (Constant (Behavior t Builder))
152150 outputs0 = mapKeyValuePairsMonotonic (\(WrapArg k :=> Identity (o, _)) -> k :=> Constant o) children0
153− outputs' :: Event t (PatchDMap k (Constant (Behavior t ByteString)))
151+ outputs' :: Event t (PatchDMap k (Constant (Behavior t Builder)))
154152 outputs' = ffor children' $ \(PatchDMap p) -> PatchDMap $
155153 mapKeyValuePairsMonotonic (\(WrapArg k :=> ComposeMaybe mv) -> k :=> ComposeMaybe (fmap (Constant . fst . runIdentity) mv)) p
156154 outputs <- holdIncremental outputs0 outputs'
157155 StaticDomBuilderT $ modify $ (:) $ pull $ do
158156 os <- sample $ currentIncremental outputs
159− fmap BS.concat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do
157+ fmap mconcat $ forM (DMap.toList os) $ \(_ :=> Constant o) -> do
160158 sample o
161159 return (result0, result')
162160
@@ -165,14 +163,14 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
165163 {-# INLINABLE textNode #-}
166164 textNode (TextNodeConfig initialContents setContents) = StaticDomBuilderT $ do
167165 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
168− let escape = BL.toStrict . toLazyByteString . fromHtmlEscapedText
166+ let escape = fromHtmlEscapedText
169167 modify . (:) <=< hold (escape initialContents) $ fmap escape setContents
170168 return $ TextNode ()
171169 {-# INLINABLE element #-}
172170 element elementTag cfg child = do
173171 -- https://www.w3.org/TR/html-markup/syntax.html#syntax-elements
174172 let voidElements = Set.fromList ["area", "base", "br", "col", "command", "embed", "hr", "img", "input", "keygen", "link", "meta", "param", "source", "track", "wbr"]
175− let toAttr (AttributeName _mns k) v = encodeUtf8 k <> "=\"" <> BL.toStrict (toLazyByteString $ fromHtmlEscapedText v) <> "\""
173+ let toAttr (AttributeName _mns k) v = byteString (encodeUtf8 k) <> byteString "=\"" <> fromHtmlEscapedText v <> byteString "\""
176174 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
177175 StaticDomBuilderT $ do
178176 (result, innerHtml) <- lift $ runStaticDomBuilderT child
@@ -180,10 +178,10 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
180178 let attrs1 = ffor (current attrs0) $ mconcat . fmap (\(k, v) -> " " <> toAttr k v) . Map.toList
181179 let tagBS = encodeUtf8 elementTag
182180 if Set.member elementTag voidElements
183− then modify $ (:) $ mconcat [constant ("<" <> tagBS), attrs1, constant " />"]
181+ then modify $ (:) $ mconcat [constant ("<" <> byteString tagBS), attrs1, constant (byteString " />")]
184182 else do
185− let open = mconcat [constant ("<" <> tagBS <> " "), attrs1, constant ">"]
186− let close = constant $ "</" <> tagBS <> ">"
183+ let open = mconcat [constant ("<" <> byteString tagBS <> " "), attrs1, constant (byteString ">")]
184+ let close = constant $ byteString $ "</" <> tagBS <> ">"
187185 modify $ (:) $ mconcat [open, innerHtml, close]
188186 return (Element es (), result)
189187 {-# INLINABLE inputElement #-}
@@ -232,6 +230,7 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
232230--TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better
233231type StaticWidget x = PostBuildT Spider (StaticDomBuilderT Spider (PerformEventT Spider (SpiderHost Global)))
234232
233+{-# INLINE renderStatic #-}
235234renderStatic :: StaticWidget x a -> IO (a, ByteString)
236235renderStatic w = do
237236 runSpiderHost $ do
@@ -240,4 +239,4 @@ renderStatic w = do
240239 mPostBuildTrigger <- readRef postBuildTriggerRef
241240 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()
242241 bs' <- sample bs
243− return (res, bs')
242+ return (res, LBS.toStrict $ toLazyByteString bs')