@@ -55,7 +55,6 @@ import Reflex.PerformEvent.Class
5555import Reflex.PostBuild.Base
5656import Reflex.PostBuild.Class
5757import Reflex.TriggerEvent.Class
58−import System.Random (randomRIO)
5958
6059data StaticDomBuilderEnv t = StaticDomBuilderEnv
6160 { _staticDomBuilderEnv_shouldEscape :: Bool
@@ -64,6 +63,7 @@ data StaticDomBuilderEnv t = StaticDomBuilderEnv
6463 -- We use this to add a "selected" attribute to the appropriate "option" child element.
6564 -- This is not yet a perfect simulation of what the browser does, but it is much closer than doing nothing.
6665 -- TODO: Handle edge cases, e.g. setting to a value for which there is no option, then adding that option dynamically afterwards.
66+ , _staticDomBuilderEnv_nextRunWithReplaceKey :: IORef Int
6767 }
6868
6969newtype StaticDomBuilderT t m a = StaticDomBuilderT
@@ -164,7 +164,7 @@ instance (SupportsStaticDomBuilder t m, Monad m) => HasDocument (StaticDomBuilde
164164instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m) => Adjustable t (StaticDomBuilderT t m) where
165165 runWithReplace a0 a' = do
166166 e <- StaticDomBuilderT ask
167− key <- replaceStart
167+ key <- replaceStart e
168168 (result0, result') <- lift $ runWithReplace (runStaticDomBuilderT a0 e) (flip runStaticDomBuilderT e <$> a')
169169 o <- hold (snd result0) $ fmapCheap snd result'
170170 StaticDomBuilderT $ modify $ (:) $ join o
@@ -174,10 +174,9 @@ instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m)
174174 traverseDMapWithKeyWithAdjust = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap
175175 traverseDMapWithKeyWithAdjustWithMove = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove
176176
177−-- TODO remove this?
178−replaceStart :: (DomBuilder t m, MonadIO m) => m Text
179−replaceStart = do
180− str <- liftIO $ replicateM 8 $ randomRIO ('a', 'z')
177+replaceStart :: (DomBuilder t m, MonadIO m) => StaticDomBuilderEnv t -> m Text
178+replaceStart env = do
179+ str <- show <$> liftIO (atomicModifyRef (_staticDomBuilderEnv_nextRunWithReplaceKey env) $ \k -> (succ k, k))
181180 let key = "-" <> T.pack str
182181 _ <- commentNode $ def { _commentNodeConfig_initialContents = "replace-start" <> key }
183182 pure key
@@ -287,7 +286,8 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
287286 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
288287 StaticDomBuilderT $ do
289288 let shouldEscape = elementTag `Set.notMember` noEscapeElements
290− (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing
289+ nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
290+ (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing nextRunWithReplaceKey
291291 attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
292292 selectValue <- asks _staticDomBuilderEnv_selectValue
293293 let addSelectedAttr attrs sel = case Map.lookup "value" attrs of
@@ -341,7 +341,9 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
341341 selectElement cfg child = do
342342 v <- holdDyn (cfg ^. selectElementConfig_initialValue) (cfg ^. selectElementConfig_setValue)
343343 (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) $ do
344− (a, innerHtml) <- StaticDomBuilderT $ lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False $ Just (current v)
344+ (a, innerHtml) <- StaticDomBuilderT $ do
345+ nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
346+ lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False (Just $ current v) nextRunWithReplaceKey
345347 StaticDomBuilderT $ lift $ modify $ (:) innerHtml
346348 return a
347349 let wrapped = SelectElement
@@ -363,7 +365,8 @@ renderStatic :: StaticWidget x a -> IO (a, ByteString)
363365renderStatic w = do
364366 runDomHost $ do
365367 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
366− let env0 = StaticDomBuilderEnv True Nothing
368+ nextRunWithReplaceKey <- newRef 0
369+ let env0 = StaticDomBuilderEnv True Nothing nextRunWithReplaceKey
367370 ((res, bs), FireCommand fire) <- hostPerformEventT $ runStaticDomBuilderT (runPostBuildT w postBuild) env0
368371 mPostBuildTrigger <- readRef postBuildTriggerRef
369372 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()