on develop help sign in
fix handling of modifyAttributes
commit200537d1624f8c04a990f5382790697af9257b3e authorLuigy Leon <luigy@outlook.com> dateThu 16 Jun 2016, 17:10 (10 years ago) parent453d427
1 file changed+7−15
src/Reflex/Dom/Builder/Static.hs+7−15
src/Reflex/Dom/Builder/Static.hs+7−15
@@ -7,6 +7,7 @@ import Reflex.Dom.Builder.Class
77import Reflex.Dom.PerformEvent.Base
88import Reflex.Dom.PerformEvent.Class
99import Reflex.Dom.PostBuild.Class
10+import Reflex.Dom.Widget.Basic (applyMap)
1011import Control.Monad.Ref
1112import Control.Monad.Identity
1213import Data.Dependent.Sum (DSum (..))
@@ -103,24 +104,15 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
103104 {-# INLINABLE element #-}
104105 element elementTag cfg child = do
105106 let toAttr (_mns, k) v = encodeUtf8 k <> "=\"" <> (BL.toStrict $ toLazyByteString $ fromHtmlEscapedText v) <> "\""
106− let attrs = B8.intercalate " " $ Map.foldMapWithKey (\k v -> [toAttr k v]) $ cfg ^. initialAttributes
107−
108− let tag' = encodeUtf8 elementTag
109− let open' more = constant ("<" <> tag' <> " " <> attrs <> " ") <> more <> constant ">"
110− let close' = constant $ "</" <> tag' <> ">"
111−
112107 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
113108 StaticDomBuilderT $ do
114109 (result, innerHtml) <- lift $ runStaticDomBuilderT child
115− initial <- lift $ performEvent $ ffor (cfg ^. modifyAttributes) $ ifoldrM (\r@(mAttrNamespace, n) mv acc -> case mAttrNamespace of
116− Nothing -> return $ maybe acc ((" " <>) . toAttr r) mv
117− Just ns -> error $ "modifyAttributes Just " ++ show ns) ""
118−
119− -- attributes that were not available till PostBuild was fired
120− -- TODO use Map and merge with initial attributes?
121− -- also ensure any removed attributes after postbuild are not passed on
122− extraAttrs <- hold "" initial
123− modify (open' extraAttrs <> innerHtml <> close' :)
110+ attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
111+ let attrs1 = ffor (current attrs0) $ mconcat . fmap (\(k, v) -> " " <> toAttr k v) . Map.toList
112+ let tag = encodeUtf8 elementTag
113+ let open = mconcat [constant ("<" <> tag <> " "), attrs1, constant ">"]
114+ let close = constant $ "</" <> tag <> ">" -- TODO handle elements without closing tags
115+ modify $ (:) $ mconcat $ [open, innerHtml, close]
124116 return (Element es (error "Static.element RawElement was used"), result)
125117
126118 {-# INLINABLE placeholder #-}