@@ -36,6 +36,7 @@ import Data.Functor.Misc
3636import qualified Data.Map as Map
3737import Data.Monoid
3838import qualified Data.Set as Set
39+import Data.Text (Text)
3940import Data.Text.Encoding
4041import Data.Tuple
4142import GHC.Generics
@@ -50,10 +51,13 @@ import Reflex.PostBuild.Base
5051import Reflex.Spider
5152import Reflex.TriggerEvent.Class
5253
53−data StaticDomBuilderEnv = StaticDomBuilderEnv { _staticDomBuilderEnv_shouldEscape :: Bool }
54+data StaticDomBuilderEnv t = StaticDomBuilderEnv
55+ { _staticDomBuilderEnv_shouldEscape :: Bool
56+ , _staticDomBuilderEnv_selectValue :: Maybe (Dynamic t Text)
57+ }
5458
5559newtype StaticDomBuilderT t m a = StaticDomBuilderT
56− { unStaticDomBuilderT :: ReaderT StaticDomBuilderEnv (StateT [Behavior t Builder] m) a -- Accumulated Html will be in reversed order
60+ { unStaticDomBuilderT :: ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a -- Accumulated Html will be in reversed order
5761 }
5862 deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
5963
@@ -64,7 +68,7 @@ instance PrimMonad m => PrimMonad (StaticDomBuilderT x m) where
6468instance MonadTrans (StaticDomBuilderT t) where
6569 lift = StaticDomBuilderT . lift . lift
6670
67−runStaticDomBuilderT :: (Monad m, Reflex t) => StaticDomBuilderT t m a -> StaticDomBuilderEnv -> m (a, Behavior t Builder)
71+runStaticDomBuilderT :: (Monad m, Reflex t) => StaticDomBuilderT t m a -> StaticDomBuilderEnv t -> m (a, Behavior t Builder)
6872runStaticDomBuilderT (StaticDomBuilderT a) e = do
6973 (result, a') <- runStateT (runReaderT a e) []
7074 return (result, mconcat $ reverse a')
@@ -181,14 +185,21 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
181185 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
182186 StaticDomBuilderT $ do
183187 let shouldEscape = elementTag `Set.notMember` noEscapeElements
184− (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape
188+ (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing
185189 attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
186− let attrs1 = ffor (current attrs0) $ mconcat . fmap (\(k, v) -> " " <> toAttr k v) . Map.toList
190+ selectValue <- asks _staticDomBuilderEnv_selectValue
191+ let addSelectedAttr attrs sel = case Map.lookup "value" attrs of
192+ Just v | v == sel -> attrs <> Map.singleton "selected" ""
193+ _ -> Map.delete "selected" attrs
194+ let attrs1 = case selectValue of
195+ Nothing -> attrs0
196+ Just sv -> zipDynWith addSelectedAttr attrs0 sv
197+ let attrs2 = ffor (current attrs1) $ mconcat . fmap (\(k, v) -> " " <> toAttr k v) . Map.toList
187198 let tagBS = encodeUtf8 elementTag
188199 if Set.member elementTag voidElements
189− then modify $ (:) $ mconcat [constant ("<" <> byteString tagBS), attrs1, constant (byteString " />")]
200+ then modify $ (:) $ mconcat [constant ("<" <> byteString tagBS), attrs2, constant (byteString " />")]
190201 else do
191− let open = mconcat [constant ("<" <> byteString tagBS), attrs1, constant (byteString ">")]
202+ let open = mconcat [constant ("<" <> byteString tagBS), attrs2, constant (byteString ">")]
192203 let close = constant $ byteString $ "</" <> tagBS <> ">"
193204 modify $ (:) $ mconcat [open, innerHtml, close]
194205 return (Element es (), result)
@@ -222,8 +233,11 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
222233 , _textAreaElement_raw = ()
223234 }
224235 selectElement cfg child = do
225− (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) child
226236 v <- holdDyn (cfg ^. selectElementConfig_initialValue) (cfg ^. selectElementConfig_setValue)
237+ (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) $ do
238+ (a, innerHtml) <- StaticDomBuilderT $ lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False (Just v)
239+ StaticDomBuilderT $ lift $ modify $ (:) innerHtml
240+ return a
227241 let wrapped = SelectElement
228242 { _selectElement_value = v
229243 , _selectElement_change = never
@@ -243,7 +257,7 @@ renderStatic :: StaticWidget x a -> IO (a, ByteString)
243257renderStatic w = do
244258 runSpiderHost $ do
245259 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
246− let env0 = StaticDomBuilderEnv True
260+ let env0 = StaticDomBuilderEnv True Nothing
247261 ((res, bs), FireCommand fire) <- hostPerformEventT $ runStaticDomBuilderT (runPostBuildT w postBuild) env0
248262 mPostBuildTrigger <- readRef postBuildTriggerRef
249263 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()