<commit_before>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef ghcjs_HOST_OS
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}
#endif
module Reflex.Dom.Builder.Hydration
       ( EventTriggerRef (..)
       , HydrationDomBuilderEnv (..)
       , HydrationDomBuilderT (..)
       , HydrationMode (..)
       , HydrationRunnerT (..)
       , runHydrationRunnerT
       , localEnv
       , addHydrationStepWithSetup
       , addHydrationStep
       , getHydrationMode
       , hydrateNode
       , getPreviousNode, setPreviousNode
       , runHydrationDomBuilderT
       , askParent
       , askEvents
       , append
       , textNodeInternal
       , SupportsHydrationDomBuilder
       , wrap
       , makeElement
       , drawChildUpdate
       -- * Internal
       , traverseDMapWithKeyWithAdjust'
       , hoistTraverseWithKeyWithAdjust
       , traverseIntMapWithKeyWithAdjust'
       ) where

import Control.Concurrent
import Control.Exception (bracketOnError)
import Control.Lens (Identity(..), imapM_, iforM_, (^.))
import Control.Monad.Exception
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.FastMutableIntMap (PatchIntMap (..))
import Data.Foldable (for_)
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.IORef
import Data.IntMap.Strict (IntMap)
import Data.Maybe
import Data.Some (Some(..))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Foreign.JavaScript.Internal.Utils
import Foreign.JavaScript.TH
import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
import GHCJS.DOM.Element (removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
import GHCJS.DOM.EventM (on)
import GHCJS.DOM.Node (appendChild_, setNodeValue, toNode)
import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, IsNode, Node, ToDOMString, uncheckedCastTo)
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate, ChildReadyState(..))
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.Patch.DMapWithMove (PatchDMapWithMove(..))
import Reflex.Patch.MapWithMove (PatchMapWithMove(..))
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Class
import Reflex.Requester.Base
import Reflex.Requester.Class
import Reflex.TriggerEvent.Base hiding (askEvents)
import Reflex.TriggerEvent.Class

import qualified Data.Dependent.Map as DMap
import qualified Data.FastMutableIntMap as FastMutableIntMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.EventM as DOM
import qualified GHCJS.DOM.FileList as FileList
import qualified GHCJS.DOM.GlobalEventHandlers as Events
import qualified GHCJS.DOM.HTMLInputElement as Input
import qualified GHCJS.DOM.HTMLSelectElement as Select
import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Text as DOM
import qualified GHCJS.DOM.Types as DOM
import qualified Reflex.Patch.DMap as PatchDMap
import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

#ifndef USE_TEMPLATE_HASKELL
import Data.Functor.Contravariant (phantom)
#endif

#ifndef ghcjs_HOST_OS
import GHCJS.DOM.Types (MonadJSM (..))

instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
    liftJSM' = lift . liftJSM'

instance MonadJSM m => MonadJSM (HydrationDomBuilderT t m) where
    liftJSM' = lift . liftJSM'

instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
    liftJSM' = lift . liftJSM'
#endif

data HydrationDomBuilderEnv t = HydrationDomBuilderEnv
  { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
  -- ^ Reference to the document
  , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
  -- ^ This is in an IORef because in the time up to hydration we can't actually know what the
  -- parent is - we populate this reference during the DOM traversal at hydration time
  , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
  -- ^ Number of children who still aren't fully rendered
  , _hydrationDomBuilderEnv_commitAction :: !(JSM ())
  -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
  , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
  -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
  , _hydrationDomBuilderEnv_switchover :: !(Event t ())
  }

-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events
-- State contains reference to the previous node sibling, if any.
newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT (Maybe Node) (ReaderT Node (DomRenderHookT t m)) a }
  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
#if MIN_VERSION_base(4,9,1)
           , MonadAsyncException
#endif
           )

localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner (HydrationRunnerT m) s parent = HydrationRunnerT . lift $ local (\_ -> parent) (evalStateT m s)

runHydrationRunnerT
  :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
  => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerT (HydrationRunnerT m) s parent = runDomRenderHookT (runReaderT (evalStateT m s) parent)

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger = lift . newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

instance MonadTrans (HydrationRunnerT t) where
  lift = HydrationRunnerT . lift . lift . lift

instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
  sample = lift . sample

-- | Add a hydration step which depends on some computation that should only be
-- done *before* the switchover to immediate mode - this is most likely some
-- form of 'hold' which we want to remove after hydration is done
addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT t m ()<commit_msg>Add top level docs to hydration builder<commit_after>{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef ghcjs_HOST_OS
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}
#endif
-- | This is a builder to be used on the client side. It can be run in two modes:
--
--  1. in "hydration mode", reusing DOM nodes already in the page (as produced
--  by 'Reflex.Dom.Builder.Static.renderStatic')
--  2. in "immediate mode", creating and appending DOM nodes as required
--
-- In "hydration mode", the preexisting DOM __must contain__ what the builder
-- will expect at switchover time (the time at which parity with the static
-- renderer is reached, and the time after which the page is "live").
-- There can be extra nodes, but no missing or incorrect nodes.
--
-- For example, displaying the current time as text should be done inside
-- 'Reflex.Dom.Prerender.prerender' to ensure that we don't attempt to hydrate the incorrect text.
-- The server will prerender a text node with time A, and the client will expect
-- a text node with time B. Barring a miracle, time A and time B will not match,
-- and hydration will fail.
module Reflex.Dom.Builder.Hydration
       ( EventTriggerRef (..)
       , HydrationDomBuilderEnv (..)
       , HydrationDomBuilderT (..)
       , HydrationMode (..)
       , HydrationRunnerT (..)
       , runHydrationRunnerT
       , localEnv
       , addHydrationStepWithSetup
       , addHydrationStep
       , getHydrationMode
       , hydrateNode
       , getPreviousNode, setPreviousNode
       , runHydrationDomBuilderT
       , askParent
       , askEvents
       , append
       , textNodeInternal
       , SupportsHydrationDomBuilder
       , wrap
       , makeElement
       , drawChildUpdate
       -- * Internal
       , traverseDMapWithKeyWithAdjust'
       , hoistTraverseWithKeyWithAdjust
       , traverseIntMapWithKeyWithAdjust'
       ) where

import Control.Concurrent
import Control.Exception (bracketOnError)
import Control.Lens (Identity(..), imapM_, iforM_, (^.))
import Control.Monad.Exception
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict
import Data.Dependent.Map (DMap)
import Data.Dependent.Sum
import Data.FastMutableIntMap (PatchIntMap (..))
import Data.Foldable (for_)
import Data.Functor.Compose
import Data.Functor.Constant
import Data.Functor.Misc
import Data.Functor.Product
import Data.IORef
import Data.IntMap.Strict (IntMap)
import Data.Maybe
import Data.Some (Some(..))
import Data.Text (Text)
import Data.Typeable (Typeable)
import Foreign.JavaScript.Internal.Utils
import Foreign.JavaScript.TH
import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
import GHCJS.DOM.Element (removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
import GHCJS.DOM.EventM (on)
import GHCJS.DOM.Node (appendChild_, setNodeValue, toNode)
import GHCJS.DOM.Types (liftJSM, askJSM, runJSM, JSM, MonadJSM, IsNode, Node, ToDOMString, uncheckedCastTo)
import Reflex.Adjustable.Class
import Reflex.Class as Reflex
import Reflex.Dom.Builder.Class
import Reflex.Dom.Builder.Immediate hiding (askEvents, askParent, append, wrap, makeElement, textNodeInternal, traverseIntMapWithKeyWithAdjust', traverseDMapWithKeyWithAdjust', hoistTraverseWithKeyWithAdjust, hoistTraverseIntMapWithKeyWithAdjust, drawChildUpdate, ChildReadyState(..))
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.Patch.DMapWithMove (PatchDMapWithMove(..))
import Reflex.Patch.MapWithMove (PatchMapWithMove(..))
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Class
import Reflex.Requester.Base
import Reflex.Requester.Class
import Reflex.TriggerEvent.Base hiding (askEvents)
import Reflex.TriggerEvent.Class

import qualified Data.Dependent.Map as DMap
import qualified Data.FastMutableIntMap as FastMutableIntMap
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified GHCJS.DOM as DOM
import qualified GHCJS.DOM.DocumentOrShadowRoot as Document
import qualified GHCJS.DOM.Element as Element
import qualified GHCJS.DOM.EventM as DOM
import qualified GHCJS.DOM.FileList as FileList
import qualified GHCJS.DOM.GlobalEventHandlers as Events
import qualified GHCJS.DOM.HTMLInputElement as Input
import qualified GHCJS.DOM.HTMLSelectElement as Select
import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea
import qualified GHCJS.DOM.Node as Node
import qualified GHCJS.DOM.Text as DOM
import qualified GHCJS.DOM.Types as DOM
import qualified Reflex.Patch.DMap as PatchDMap
import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

#ifndef USE_TEMPLATE_HASKELL
import Data.Functor.Contravariant (phantom)
#endif

#ifndef ghcjs_HOST_OS
import GHCJS.DOM.Types (MonadJSM (..))

instance MonadJSM m => MonadJSM (HydrationRunnerT t m) where
    liftJSM' = lift . liftJSM'

instance MonadJSM m => MonadJSM (HydrationDomBuilderT t m) where
    liftJSM' = lift . liftJSM'

instance MonadJSM m => MonadJSM (DomRenderHookT t m) where
    liftJSM' = lift . liftJSM'
#endif

data HydrationDomBuilderEnv t = HydrationDomBuilderEnv
  { _hydrationDomBuilderEnv_document :: {-# UNPACK #-} !Document
  -- ^ Reference to the document
  , _hydrationDomBuilderEnv_parent :: {-# UNPACK #-} !(IORef Node)
  -- ^ This is in an IORef because in the time up to hydration we can't actually know what the
  -- parent is - we populate this reference during the DOM traversal at hydration time
  , _hydrationDomBuilderEnv_unreadyChildren :: {-# UNPACK #-} !(IORef Word)
  -- ^ Number of children who still aren't fully rendered
  , _hydrationDomBuilderEnv_commitAction :: !(JSM ())
  -- ^ Action to take when all children are ready --TODO: we should probably get rid of this once we invoke it
  , _hydrationDomBuilderEnv_hydrationMode :: {-# UNPACK #-} !(IORef HydrationMode)
  -- ^ In hydration mode? Should be switched to `HydrationMode_Immediate` after hydration is finished
  , _hydrationDomBuilderEnv_switchover :: !(Event t ())
  }

-- | The monad which performs the delayed actions to reuse prerendered nodes and set up events.
-- State contains reference to the previous node sibling, if any, and the reader contains reference to the parent node.
newtype HydrationRunnerT t m a = HydrationRunnerT { unHydrationRunnerT :: StateT (Maybe Node) (ReaderT Node (DomRenderHookT t m)) a }
  deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException
#if MIN_VERSION_base(4,9,1)
           , MonadAsyncException
#endif
           )

localRunner :: (MonadJSM m, Monad m) => HydrationRunnerT t m a -> Maybe Node -> Node -> HydrationRunnerT t m a
localRunner (HydrationRunnerT m) s parent = HydrationRunnerT . lift $ local (\_ -> parent) (evalStateT m s)

runHydrationRunnerT
  :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))
  => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a
runHydrationRunnerT (HydrationRunnerT m) s parent = runDomRenderHookT (runReaderT (evalStateT m s) parent)

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger = lift . newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

instance MonadTrans (HydrationRunnerT t) where
  lift = HydrationRunnerT . lift . lift . lift

instance MonadSample t m => MonadSample t (HydrationRunnerT t m) where
  sample = lift . sample

-- | Add a hydration step which depends on some computation that should only be
-- done *before* the switchover to immediate mode - this is most likely some
-- form of 'hold' which we want to remove after hydration is done
addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT t m ()
{'fraction_non_alphanumeric': 0.0897619901925607, 'fraction_numerical': 0.00047841167324482717, 'mean_word_length': 4.456117455138663, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 41, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6714638', 'n_tokens_mistral': 5354, 'n_tokens_neox': 5207, 'n_words': 1560}