on develop help sign in
Remove HydrationDomSpace, use GhcjsDomSpace
commitc9b1c0d38d7f066496adfe294cef8092bce7d9d3 authorTom Smalley <tfsmalley@gmail.com> dateTue 27 Nov 2018, 13:58 (8 years ago) parent5dec470
1 file changed+16−40
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+16−40
reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+16−40
@@ -37,6 +37,7 @@ module Reflex.Dom.Builder.Hydration
3737 , HydrationMode (..)
3838 , HydrationRunnerT (..)
3939 , runHydrationRunnerT
40+ , localEnv
4041 , addHydrationStepWithSetup
4142 , addHydrationStep
4243 , hydrateNode
@@ -159,32 +160,6 @@ instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
159160 liftJSM' = lift . liftJSM'
160161#endif
161162
162−data HydrationDomSpace
163−
164−instance DomSpace HydrationDomSpace where
165− type EventSpec HydrationDomSpace = GhcjsEventSpec
166− type RawDocument HydrationDomSpace = DOM.Document
167− type RawTextNode HydrationDomSpace = ()
168− type RawCommentNode HydrationDomSpace = ()
169− type RawElement HydrationDomSpace = ()
170− type RawFile HydrationDomSpace = DOM.File
171− type RawInputElement HydrationDomSpace = ()
172− type RawTextAreaElement HydrationDomSpace = ()
173− type RawSelectElement HydrationDomSpace = ()
174− addEventSpecFlags _ en f es = es
175− { _ghcjsEventSpec_filters =
176− let f' = Just . GhcjsEventFilter . \case
177− Nothing -> \evt -> do
178− mEventResult <- unGhcjsEventHandler (_ghcjsEventSpec_handler es) (en, evt)
179− return (f mEventResult, return mEventResult)
180− Just (GhcjsEventFilter oldFilter) -> \evt -> do
181− (oldFlags, oldContinuation) <- oldFilter evt
182− mEventResult <- oldContinuation
183− let newFlags = oldFlags <> f mEventResult
184− return (newFlags, return mEventResult)
185− in DMap.alter f' en $ _ghcjsEventSpec_filters es
186− }
187−
188163data HydrationDomBuilderEnv t = HydrationDomBuilderEnv
189164 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
190165 -- ^ Reference to the document
@@ -426,7 +401,7 @@ wrap
426401 :: forall m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)
427402 => Chan [DSum (EventTriggerRef t) TriggerInvocation]
428403 -> RawElement GhcjsDomSpace
429− -> RawElementConfig er t HydrationDomSpace
404+ -> RawElementConfig er t GhcjsDomSpace
430405 -> m (DMap EventName (EventFilterTriggerRef t er))
431406wrap events e cfg = do
432407 forM_ (_rawElementConfig_modifyAttributes cfg) $ \modifyAttrs -> requestDomAction_ $ ffor modifyAttrs $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of
@@ -451,9 +426,9 @@ wrap events e cfg = do
451426makeElement
452427 :: forall er t m a. (MonadJSM m, MonadHold t m, MonadFix m, MonadReflexCreateTrigger t m, Adjustable t m, Ref m ~ IORef, PerformEvent t m, MonadJSM (Performable m), MonadRef m)
453428 => Text
454− -> ElementConfig er t HydrationDomSpace
429+ -> ElementConfig er t GhcjsDomSpace
455430 -> HydrationDomBuilderT t m a
456− -> HydrationDomBuilderT t m ((Element er HydrationDomSpace t, a), DOM.Element)
431+ -> HydrationDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)
457432makeElement elementTag cfg child = do
458433 doc <- askDocument
459434 ctx <- askJSM
@@ -501,7 +476,7 @@ makeElement elementTag cfg child = do
501476 events <- askEvents
502477 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg
503478 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e
504− return ((Element es (), result), e)
479+ return ((Element es e, result), e)
505480 HydrationMode_Hydrating -> do
506481 -- Schedule everything for after postBuild, except for getting the result itself
507482 parent <- liftIO $ newIORef $ error "Parent not yet initialized"
@@ -539,7 +514,8 @@ makeElement elementTag cfg child = do
539514 Nothing -> killThread threadId
540515 Just c -> c
541516
542− return ((Element es (), result), error "makeElement: DOM.Element")
517+ let dummyElement = error "makeElement: DOM.Element"
518+ return ((Element es dummyElement, result), dummyElement)
543519
544520{-# INLINABLE textNodeInternal #-}
545521textNodeInternal :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t) => Text -> Maybe (Event t Text) -> HydrationDomBuilderT t m DOM.Text
@@ -674,17 +650,17 @@ instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m
674650 liftIO $ modifyIORef' unreadyChildren succ
675651
676652instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT t m) where
677− type DomBuilderSpace (HydrationDomBuilderT t m) = HydrationDomSpace
653+ type DomBuilderSpace (HydrationDomBuilderT t m) = GhcjsDomSpace
678654 {-# INLINABLE textNode #-}
679655 textNode (TextNodeConfig initialContents mSetContents) = do
680656 liftIO $ putStrLn $ "Text: " <> T.unpack initialContents
681− textNodeInternal initialContents mSetContents
682− return $ TextNode ()
657+ t <- textNodeInternal initialContents mSetContents
658+ return $ TextNode t
683659 {-# INLINABLE commentNode #-}
684660 commentNode (CommentNodeConfig initialContents mSetContents) = do
685661 liftIO $ putStrLn $ "Comment: " <> T.unpack initialContents
686− commentNodeInternal initialContents mSetContents
687− return $ CommentNode ()
662+ c <- commentNodeInternal initialContents mSetContents
663+ return $ CommentNode c
688664 {-# INLINABLE element #-}
689665 element elementTag cfg child = do
690666 liftIO $ putStrLn $ "Element: " <> T.unpack elementTag
@@ -738,7 +714,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
738714 , _inputElement_input = valueChangedByUI
739715 , _inputElement_hasFocus = hasFocus
740716 , _inputElement_element = e
741− , _inputElement_raw = ()--domInputElement
717+ , _inputElement_raw = domInputElement
742718 , _inputElement_files = files
743719 }
744720 {-# INLINABLE textAreaElement #-}
@@ -764,7 +740,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
764740 , _textAreaElement_input = valueChangedByUI
765741 , _textAreaElement_hasFocus = hasFocus
766742 , _textAreaElement_element = e
767− , _textAreaElement_raw = ()--domTextAreaElement
743+ , _textAreaElement_raw = domTextAreaElement
768744 }
769745 {-# INLINABLE selectElement #-}
770746 selectElement cfg child = do
@@ -789,11 +765,11 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
789765 , _selectElement_change = valueChangedByUI
790766 , _selectElement_hasFocus = hasFocus
791767 , _selectElement_element = e
792− , _selectElement_raw = ()--domSelectElement
768+ , _selectElement_raw = domSelectElement
793769 }
794770 return (wrapped, result)
795771 placeRawElement _ = return () -- append . toNode
796− wrapRawElement () _ = return $ Element (EventSelector $ const never) ()
772+ wrapRawElement e _ = return $ Element (EventSelector $ const never) e -- TODO
797773
798774data FragmentState
799775 = FragmentState_Unmounted