@@ -13,7 +13,6 @@ import Data.Dependent.Sum (DSum (..))
14import Data.Monoid
14import Data.Monoid
15import Data.Text (Text)
15import Data.Text (Text)
16−-- import Foreign.JavaScript.TH
17import qualified Data.Map as Map
16import qualified Data.Map as Map
18import Data.Map (Map)
17import Data.Map (Map)
19import Control.Lens hiding (element)
18import Control.Lens hiding (element)
@@ -98,34 +97,28 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
98 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
97 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
99 {-# INLINABLE textNode #-}
98 {-# INLINABLE textNode #-}
100 textNode (TextNodeConfig contents) = StaticDomBuilderT $ do
99 textNode (TextNodeConfig contents) = StaticDomBuilderT $ do
101− modify . (:) $ constant $ BL.toStrict $ toLazyByteString $ fromHtmlEscapedText contents
100+ modify $ (:) $ constant $ BL.toStrict $ toLazyByteString $ fromHtmlEscapedText contents
102 return TextNode
101 return TextNode
104 {-# INLINABLE element #-}
103 {-# INLINABLE element #-}
105 element elementTag cfg child = do
104 element elementTag cfg child = do
106− let toAttr (_mns,k) v = let key = encodeUtf8 k; val = BL.toStrict $ toLazyByteString $ fromHtmlEscapedText v in [key <> "=\"" <> val <> "\""]
105+ let toAttr (_mns, k) v = encodeUtf8 k <> "=\"" <> (BL.toStrict $ toLazyByteString $ fromHtmlEscapedText v) <> "\""
107− let attrs0 = Map.foldMapWithKey toAttr $ cfg ^. initialAttributes
106+ let attrs = B8.intercalate " " $ Map.foldMapWithKey (\k v -> [toAttr k v]) $ cfg ^. initialAttributes
108− let attrs1 = if null attrs0 then "" else " " <> B8.intercalate " " attrs0
110 let tag' = encodeUtf8 elementTag
108 let tag' = encodeUtf8 elementTag
111− let open' more = constant ("<" <> tag' <> attrs1 <> " ") <> more <> constant ">"
109+ let open' more = constant ("<" <> tag' <> " " <> attrs <> " ") <> more <> constant ">"
112 let close' = constant $ "</" <> tag' <> ">"
110 let close' = constant $ "</" <> tag' <> ">"
114 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
112 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
115 StaticDomBuilderT $ do
113 StaticDomBuilderT $ do
116 (result, innerHtml) <- lift $ runStaticDomBuilderT child
114 (result, innerHtml) <- lift $ runStaticDomBuilderT child
117 initial <- lift $ performEvent $ ffor (cfg ^. modifyAttributes) $ ifoldrM (\r@(mAttrNamespace, n) mv acc -> case mAttrNamespace of
115 initial <- lift $ performEvent $ ffor (cfg ^. modifyAttributes) $ ifoldrM (\r@(mAttrNamespace, n) mv acc -> case mAttrNamespace of
118− Nothing -> do
116+ Nothing -> return $ maybe acc ((" " <>) . toAttr r) mv
121− let [attr'] = toAttr r v
122− return $ " " <> attr'
123− Nothing -> return acc
125− error $ "modifyAttributes Just " ++ show ns) ""
117+ Just ns -> error $ "modifyAttributes Just " ++ show ns) ""
127 -- attributes that were not available till PostBuild was fired
119 -- attributes that were not available till PostBuild was fired
128− -- TODO use map and merge with initial attributes?
120+ -- TODO use Map and merge with initial attributes?
121+ -- also ensure any removed attributes after postbuild are not passed on
129 extraAttrs <- hold "" initial
122 extraAttrs <- hold "" initial
130 modify (open' extraAttrs <> innerHtml <> close' :)
123 modify (open' extraAttrs <> innerHtml <> close' :)
131 return (Element es (error "Static.element RawElement was used"), result)
124 return (Element es (error "Static.element RawElement was used"), result)
@@ -134,7 +127,7 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
134 placeholder (PlaceholderConfig toInsertAbove _delete) = StaticDomBuilderT $ do
127 placeholder (PlaceholderConfig toInsertAbove _delete) = StaticDomBuilderT $ do
135 result <- lift $ performEvent (fmap runStaticDomBuilderT toInsertAbove)
128 result <- lift $ performEvent (fmap runStaticDomBuilderT toInsertAbove)
136 acc <- foldDyn (:) [] (fmap snd result)
129 acc <- foldDyn (:) [] (fmap snd result)
137− modify . (:) $ join $ fmap (mconcat . reverse) $ current acc
130+ modify $ (:) $ join $ fmap (mconcat . reverse) $ current acc
138 return $ Placeholder (fmap fst result) never
131 return $ Placeholder (fmap fst result) never
140 {-# INLINABLE inputElement #-}
133 {-# INLINABLE inputElement #-}
@@ -142,17 +135,15 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
142 (e, _result) <- element "input" (cfg ^. inputElementConfig_elementConfig) $ return ()
135 (e, _result) <- element "input" (cfg ^. inputElementConfig_elementConfig) $ return ()
143 let v0 = constDyn $ cfg ^. inputElementConfig_initialValue
136 let v0 = constDyn $ cfg ^. inputElementConfig_initialValue
144 let c0 = constDyn $ cfg ^. inputElementConfig_initialChecked
137 let c0 = constDyn $ cfg ^. inputElementConfig_initialChecked
145− let valueChangedByUI = never
146− let hasFocus = constDyn False -- XXX should this coming from initialAtttributes
138+ let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes
147− return $ InputElement v0 c0 valueChangedByUI hasFocus e
139+ return $ InputElement v0 c0 never hasFocus e
149 {-# INLINABLE textAreaElement #-}
141 {-# INLINABLE textAreaElement #-}
150 textAreaElement cfg = do
142 textAreaElement cfg = do
151 (e, _domElement) <- element "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
143 (e, _domElement) <- element "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
152 let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue
144 let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue
153− let valueChangedByUI = never
154− let hasFocus = constDyn False -- XXX should this be coming from initialAtttributes
145+ let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes
155− return $ TextAreaElement v0 valueChangedByUI hasFocus e
146+ return $ TextAreaElement v0 never hasFocus e
157--TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better
148--TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better
158type StaticWidget x = PostBuildT Spider (StaticDomBuilderT Spider (PerformEventT Spider (SpiderHost Global)))
149type StaticWidget x = PostBuildT Spider (StaticDomBuilderT Spider (PerformEventT Spider (SpiderHost Global)))