c9b1c0d · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Remove HydrationDomSpace, use GhcjsDomSpace

c9b1c0dTom Smalley8 years ago

reflex-dom-core/src/Reflex/Dom/Builder/Hydration.hs+16−40

compare with develop

unifiedsplit

@@ -37,6 +37,7 @@ module Reflex.Dom.Builder.Hydration

37 , HydrationMode (..)

38 , HydrationRunnerT (..)

39 , runHydrationRunnerT

40+ , localEnv

40 , addHydrationStepWithSetup

41 , addHydrationStepWithSetup

41 , addHydrationStep

42 , addHydrationStep

42 , hydrateNode

43 , hydrateNode

@@ -159,32 +160,6 @@ instance MonadJSM m => MonadJSM (DomRenderHookT t m) where

159 liftJSM' = lift . liftJSM'

160 liftJSM' = lift . liftJSM'

160#endif

161#endif

161

162

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−

188data HydrationDomBuilderEnv t = HydrationDomBuilderEnv

163data HydrationDomBuilderEnv t = HydrationDomBuilderEnv

189 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document

164 { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document

190 -- ^ Reference to the document

165 -- ^ Reference to the document

@@ -426,7 +401,7 @@ wrap

426 :: forall m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)

401 :: forall m er t. (Reflex t, MonadJSM m, MonadReflexCreateTrigger t m, DomRenderHook t m)

427 => Chan [DSum (EventTriggerRef t) TriggerInvocation]

402 => Chan [DSum (EventTriggerRef t) TriggerInvocation]

428 -> RawElement GhcjsDomSpace

403 -> RawElement GhcjsDomSpace

429− -> RawElementConfig er t HydrationDomSpace

404+ -> RawElementConfig er t GhcjsDomSpace

430 -> m (DMap EventName (EventFilterTriggerRef t er))

405 -> m (DMap EventName (EventFilterTriggerRef t er))

431wrap events e cfg = do

406wrap events e cfg = do

432 forM_ (_rawElementConfig_modifyAttributes cfg) $ \modifyAttrs -> requestDomAction_ $ ffor modifyAttrs $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

407 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

451makeElement

426makeElement

452 :: 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)

427 :: 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)

453 => Text

428 => Text

454− -> ElementConfig er t HydrationDomSpace

429+ -> ElementConfig er t GhcjsDomSpace

455 -> HydrationDomBuilderT t m a

430 -> 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)

457makeElement elementTag cfg child = do

432makeElement elementTag cfg child = do

458 doc <- askDocument

433 doc <- askDocument

459 ctx <- askJSM

434 ctx <- askJSM

@@ -501,7 +476,7 @@ makeElement elementTag cfg child = do

501 events <- askEvents

476 events <- askEvents

502 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg

477 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg

503 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e

478 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e

504− return ((Element es (), result), e)

479+ return ((Element es e, result), e)

505 HydrationMode_Hydrating -> do

480 HydrationMode_Hydrating -> do

506 -- Schedule everything for after postBuild, except for getting the result itself

481 -- Schedule everything for after postBuild, except for getting the result itself

507 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

482 parent <- liftIO $ newIORef $ error "Parent not yet initialized"

@@ -539,7 +514,8 @@ makeElement elementTag cfg child = do

539 Nothing -> killThread threadId

514 Nothing -> killThread threadId

540 Just c -> c

515 Just c -> c

541

516

542− return ((Element es (), result), error "makeElement: DOM.Element")

517+ let dummyElement = error "makeElement: DOM.Element"

518+ return ((Element es dummyElement, result), dummyElement)

543

519

544{-# INLINABLE textNodeInternal #-}

520{-# INLINABLE textNodeInternal #-}

545textNodeInternal :: (Adjustable t m, MonadHold t m, MonadJSM m, MonadFix m, Reflex t) => Text -> Maybe (Event t Text) -> HydrationDomBuilderT t m DOM.Text

521textNodeInternal :: (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

674 liftIO $ modifyIORef' unreadyChildren succ

650 liftIO $ modifyIORef' unreadyChildren succ

675

651

676instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT t m) where

652instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT t m) where

677− type DomBuilderSpace (HydrationDomBuilderT t m) = HydrationDomSpace

653+ type DomBuilderSpace (HydrationDomBuilderT t m) = GhcjsDomSpace

678 {-# INLINABLE textNode #-}

654 {-# INLINABLE textNode #-}

679 textNode (TextNodeConfig initialContents mSetContents) = do

655 textNode (TextNodeConfig initialContents mSetContents) = do

680 liftIO $ putStrLn $ "Text: " <> T.unpack initialContents

656 liftIO $ putStrLn $ "Text: " <> T.unpack initialContents

681− textNodeInternal initialContents mSetContents

657+ t <- textNodeInternal initialContents mSetContents

682− return $ TextNode ()

658+ return $ TextNode t

683 {-# INLINABLE commentNode #-}

659 {-# INLINABLE commentNode #-}

684 commentNode (CommentNodeConfig initialContents mSetContents) = do

660 commentNode (CommentNodeConfig initialContents mSetContents) = do

685 liftIO $ putStrLn $ "Comment: " <> T.unpack initialContents

661 liftIO $ putStrLn $ "Comment: " <> T.unpack initialContents

686− commentNodeInternal initialContents mSetContents

662+ c <- commentNodeInternal initialContents mSetContents

687− return $ CommentNode ()

663+ return $ CommentNode c

688 {-# INLINABLE element #-}

664 {-# INLINABLE element #-}

689 element elementTag cfg child = do

665 element elementTag cfg child = do

690 liftIO $ putStrLn $ "Element: " <> T.unpack elementTag

666 liftIO $ putStrLn $ "Element: " <> T.unpack elementTag

@@ -738,7 +714,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT

738 , _inputElement_input = valueChangedByUI

714 , _inputElement_input = valueChangedByUI

739 , _inputElement_hasFocus = hasFocus

715 , _inputElement_hasFocus = hasFocus

740 , _inputElement_element = e

716 , _inputElement_element = e

741− , _inputElement_raw = ()--domInputElement

717+ , _inputElement_raw = domInputElement

742 , _inputElement_files = files

718 , _inputElement_files = files

743 }

719 }

744 {-# INLINABLE textAreaElement #-}

720 {-# INLINABLE textAreaElement #-}

@@ -764,7 +740,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT

764 , _textAreaElement_input = valueChangedByUI

740 , _textAreaElement_input = valueChangedByUI

765 , _textAreaElement_hasFocus = hasFocus

741 , _textAreaElement_hasFocus = hasFocus

766 , _textAreaElement_element = e

742 , _textAreaElement_element = e

767− , _textAreaElement_raw = ()--domTextAreaElement

743+ , _textAreaElement_raw = domTextAreaElement

768 }

744 }

769 {-# INLINABLE selectElement #-}

745 {-# INLINABLE selectElement #-}

770 selectElement cfg child = do

746 selectElement cfg child = do

@@ -789,11 +765,11 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT

789 , _selectElement_change = valueChangedByUI

765 , _selectElement_change = valueChangedByUI

790 , _selectElement_hasFocus = hasFocus

766 , _selectElement_hasFocus = hasFocus

791 , _selectElement_element = e

767 , _selectElement_element = e

792− , _selectElement_raw = ()--domSelectElement

768+ , _selectElement_raw = domSelectElement

793 }

769 }

794 return (wrapped, result)

770 return (wrapped, result)

795 placeRawElement _ = return () -- append . toNode

771 placeRawElement _ = return () -- append . toNode

796− wrapRawElement () _ = return $ Element (EventSelector $ const never) ()

772+ wrapRawElement e _ = return $ Element (EventSelector $ const never) e -- TODO

797

773

798data FragmentState

774data FragmentState

799 = FragmentState_Unmounted

775 = FragmentState_Unmounted