@@ -51,22 +51,6 @@ module Reflex.Dom.Builder.Hydration
5151 , hoistTraverseIntMapWithKeyWithAdjust
5252 ) where
5353
54−import Foreign.JavaScript.TH
55−import Reflex.Adjustable.Class
56−import Reflex.Class as Reflex
57−import qualified Reflex.Spider.Internal as Spider
58−import Reflex.Dom.Builder.Class
59−import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, commentNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate)
60−import Reflex.Dynamic
61−import Reflex.Host.Class
62−import qualified Reflex.Patch.DMap as PatchDMap
63−import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
64−import Reflex.PerformEvent.Class
65−import Reflex.PostBuild.Class
66−import Reflex.TriggerEvent.Base hiding (askEvents)
67−import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
68−import Reflex.TriggerEvent.Class
69−
7054import Control.Concurrent
7155import Control.Exception (bracketOnError)
7256import Control.Lens hiding (element, ix)
@@ -75,71 +59,64 @@ import Control.Monad.Primitive
7559import Control.Monad.Reader
7660import Control.Monad.Ref
7761import Control.Monad.State.Strict
78−import Control.Monad.Trans.Maybe
79−#ifndef USE_TEMPLATE_HASKELL
80−import Data.Functor.Contravariant (phantom)
81−#endif
82−import Data.Bitraversable
83−import Data.Default
8462import Data.Dependent.Map (DMap)
85−import qualified Data.Dependent.Map as DMap
8663import Data.Dependent.Sum
87−import Data.Foldable (foldl', for_)
64+import Data.FastMutableIntMap (PatchIntMap (..))
65+import Data.Foldable (for_)
8866import Data.Functor.Compose
8967import Data.Functor.Constant
9068import Data.Functor.Misc
9169import Data.Functor.Product
9270import Data.IORef
93−import qualified Data.Map as Map
71+import Data.IntMap.Strict (IntMap)
9472import Data.Maybe
95−import Data.Monoid hiding (Product)
96−import Data.Some (Some)
97−import qualified Data.Some as Some
9873import Data.Text (Text)
74+import Data.Typeable (Typeable)
75+import Foreign.JavaScript.Internal.Utils
76+import Foreign.JavaScript.TH
77+import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
78+import GHCJS.DOM.Element (removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
79+import GHCJS.DOM.EventM (on)
80+import GHCJS.DOM.Node (appendChild_, setNodeValue, toNode)
81+import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, IsNode, Node, ToDOMString, uncheckedCastTo)
82+import Reflex.Adjustable.Class
83+import Reflex.Class as Reflex
84+import Reflex.Dom.Builder.Class
85+import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate)
86+import Reflex.Dynamic
87+import Reflex.Host.Class
88+import Reflex.PerformEvent.Class
89+import Reflex.PostBuild.Class
90+import Reflex.Requester.Base
91+import Reflex.Requester.Class
92+import Reflex.TriggerEvent.Base hiding (askEvents)
93+import Reflex.TriggerEvent.Class
94+
95+import qualified Data.Dependent.Map as DMap
96+import qualified Data.FastMutableIntMap as FastMutableIntMap
97+import qualified Data.IntMap.Strict as IntMap
98+import qualified Data.Map as Map
99+import qualified Data.Some as Some
99100import qualified Data.Text as T
100−import Data.Typeable (Typeable, typeRep, Proxy(..))
101−import GHC.Generics (Generic)
102101import qualified GHCJS.DOM as DOM
103−import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
104−import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
102+import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
105103import qualified GHCJS.DOM.Element as Element
106−import qualified GHCJS.DOM.Event as Event
107−import qualified GHCJS.DOM.GlobalEventHandlers as Events
108−import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events
109−import GHCJS.DOM.EventM (EventM, event, on)
110104import qualified GHCJS.DOM.EventM as DOM
111105import qualified GHCJS.DOM.FileList as FileList
112−import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
106+import qualified GHCJS.DOM.GlobalEventHandlers as Events
113107import qualified GHCJS.DOM.HTMLInputElement as Input
114108import qualified GHCJS.DOM.HTMLSelectElement as Select
115109import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
116−import GHCJS.DOM.MouseEvent
117−import qualified GHCJS.DOM.Touch as Touch
118−import qualified GHCJS.DOM.TouchEvent as TouchEvent
119−import qualified GHCJS.DOM.TouchList as TouchList
120−import GHCJS.DOM.Node (appendChild_, getChildNodes, getOwnerDocumentUnchecked, getParentNodeUnchecked, setNodeValue, toNode)
121−import qualified GHCJS.DOM.Node as DOM (insertBefore_)
122110import qualified GHCJS.DOM.Node as Node
123−import qualified GHCJS.DOM.NodeList as NodeList
124111import qualified GHCJS.DOM.Text as DOM
125−import GHCJS.DOM.Types
126− (liftJSM, askJSM, runJSM, JSM, MonadJSM,
127− FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,
128− ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)
129112import qualified GHCJS.DOM.Types as DOM
130−import GHCJS.DOM.UIEvent
131−import GHCJS.DOM.KeyboardEvent as KeyboardEvent
132−import qualified GHCJS.DOM.Window as Window
133−import Language.Javascript.JSaddle (call, eval, jsg, js1)
134−import Data.IntMap.Strict (IntMap)
135−import qualified Data.IntMap.Strict as IntMap
136−import Data.FastMutableIntMap (PatchIntMap (..))
137−import qualified Data.FastMutableIntMap as FastMutableIntMap
138−import System.IO.Unsafe (unsafePerformIO)
113+import qualified Reflex.Patch.DMap as PatchDMap
114+import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
115+import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
139116
140−import Reflex.Requester.Base
141−import Reflex.Requester.Class
142−import Foreign.JavaScript.Internal.Utils
117+#ifndef USE_TEMPLATE_HASKELL
118+import Data.Functor.Contravariant (phantom)
119+#endif
143120
144121#ifndef ghcjs_HOST_OS
145122import GHCJS.DOM.Types (MonadJSM (..))
@@ -166,7 +143,7 @@ data HydrationDomBuilderEnv t = HydrationDomBuilderEnv
166143 -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
167144 , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
168145 -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
169− , _hydrationDomBuilderEnv_switchover :: {-# UNPACK #-} !(Event t ())
146+ , _hydrationDomBuilderEnv_switchover :: !(Event t ())
170147 }
171148
172149-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
@@ -461,7 +438,6 @@ makeElement elementTag cfg child = do
461438 p <- liftIO $ newIORef $ toNode e
462439 -- Run the child builder with updated parent and previous sibling references
463440 result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) child
464− events <- askEvents
465441 eventTriggerRefs <- wrap events e $ extractRawElementConfig cfg
466442 es <- newFanEventWithTrigger $ triggerBody eventTriggerRefs e
467443 e' <- liftIO $ newIORef e
@@ -516,7 +492,6 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case
516492 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
517493 pure n
518494 HydrationMode_Hydrating -> do
519− doc <- askDocument
520495 addHydrationStepWithSetup (maybe (pure $ pure t) (hold t) mSetContents) $ \currentText -> do
521496 n <- hydrateTextNode =<< sample currentText
522497 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
@@ -530,9 +505,9 @@ textNodeInternal !t mSetContents = getHydrationMode >>= \case
530505hydrateTextNode :: MonadJSM m => Text -> HydrationRunnerT t m DOM.Text
531506hydrateTextNode t@"" = do
532507 doc <- Node.getOwnerDocumentUnchecked =<< askParent
533− textNode <- createTextNode doc t
534− insertAfterPreviousNode textNode
535− pure textNode
508+ tn <- createTextNode doc t
509+ insertAfterPreviousNode tn
510+ pure tn
536511hydrateTextNode t = do
537512 n <- join $ go <$> askParent <*> getPreviousNode
538513 setPreviousNode $ Just $ toNode n
@@ -562,7 +537,6 @@ commentNodeInternal !t mSetContents = getHydrationMode >>= \case
562537 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
563538 pure n
564539 HydrationMode_Hydrating -> do
565− doc <- askDocument
566540 addHydrationStep $ do
567541 n <- hydrateNode (const $ pure True) DOM.Comment
568542 mapM_ (requestDomAction_ . fmap (setNodeValue n . Just)) mSetContents
@@ -597,19 +571,19 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
597571 case T.stripPrefix (prefix <> key0) commentText of
598572 Just key -> do
599573 -- Replace the comment with an (invisible) text node
600− textNode <- createTextNode doc ("" :: Text)
601− Node.replaceChild_ parent textNode comment
602− pure (textNode, key)
574+ tn <- createTextNode doc ("" :: Text)
575+ Node.replaceChild_ parent tn comment
576+ pure (tn, key)
603577 Nothing -> do
604578 go key0 (Just node)
605579 Nothing -> do
606580 go key0 (Just node)
607581 switchComment = do
608582 key0 <- liftIO $ readIORef key0Ref
609− (textNode, key) <- go key0 =<< getPreviousNode
610− setPreviousNode $ Just $ toNode textNode
583+ (tn, key) <- go key0 =<< getPreviousNode
584+ setPreviousNode $ Just $ toNode tn
611585 liftIO $ do
612− writeIORef textNodeRef textNode
586+ writeIORef textNodeRef tn
613587 writeIORef keyRef key
614588 pure (switchComment, textNodeRef, keyRef)
615589
@@ -632,7 +606,6 @@ instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT t m
632606 when (new == 0) commitAction
633607 requestDomAction_ $ ready <$ eOnce
634608 notReady = do
635− env <- HydrationDomBuilderT ask
636609 unreadyChildren <- askUnreadyChildren
637610 liftIO $ modifyIORef' unreadyChildren succ
638611
@@ -695,7 +668,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
695668 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'
696669
697670 Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg
698− liftJSM $ domInputElement `on` Events.click $ do
671+ _ <- liftJSM $ domInputElement `on` Events.click $ do
699672 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement
700673
701674 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->
@@ -704,7 +677,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
704677 Input.setChecked domInputElement newChecked
705678 when (newChecked /= oldChecked) $ liftIO $ triggerCheckedChangedBySetChecked newChecked
706679
707− liftJSM $ domInputElement `on` Events.change $ do
680+ _ <- liftJSM $ domInputElement `on` Events.change $ do
708681 mfiles <- Input.getFiles domInputElement
709682 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs
710683 liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles
@@ -740,7 +713,7 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
740713
741714 {-# INLINABLE textAreaElement #-}
742715 textAreaElement cfg = do --TODO
743− ((e, _), domElement') <- makeElement "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
716+ ((e, _), _domElement') <- makeElement "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()
744717 let domElement = undefined :: DOM.HTMLTextAreaElement
745718 let domTextAreaElement = uncheckedCastTo DOM.HTMLTextAreaElement domElement
746719 TextArea.setValue domTextAreaElement $ cfg ^. textAreaElementConfig_initialValue
@@ -764,9 +737,10 @@ instance (SupportsHydrationDomBuilder t m) => DomBuilder t (HydrationDomBuilderT
764737 , _textAreaElement_element = e
765738 , _textAreaElement_raw = domTextAreaElement
766739 }
740+
767741 {-# INLINABLE selectElement #-}
768742 selectElement cfg child = do
769− ((e, result), domElement') <- makeElement "select" (cfg ^. selectElementConfig_elementConfig) child
743+ ((e, result), _domElement') <- makeElement "select" (cfg ^. selectElementConfig_elementConfig) child
770744 let domElement = undefined :: DOM.HTMLSelectElement
771745 let domSelectElement = uncheckedCastTo DOM.HTMLSelectElement domElement
772746 Select.setValue domSelectElement $ cfg ^. selectElementConfig_initialValue
@@ -805,8 +779,8 @@ data HydrationDomFragment = HydrationDomFragment
805779
806780extractFragment :: MonadJSM m => HydrationDomFragment -> m ()
807781extractFragment fragment = do
808− state <- liftIO $ readIORef $ _hydrationDomFragment_state fragment
809− case state of
782+ s <- liftIO $ readIORef $ _hydrationDomFragment_state fragment
783+ case s of
810784 FragmentState_Unmounted -> return ()
811785 FragmentState_Mounted (before, after) -> do
812786 extractBetweenExclusive (_hydrationDomFragment_document fragment) before after
@@ -818,8 +792,8 @@ instance SupportsHydrationDomBuilder t m => MountableDomBuilder t (HydrationDomB
818792 df <- createDocumentFragment =<< askDocument
819793 p <- liftIO $ newIORef $ toNode df
820794 result <- localEnv (\env -> env { _hydrationDomBuilderEnv_parent = p }) w
821− state <- liftIO $ newIORef FragmentState_Unmounted
822− return (HydrationDomFragment df state, result)
795+ s <- liftIO $ newIORef FragmentState_Unmounted
796+ return (HydrationDomFragment df s, result)
823797 mountDomFragment fragment setFragment = do
824798 parent <- getParent
825799 extractFragment fragment
@@ -1070,7 +1044,7 @@ hoistTraverseIntMapWithKeyWithAdjust :: forall v v' t m p.
10701044 -> Event t (p v)
10711045 -> HydrationDomBuilderT t m (IntMap v', Event t (p v'))
10721046hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_ f dm0 dm' = do
1073− (hydrateStart, _, key) <- skipToReplaceStart
1047+ (_hydrateStart, _, key) <- skipToReplaceStart
10741048 initialEnv <- HydrationDomBuilderT ask
10751049 let parentUnreadyChildren = _hydrationDomBuilderEnv_unreadyChildren initialEnv
10761050 pendingChange :: IORef (IntMap (IORef ChildReadyStateInt), p (HydrationRunnerT t m (), DOM.DocumentFragment, DOM.Text, IORef ChildReadyStateInt, v')) <- liftIO $ newIORef mempty
@@ -1131,13 +1105,13 @@ hoistTraverseIntMapWithKeyWithAdjust base updateChildUnreadiness applyDomUpdate_
11311105 insertAfterPreviousNode ph
11321106 liftIO $ writeIORef lastPlaceholderRef ph
11331107 addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1134− join $ sample (sequence . IntMap.elems <$> delayed)
1108+ _ <- join $ sample (sequence . IntMap.elems <$> delayed)
11351109 setFinalPlaceholder
11361110 liftIO $ writeIORef placeholders $! placeholders0
11371111 getHydrationMode >>= \case
11381112 HydrationMode_Immediate -> void $ IntMap.traverseWithKey (\_ (_, df, _, _, _) -> void $ append $ toNode df) children0
11391113 _ -> pure ()
1140− (hydrateEnd, lastPlaceholderRef) <- skipToReplaceEnd key
1114+ (_hydrateEnd, _lastPlaceholderRef) <- skipToReplaceEnd key
11411115 requestDomAction_ $ ffor children' $ \p -> do
11421116 (oldUnready, oldP) <- liftIO $ readIORef pendingChange
11431117 newUnready <- liftIO $ updateChildUnreadiness p oldUnready
@@ -1245,7 +1219,7 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda
12451219 insertAfterPreviousNode ph
12461220 liftIO $ writeIORef lastPlaceholderRef ph
12471221 addHydrationStepWithSetup (accumMaybeB (flip apply) delayed0 delayed') $ \delayed -> do
1248− join $ sample (traverse (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)
1222+ _ <- join $ sample (traverse (\(_ :=> Const d) -> d) . DMap.toList <$> delayed)
12491223 setFinalPlaceholder
12501224 liftIO $ writeIORef placeholders $! placeholders0
12511225 getHydrationMode >>= \case