on develop help sign in
fix handling of modifyAttributes
200537dLuigy Leon
src/Reflex/Dom/Builder/Static.hs+7−15
@@ -7,6 +7,7 @@ import Reflex.Dom.Builder.Class
7import Reflex.Dom.PerformEvent.Base
7import Reflex.Dom.PerformEvent.Base
8import Reflex.Dom.PerformEvent.Class
8import Reflex.Dom.PerformEvent.Class
9import Reflex.Dom.PostBuild.Class
9import Reflex.Dom.PostBuild.Class
10+import Reflex.Dom.Widget.Basic (applyMap)
10import Control.Monad.Ref
11import Control.Monad.Ref
11import Control.Monad.Identity
12import Control.Monad.Identity
12import Data.Dependent.Sum (DSum (..))
13import Data.Dependent.Sum (DSum (..))
@@ -103,24 +104,15 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
103 {-# INLINABLE element #-}
104 {-# INLINABLE element #-}
104 element elementTag cfg child = do
105 element elementTag cfg child = do
105 let toAttr (_mns, k) v = encodeUtf8 k <> "=\"" <> (BL.toStrict $ toLazyByteString $ fromHtmlEscapedText v) <> "\""
106 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−
112 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
107 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
113 StaticDomBuilderT $ do
108 StaticDomBuilderT $ do
114 (result, innerHtml) <- lift $ runStaticDomBuilderT child
109 (result, innerHtml) <- lift $ runStaticDomBuilderT child
115− initial <- lift $ performEvent $ ffor (cfg ^. modifyAttributes) $ ifoldrM (\r@(mAttrNamespace, n) mv acc -> case mAttrNamespace of
110+ attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
116− Nothing -> return $ maybe acc ((" " <>) . toAttr r) mv
111+ let attrs1 = ffor (current attrs0) $ mconcat . fmap (\(k, v) -> " " <> toAttr k v) . Map.toList
117− Just ns -> error $ "modifyAttributes Just " ++ show ns) ""
112+ let tag = encodeUtf8 elementTag
118−
113+ let open = mconcat [constant ("<" <> tag <> " "), attrs1, constant ">"]
119− -- attributes that were not available till PostBuild was fired
114+ let close = constant $ "</" <> tag <> ">" -- TODO handle elements without closing tags
120− -- TODO use Map and merge with initial attributes?
115+ modify $ (:) $ mconcat $ [open, innerHtml, close]
121− -- also ensure any removed attributes after postbuild are not passed on
122− extraAttrs <- hold "" initial
123− modify (open' extraAttrs <> innerHtml <> close' :)
124 return (Element es (error "Static.element RawElement was used"), result)
116 return (Element es (error "Static.element RawElement was used"), result)
125
117
126 {-# INLINABLE placeholder #-}
118 {-# INLINABLE placeholder #-}