{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
module Reflex.Dom.Builder.Static where

import Data.IORef (IORef)
import Blaze.ByteString.Builder.Html.Utf8
import Control.Lens hiding (element)
import Control.Monad
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.Ref
import Control.Monad.State.Strict
import Control.Monad.Trans.Reader
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, byteString, toLazyByteString)
import qualified Data.ByteString.Lazy as LBS
import Data.Default
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum (DSum (..))
import Data.Functor.Compose
import Data.Functor.Constant
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import Data.Map.Misc (applyMap)
import Data.Maybe (fromMaybe)
import Data.Kind (Type)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Tuple
import GHC.Generics
import Reflex.Adjustable.Class
import Reflex.Class
import Reflex.Dom.Main (DomHost, DomTimeline, runDomHost)
import Reflex.Dom.Builder.Class
import Reflex.Dynamic
import Reflex.Host.Class
import Reflex.PerformEvent.Base
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Base
import Reflex.PostBuild.Class
import Reflex.TriggerEvent.Class

data StaticDomBuilderEnv t = StaticDomBuilderEnv
  { forall {k} (t :: k). StaticDomBuilderEnv t -> Bool
_staticDomBuilderEnv_shouldEscape :: Bool
  , forall {k} (t :: k).
StaticDomBuilderEnv t -> Maybe (Behavior t Text)
_staticDomBuilderEnv_selectValue :: Maybe (Behavior t Text)
    -- ^ When the parent element is a "select" whose value has been set, this value tells us the current value.
    -- We use this to add a "selected" attribute to the appropriate "option" child element.
    -- This is not yet a perfect simulation of what the browser does, but it is much closer than doing nothing.
    -- TODO: Handle edge cases, e.g. setting to a value for which there is no option, then adding that option dynamically afterwards.
  , forall {k} (t :: k). StaticDomBuilderEnv t -> IORef Int
_staticDomBuilderEnv_nextRunWithReplaceKey :: IORef Int
  }

newtype StaticDomBuilderT t m a = StaticDomBuilderT
    { forall {k} (t :: k) (m :: * -> *) a.
StaticDomBuilderT t m a
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
unStaticDomBuilderT :: ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a -- Accumulated Html will be in reversed order
    }
  deriving ((forall a b.
 (a -> b) -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b)
-> (forall a b.
    a -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a)
-> Functor (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) a b.
Functor m =>
a -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) a b.
Functor m =>
(a -> b) -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
forall a b. a -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall a b.
(a -> b) -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k (t :: k) (m :: * -> *) a b.
Functor m =>
(a -> b) -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
fmap :: forall a b.
(a -> b) -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
$c<$ :: forall k (t :: k) (m :: * -> *) a b.
Functor m =>
a -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
<$ :: forall a b. a -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
Functor, Functor (StaticDomBuilderT t m)
Functor (StaticDomBuilderT t m) =>
(forall a. a -> StaticDomBuilderT t m a)
-> (forall a b.
    StaticDomBuilderT t m (a -> b)
    -> StaticDomBuilderT t m a -> StaticDomBuilderT t m b)
-> (forall a b c.
    (a -> b -> c)
    -> StaticDomBuilderT t m a
    -> StaticDomBuilderT t m b
    -> StaticDomBuilderT t m c)
-> (forall a b.
    StaticDomBuilderT t m a
    -> StaticDomBuilderT t m b -> StaticDomBuilderT t m b)
-> (forall a b.
    StaticDomBuilderT t m a
    -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a)
-> Applicative (StaticDomBuilderT t m)
forall a. a -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *).
Monad m =>
Functor (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) a.
Monad m =>
a -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m (a -> b)
-> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
forall k (t :: k) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> StaticDomBuilderT t m a
-> StaticDomBuilderT t m b
-> StaticDomBuilderT t m c
forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
forall a b.
StaticDomBuilderT t m (a -> b)
-> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
forall a b c.
(a -> b -> c)
-> StaticDomBuilderT t m a
-> StaticDomBuilderT t m b
-> StaticDomBuilderT t m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall k (t :: k) (m :: * -> *) a.
Monad m =>
a -> StaticDomBuilderT t m a
pure :: forall a. a -> StaticDomBuilderT t m a
$c<*> :: forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m (a -> b)
-> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
<*> :: forall a b.
StaticDomBuilderT t m (a -> b)
-> StaticDomBuilderT t m a -> StaticDomBuilderT t m b
$cliftA2 :: forall k (t :: k) (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> StaticDomBuilderT t m a
-> StaticDomBuilderT t m b
-> StaticDomBuilderT t m c
liftA2 :: forall a b c.
(a -> b -> c)
-> StaticDomBuilderT t m a
-> StaticDomBuilderT t m b
-> StaticDomBuilderT t m c
$c*> :: forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
*> :: forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
$c<* :: forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
<* :: forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
Applicative, Applicative (StaticDomBuilderT t m)
Applicative (StaticDomBuilderT t m) =>
(forall a b.
 StaticDomBuilderT t m a
 -> (a -> StaticDomBuilderT t m b) -> StaticDomBuilderT t m b)
-> (forall a b.
    StaticDomBuilderT t m a
    -> StaticDomBuilderT t m b -> StaticDomBuilderT t m b)
-> (forall a. a -> StaticDomBuilderT t m a)
-> Monad (StaticDomBuilderT t m)
forall a. a -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *).
Monad m =>
Applicative (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) a.
Monad m =>
a -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> (a -> StaticDomBuilderT t m b) -> StaticDomBuilderT t m b
forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
forall a b.
StaticDomBuilderT t m a
-> (a -> StaticDomBuilderT t m b) -> StaticDomBuilderT t m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> (a -> StaticDomBuilderT t m b) -> StaticDomBuilderT t m b
>>= :: forall a b.
StaticDomBuilderT t m a
-> (a -> StaticDomBuilderT t m b) -> StaticDomBuilderT t m b
$c>> :: forall k (t :: k) (m :: * -> *) a b.
Monad m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
>> :: forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m b
$creturn :: forall k (t :: k) (m :: * -> *) a.
Monad m =>
a -> StaticDomBuilderT t m a
return :: forall a. a -> StaticDomBuilderT t m a
Monad, Monad (StaticDomBuilderT t m)
Monad (StaticDomBuilderT t m) =>
(forall a.
 (a -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a)
-> MonadFix (StaticDomBuilderT t m)
forall a. (a -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *).
MonadFix m =>
Monad (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) a.
MonadFix m =>
(a -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall k (t :: k) (m :: * -> *) a.
MonadFix m =>
(a -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
mfix :: forall a. (a -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
MonadFix, Monad (StaticDomBuilderT t m)
Monad (StaticDomBuilderT t m) =>
(forall a. IO a -> StaticDomBuilderT t m a)
-> MonadIO (StaticDomBuilderT t m)
forall a. IO a -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *).
MonadIO m =>
Monad (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) a.
MonadIO m =>
IO a -> StaticDomBuilderT t m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall k (t :: k) (m :: * -> *) a.
MonadIO m =>
IO a -> StaticDomBuilderT t m a
liftIO :: forall a. IO a -> StaticDomBuilderT t m a
MonadIO, Monad (StaticDomBuilderT t m)
Monad (StaticDomBuilderT t m) =>
(forall e a. Exception e => e -> StaticDomBuilderT t m a)
-> (forall e a.
    Exception e =>
    StaticDomBuilderT t m a
    -> (e -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a)
-> (forall a b.
    StaticDomBuilderT t m a
    -> StaticDomBuilderT t m b -> StaticDomBuilderT t m a)
-> MonadException (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *).
MonadException m =>
Monad (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) e a.
(MonadException m, Exception e) =>
StaticDomBuilderT t m a
-> (e -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
forall k (t :: k) (m :: * -> *) a b.
MonadException m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall e a. Exception e => e -> StaticDomBuilderT t m a
forall e a.
Exception e =>
StaticDomBuilderT t m a
-> (e -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
$cthrow :: forall k (t :: k) (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> StaticDomBuilderT t m a
throw :: forall e a. Exception e => e -> StaticDomBuilderT t m a
$ccatch :: forall k (t :: k) (m :: * -> *) e a.
(MonadException m, Exception e) =>
StaticDomBuilderT t m a
-> (e -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
catch :: forall e a.
Exception e =>
StaticDomBuilderT t m a
-> (e -> StaticDomBuilderT t m a) -> StaticDomBuilderT t m a
$cfinally :: forall k (t :: k) (m :: * -> *) a b.
MonadException m =>
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
finally :: forall a b.
StaticDomBuilderT t m a
-> StaticDomBuilderT t m b -> StaticDomBuilderT t m a
MonadException, MonadIO (StaticDomBuilderT t m)
MonadException (StaticDomBuilderT t m)
(MonadIO (StaticDomBuilderT t m),
 MonadException (StaticDomBuilderT t m)) =>
(forall b.
 ((forall a. StaticDomBuilderT t m a -> StaticDomBuilderT t m a)
  -> StaticDomBuilderT t m b)
 -> StaticDomBuilderT t m b)
-> MonadAsyncException (StaticDomBuilderT t m)
forall b.
((forall a. StaticDomBuilderT t m a -> StaticDomBuilderT t m a)
 -> StaticDomBuilderT t m b)
-> StaticDomBuilderT t m b
forall k (t :: k) (m :: * -> *).
MonadAsyncException m =>
MonadIO (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *).
MonadAsyncException m =>
MonadException (StaticDomBuilderT t m)
forall k (t :: k) (m :: * -> *) b.
MonadAsyncException m =>
((forall a. StaticDomBuilderT t m a -> StaticDomBuilderT t m a)
 -> StaticDomBuilderT t m b)
-> StaticDomBuilderT t m b
forall (m :: * -> *).
(MonadIO m, MonadException m) =>
(forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> MonadAsyncException m
$cmask :: forall k (t :: k) (m :: * -> *) b.
MonadAsyncException m =>
((forall a. StaticDomBuilderT t m a -> StaticDomBuilderT t m a)
 -> StaticDomBuilderT t m b)
-> StaticDomBuilderT t m b
mask :: forall b.
((forall a. StaticDomBuilderT t m a -> StaticDomBuilderT t m a)
 -> StaticDomBuilderT t m b)
-> StaticDomBuilderT t m b
MonadAsyncException)

instance PrimMonad m => PrimMonad (StaticDomBuilderT x m) where
  type PrimState (StaticDomBuilderT x m) = PrimState m
  primitive :: forall a.
(State# (PrimState (StaticDomBuilderT x m))
 -> (# State# (PrimState (StaticDomBuilderT x m)), a #))
-> StaticDomBuilderT x m a
primitive = m a -> StaticDomBuilderT x m a
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StaticDomBuilderT x m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> StaticDomBuilderT x m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall a.
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance MonadTrans (StaticDomBuilderT t) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
lift = ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT (ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
 -> StaticDomBuilderT t m a)
-> (m a
    -> ReaderT
         (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a)
-> m a
-> StaticDomBuilderT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT [Behavior t Builder] m a
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
forall (m :: * -> *) a.
Monad m =>
m a -> ReaderT (StaticDomBuilderEnv t) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT [Behavior t Builder] m a
 -> ReaderT
      (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a)
-> (m a -> StateT [Behavior t Builder] m a)
-> m a
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> StateT [Behavior t Builder] m a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT [Behavior t Builder] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

runStaticDomBuilderT :: (Monad m, Reflex t) => StaticDomBuilderT t m a -> StaticDomBuilderEnv t -> m (a, Behavior t Builder)
runStaticDomBuilderT :: forall {k} (m :: * -> *) (t :: k) a.
(Monad m, Reflex t) =>
StaticDomBuilderT t m a
-> StaticDomBuilderEnv t -> m (a, Behavior t Builder)
runStaticDomBuilderT (StaticDomBuilderT ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
a) StaticDomBuilderEnv t
e = do
  (result, a') <- StateT [Behavior t Builder] m a
-> [Behavior t Builder] -> m (a, [Behavior t Builder])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderEnv t -> StateT [Behavior t Builder] m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
a StaticDomBuilderEnv t
e) []
  return (result, mconcat $ reverse a')

instance PostBuild t m => PostBuild t (StaticDomBuilderT t m) where
  {-# INLINABLE getPostBuild #-}
  getPostBuild :: StaticDomBuilderT t m (Event t ())
getPostBuild = m (Event t ()) -> StaticDomBuilderT t m (Event t ())
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (StaticDomBuilderT t m) where
  {-# INLINABLE newEventWithTrigger #-}
  newEventWithTrigger :: forall a.
(EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (Event t a)
newEventWithTrigger = m (Event t a) -> StaticDomBuilderT t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> StaticDomBuilderT t m (Event t a))
-> ((EventTrigger t a -> IO (IO ())) -> m (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall a. (EventTrigger t a -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  {-# INLINABLE newFanEventWithTrigger #-}
  newFanEventWithTrigger :: forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
f = m (EventSelector t k) -> StaticDomBuilderT t m (EventSelector t k)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (EventSelector t k)
 -> StaticDomBuilderT t m (EventSelector t k))
-> m (EventSelector t k)
-> StaticDomBuilderT t m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger k a -> EventTrigger t a -> IO (IO ())
forall a. k a -> EventTrigger t a -> IO (IO ())
f

instance PerformEvent t m => PerformEvent t (StaticDomBuilderT t m) where
  type Performable (StaticDomBuilderT t m) = Performable m
  {-# INLINABLE performEvent_ #-}
  performEvent_ :: Event t (Performable (StaticDomBuilderT t m) ())
-> StaticDomBuilderT t m ()
performEvent_ Event t (Performable (StaticDomBuilderT t m) ())
e = m () -> StaticDomBuilderT t m ()
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StaticDomBuilderT t m ())
-> m () -> StaticDomBuilderT t m ()
forall a b. (a -> b) -> a -> b
$ Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_ Event t (Performable m ())
Event t (Performable (StaticDomBuilderT t m) ())
e
  {-# INLINABLE performEvent #-}
  performEvent :: forall a.
Event t (Performable (StaticDomBuilderT t m) a)
-> StaticDomBuilderT t m (Event t a)
performEvent Event t (Performable (StaticDomBuilderT t m) a)
e = m (Event t a) -> StaticDomBuilderT t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> StaticDomBuilderT t m (Event t a))
-> m (Event t a) -> StaticDomBuilderT t m (Event t a)
forall a b. (a -> b) -> a -> b
$ Event t (Performable m a) -> m (Event t a)
forall a. Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent Event t (Performable m a)
Event t (Performable (StaticDomBuilderT t m) a)
e

instance MonadSample t m => MonadSample t (StaticDomBuilderT t m) where
  {-# INLINABLE sample #-}
  sample :: forall a. Behavior t a -> StaticDomBuilderT t m a
sample = m a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StaticDomBuilderT t m a)
-> (Behavior t a -> m a) -> Behavior t a -> StaticDomBuilderT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior t a -> m a
forall a. Behavior t a -> m a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample

instance MonadHold t m => MonadHold t (StaticDomBuilderT t m) where
  {-# INLINABLE hold #-}
  hold :: forall a. a -> Event t a -> StaticDomBuilderT t m (Behavior t a)
hold a
v0 Event t a
v' = m (Behavior t a) -> StaticDomBuilderT t m (Behavior t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Behavior t a) -> StaticDomBuilderT t m (Behavior t a))
-> m (Behavior t a) -> StaticDomBuilderT t m (Behavior t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Behavior t a)
forall a. a -> Event t a -> m (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold a
v0 Event t a
v'
  {-# INLINABLE holdDyn #-}
  holdDyn :: forall a. a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
holdDyn a
v0 Event t a
v' = m (Dynamic t a) -> StaticDomBuilderT t m (Dynamic t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> StaticDomBuilderT t m (Dynamic t a))
-> m (Dynamic t a) -> StaticDomBuilderT t m (Dynamic t a)
forall a b. (a -> b) -> a -> b
$ a -> Event t a -> m (Dynamic t a)
forall a. a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn a
v0 Event t a
v'
  {-# INLINABLE holdIncremental #-}
  holdIncremental :: forall p.
Patch p =>
PatchTarget p
-> Event t p -> StaticDomBuilderT t m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v' = m (Incremental t p) -> StaticDomBuilderT t m (Incremental t p)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Incremental t p) -> StaticDomBuilderT t m (Incremental t p))
-> m (Incremental t p) -> StaticDomBuilderT t m (Incremental t p)
forall a b. (a -> b) -> a -> b
$ PatchTarget p -> Event t p -> m (Incremental t p)
forall p.
Patch p =>
PatchTarget p -> Event t p -> m (Incremental t p)
forall {k} (t :: k) (m :: * -> *) p.
(MonadHold t m, Patch p) =>
PatchTarget p -> Event t p -> m (Incremental t p)
holdIncremental PatchTarget p
v0 Event t p
v'
  {-# INLINABLE buildDynamic #-}
  buildDynamic :: forall a.
PushM t a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
buildDynamic PushM t a
a0 = m (Dynamic t a) -> StaticDomBuilderT t m (Dynamic t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Dynamic t a) -> StaticDomBuilderT t m (Dynamic t a))
-> (Event t a -> m (Dynamic t a))
-> Event t a
-> StaticDomBuilderT t m (Dynamic t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PushM t a -> Event t a -> m (Dynamic t a)
forall a. PushM t a -> Event t a -> m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic PushM t a
a0
  {-# INLINABLE headE #-}
  headE :: forall a. Event t a -> StaticDomBuilderT t m (Event t a)
headE = m (Event t a) -> StaticDomBuilderT t m (Event t a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> StaticDomBuilderT t m (Event t a))
-> (Event t a -> m (Event t a))
-> Event t a
-> StaticDomBuilderT t m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t a -> m (Event t a)
forall a. Event t a -> m (Event t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
Event t a -> m (Event t a)
headE

instance (Monad m, Ref m ~ Ref IO, Reflex t) => TriggerEvent t (StaticDomBuilderT t m) where
  {-# INLINABLE newTriggerEvent #-}
  newTriggerEvent :: forall a. StaticDomBuilderT t m (Event t a, a -> IO ())
newTriggerEvent = (Event t a, a -> IO ())
-> StaticDomBuilderT t m (Event t a, a -> IO ())
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t a
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never, IO () -> a -> IO ()
forall a b. a -> b -> a
const (IO () -> a -> IO ()) -> IO () -> a -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  {-# INLINABLE newTriggerEventWithOnComplete #-}
  newTriggerEventWithOnComplete :: forall a. StaticDomBuilderT t m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = (Event t a, a -> IO () -> IO ())
-> StaticDomBuilderT t m (Event t a, a -> IO () -> IO ())
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event t a
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never, \a
_ IO ()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}
  newEventWithLazyTriggerWithOnComplete :: forall a.
((a -> IO () -> IO ()) -> IO (IO ()))
-> StaticDomBuilderT t m (Event t a)
newEventWithLazyTriggerWithOnComplete (a -> IO () -> IO ()) -> IO (IO ())
_ = Event t a -> StaticDomBuilderT t m (Event t a)
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return Event t a
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never

instance MonadRef m => MonadRef (StaticDomBuilderT t m) where
  type Ref (StaticDomBuilderT t m) = Ref m
  newRef :: forall a.
a -> StaticDomBuilderT t m (Ref (StaticDomBuilderT t m) a)
newRef = m (Ref m a) -> StaticDomBuilderT t m (Ref m a)
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Ref m a) -> StaticDomBuilderT t m (Ref m a))
-> (a -> m (Ref m a)) -> a -> StaticDomBuilderT t m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Ref m a)
forall a. a -> m (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: forall a. Ref (StaticDomBuilderT t m) a -> StaticDomBuilderT t m a
readRef = m a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> StaticDomBuilderT t m a)
-> (Ref m a -> m a) -> Ref m a -> StaticDomBuilderT t m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> m a
forall a. Ref m a -> m a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: forall a.
Ref (StaticDomBuilderT t m) a -> a -> StaticDomBuilderT t m ()
writeRef Ref (StaticDomBuilderT t m) a
r = m () -> StaticDomBuilderT t m ()
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> StaticDomBuilderT t m ())
-> (a -> m ()) -> a -> StaticDomBuilderT t m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> m ()
forall a. Ref m a -> a -> m ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref m a
Ref (StaticDomBuilderT t m) a
r

instance MonadAtomicRef m => MonadAtomicRef (StaticDomBuilderT t m) where
  atomicModifyRef :: forall a b.
Ref (StaticDomBuilderT t m) a
-> (a -> (a, b)) -> StaticDomBuilderT t m b
atomicModifyRef Ref (StaticDomBuilderT t m) a
r = m b -> StaticDomBuilderT t m b
forall (m :: * -> *) a. Monad m => m a -> StaticDomBuilderT t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m b -> StaticDomBuilderT t m b)
-> ((a -> (a, b)) -> m b)
-> (a -> (a, b))
-> StaticDomBuilderT t m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> (a -> (a, b)) -> m b
forall a b. Ref m a -> (a -> (a, b)) -> m b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef Ref m a
Ref (StaticDomBuilderT t m) a
r

type SupportsStaticDomBuilder t m = (Reflex t, MonadIO m, MonadHold t m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO, Adjustable t m)

data StaticDomSpace

-- | Static documents never produce any events, so this type has no inhabitants
data StaticDomEvent (a :: k)

-- | Static documents don't process events, so all handlers are equivalent
data StaticDomHandler (a :: k) (b :: k) = StaticDomHandler

data StaticEventSpec (er :: EventTag -> Type) = StaticEventSpec deriving ((forall x. StaticEventSpec er -> Rep (StaticEventSpec er) x)
-> (forall x. Rep (StaticEventSpec er) x -> StaticEventSpec er)
-> Generic (StaticEventSpec er)
forall x. Rep (StaticEventSpec er) x -> StaticEventSpec er
forall x. StaticEventSpec er -> Rep (StaticEventSpec er) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (er :: EventTag -> *) x.
Rep (StaticEventSpec er) x -> StaticEventSpec er
forall (er :: EventTag -> *) x.
StaticEventSpec er -> Rep (StaticEventSpec er) x
$cfrom :: forall (er :: EventTag -> *) x.
StaticEventSpec er -> Rep (StaticEventSpec er) x
from :: forall x. StaticEventSpec er -> Rep (StaticEventSpec er) x
$cto :: forall (er :: EventTag -> *) x.
Rep (StaticEventSpec er) x -> StaticEventSpec er
to :: forall x. Rep (StaticEventSpec er) x -> StaticEventSpec er
Generic)

instance Default (StaticEventSpec er)

instance DomSpace StaticDomSpace where
  type EventSpec StaticDomSpace = StaticEventSpec
  type RawDocument StaticDomSpace = ()
  type RawTextNode StaticDomSpace = ()
  type RawCommentNode StaticDomSpace = ()
  type RawElement StaticDomSpace = ()
  type RawInputElement StaticDomSpace = ()
  type RawTextAreaElement StaticDomSpace = ()
  type RawSelectElement StaticDomSpace = ()
  addEventSpecFlags :: forall (proxy :: * -> *) (en :: EventTag) (er :: EventTag -> *).
proxy StaticDomSpace
-> EventName en
-> (Maybe (er en) -> EventFlags)
-> EventSpec StaticDomSpace er
-> EventSpec StaticDomSpace er
addEventSpecFlags proxy StaticDomSpace
_ EventName en
_ Maybe (er en) -> EventFlags
_ EventSpec StaticDomSpace er
_ = EventSpec StaticDomSpace er
StaticEventSpec er
forall (er :: EventTag -> *). StaticEventSpec er
StaticEventSpec

instance (SupportsStaticDomBuilder t m, Monad m) => HasDocument (StaticDomBuilderT t m) where
  askDocument :: StaticDomBuilderT
  t m (RawDocument (DomBuilderSpace (StaticDomBuilderT t m)))
askDocument = () -> StaticDomBuilderT t m ()
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m) => Adjustable t (StaticDomBuilderT t m) where
  runWithReplace :: forall a b.
StaticDomBuilderT t m a
-> Event t (StaticDomBuilderT t m b)
-> StaticDomBuilderT t m (a, Event t b)
runWithReplace StaticDomBuilderT t m a
a0 Event t (StaticDomBuilderT t m b)
a' = do
    e <- ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
-> StaticDomBuilderT t m (StaticDomBuilderEnv t)
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
    key <- replaceStart e
    (result0, result') <- lift $ runWithReplace (runStaticDomBuilderT a0 e) (flip runStaticDomBuilderT e <$> a')
    o <- hold (snd result0) $ fmapCheap snd result'
    StaticDomBuilderT $ modify $ (:) $ join o
    replaceEnd key
    return (fst result0, fmapCheap fst result')
  traverseIntMapWithKeyWithAdjust :: forall v v'.
(Int -> v -> StaticDomBuilderT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> StaticDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust = (forall x.
 (Int -> v -> m x)
 -> IntMap v
 -> Event t (PatchIntMap v)
 -> m (IntMap x, Event t (PatchIntMap x)))
-> (Int -> v -> StaticDomBuilderT t m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> StaticDomBuilderT t m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) (p :: * -> *) a b.
(Adjustable t m, MonadHold t m, Patch (p a), Functor p,
 Patch (p (Behavior t Builder)),
 PatchTarget (p (Behavior t Builder)) ~ IntMap (Behavior t Builder),
 Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadRef m) =>
(forall x.
 (Int -> a -> m x)
 -> IntMap a -> Event t (p a) -> m (IntMap x, Event t (p x)))
-> (Int -> a -> StaticDomBuilderT t m b)
-> IntMap a
-> Event t (p a)
-> StaticDomBuilderT t m (IntMap b, Event t (p b))
hoistIntMapWithKeyWithAdjust (Int -> v -> m x)
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap x, Event t (PatchIntMap x))
forall x.
(Int -> v -> m x)
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap x, Event t (PatchIntMap x))
forall v v'.
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Int -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust
  traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> StaticDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust = (forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> m (vv' a))
 -> DMap k vv
 -> Event t (PatchDMap k vv)
 -> m (DMap k vv', Event t (PatchDMap k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv')
-> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> StaticDomBuilderT t m (DMap k v', Event t (PatchDMap k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *) t (m :: * -> *)
       (p :: (* -> *) -> (* -> *) -> *).
(Adjustable t m, MonadHold t m,
 PatchTarget (p k (Constant (Behavior t Builder)))
 ~ DMap k (Constant (Behavior t Builder)),
 Patch (p k (Constant (Behavior t Builder))), Ref m ~ IORef,
 MonadIO m, MonadFix m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadRef m) =>
(forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a) -> p k vv -> p k vv')
-> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (p k v)
-> StaticDomBuilderT t m (DMap k v', Event t (p k v'))
hoistDMapWithKeyWithAdjust (forall a. k a -> vv a -> m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> m (DMap k vv', Event t (PatchDMap k vv'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> m (vv' a))
-> DMap k vv
-> Event t (PatchDMap k vv)
-> m (DMap k vv', Event t (PatchDMap k vv'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust (forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
forall {k1} (v :: k1 -> *) (v' :: k1 -> *) (k2 :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMap k2 v -> PatchDMap k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> PatchDMap k vv -> PatchDMap k vv'
mapPatchDMap
  traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> StaticDomBuilderT
     t m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove = (forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> m (vv' a))
 -> DMap k vv
 -> Event t (PatchDMapWithMove k vv)
 -> m (DMap k vv', Event t (PatchDMapWithMove k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a)
    -> PatchDMapWithMove k vv -> PatchDMapWithMove k vv')
-> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> StaticDomBuilderT
     t m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *) t (m :: * -> *)
       (p :: (* -> *) -> (* -> *) -> *).
(Adjustable t m, MonadHold t m,
 PatchTarget (p k (Constant (Behavior t Builder)))
 ~ DMap k (Constant (Behavior t Builder)),
 Patch (p k (Constant (Behavior t Builder))), Ref m ~ IORef,
 MonadIO m, MonadFix m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadRef m) =>
(forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a) -> p k vv -> p k vv')
-> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (p k v)
-> StaticDomBuilderT t m (DMap k v', Event t (p k v'))
hoistDMapWithKeyWithAdjust (forall a. k a -> vv a -> m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> m (DMap k vv', Event t (PatchDMapWithMove k vv'))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> m (vv' a))
-> DMap k vv
-> Event t (PatchDMapWithMove k vv)
-> m (DMap k vv', Event t (PatchDMapWithMove k vv'))
forall (k :: * -> *) (v :: * -> *) (v' :: * -> *).
GCompare k =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove (forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
forall {k1} (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a)
-> PatchDMapWithMove k vv -> PatchDMapWithMove k vv'
mapPatchDMapWithMove

replaceStart :: (DomBuilder t m, MonadIO m) => StaticDomBuilderEnv t -> m Text
replaceStart :: forall t (m :: * -> *).
(DomBuilder t m, MonadIO m) =>
StaticDomBuilderEnv t -> m Text
replaceStart StaticDomBuilderEnv t
env = do
  str <- Int -> String
forall a. Show a => a -> String
show (Int -> String) -> m Int -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int -> m Int
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref IO Int -> (Int -> (Int, Int)) -> IO Int
forall a b. Ref IO a -> (a -> (a, b)) -> IO b
forall (m :: * -> *) a b.
MonadAtomicRef m =>
Ref m a -> (a -> (a, b)) -> m b
atomicModifyRef (StaticDomBuilderEnv t -> IORef Int
forall {k} (t :: k). StaticDomBuilderEnv t -> IORef Int
_staticDomBuilderEnv_nextRunWithReplaceKey StaticDomBuilderEnv t
env) ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Int
k -> (Int -> Int
forall a. Enum a => a -> a
succ Int
k, Int
k))
  let key = Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
str
  _ <- commentNode $ def { _commentNodeConfig_initialContents = "replace-start" <> key }
  pure key

replaceEnd :: DomBuilder t m => Text -> m ()
replaceEnd :: forall t (m :: * -> *). DomBuilder t m => Text -> m ()
replaceEnd Text
key = m (CommentNode (DomBuilderSpace m) t) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (CommentNode (DomBuilderSpace m) t) -> m ())
-> m (CommentNode (DomBuilderSpace m) t) -> m ()
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
forall t (m :: * -> *).
DomBuilder t m =>
CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
commentNode (CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t))
-> CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t
forall a. Default a => a
def { _commentNodeConfig_initialContents = "replace-end" <> key }

hoistIntMapWithKeyWithAdjust :: forall t m p a b.
  ( Adjustable t m
  , MonadHold t m
  , Patch (p a)
  , Functor p
  , Patch (p (Behavior t Builder))
  , PatchTarget (p (Behavior t Builder)) ~ IntMap (Behavior t Builder)
  , Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m -- TODO remove
  )
  => (forall x. (IntMap.Key -> a -> m x)
      -> IntMap a
      -> Event t (p a)
      -> m (IntMap x, Event t (p x))
     ) -- ^ The base monad's traversal
  -> (IntMap.Key -> a -> StaticDomBuilderT t m b)
  -> IntMap a
  -> Event t (p a)
  -> StaticDomBuilderT t m (IntMap b, Event t (p b))
hoistIntMapWithKeyWithAdjust :: forall t (m :: * -> *) (p :: * -> *) a b.
(Adjustable t m, MonadHold t m, Patch (p a), Functor p,
 Patch (p (Behavior t Builder)),
 PatchTarget (p (Behavior t Builder)) ~ IntMap (Behavior t Builder),
 Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadRef m) =>
(forall x.
 (Int -> a -> m x)
 -> IntMap a -> Event t (p a) -> m (IntMap x, Event t (p x)))
-> (Int -> a -> StaticDomBuilderT t m b)
-> IntMap a
-> Event t (p a)
-> StaticDomBuilderT t m (IntMap b, Event t (p b))
hoistIntMapWithKeyWithAdjust forall x.
(Int -> a -> m x)
-> IntMap a -> Event t (p a) -> m (IntMap x, Event t (p x))
base Int -> a -> StaticDomBuilderT t m b
f IntMap a
im0 Event t (p a)
im' = do
  e <- ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
-> StaticDomBuilderT t m (StaticDomBuilderEnv t)
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  (children0, children') <- lift $ base (\Int
k a
v -> StaticDomBuilderT t m b
-> StaticDomBuilderEnv t -> m (b, Behavior t Builder)
forall {k} (m :: * -> *) (t :: k) a.
(Monad m, Reflex t) =>
StaticDomBuilderT t m a
-> StaticDomBuilderEnv t -> m (a, Behavior t Builder)
runStaticDomBuilderT (Int -> a -> StaticDomBuilderT t m b
f Int
k a
v) StaticDomBuilderEnv t
e) im0 im'
  let result0 = ((b, Behavior t Builder) -> b)
-> IntMap (b, Behavior t Builder) -> IntMap b
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (b, Behavior t Builder) -> b
forall a b. (a, b) -> a
fst IntMap (b, Behavior t Builder)
children0
      result' = ((p (b, Behavior t Builder) -> p b)
-> Event t (p (b, Behavior t Builder)) -> Event t (p b)
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((p (b, Behavior t Builder) -> p b)
 -> Event t (p (b, Behavior t Builder)) -> Event t (p b))
-> (((b, Behavior t Builder) -> b)
    -> p (b, Behavior t Builder) -> p b)
-> ((b, Behavior t Builder) -> b)
-> Event t (p (b, Behavior t Builder))
-> Event t (p b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Behavior t Builder) -> b) -> p (b, Behavior t Builder) -> p b
forall a b. (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (b, Behavior t Builder) -> b
forall a b. (a, b) -> a
fst Event t (p (b, Behavior t Builder))
children'
      outputs0 :: IntMap (Behavior t Builder)
      outputs0 = ((b, Behavior t Builder) -> Behavior t Builder)
-> IntMap (b, Behavior t Builder) -> IntMap (Behavior t Builder)
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map (b, Behavior t Builder) -> Behavior t Builder
forall a b. (a, b) -> b
snd IntMap (b, Behavior t Builder)
children0
      outputs' :: Event t (p (Behavior t Builder))
      outputs' = ((p (b, Behavior t Builder) -> p (Behavior t Builder))
-> Event t (p (b, Behavior t Builder))
-> Event t (p (Behavior t Builder))
forall a b. (a -> b) -> Event t a -> Event t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((p (b, Behavior t Builder) -> p (Behavior t Builder))
 -> Event t (p (b, Behavior t Builder))
 -> Event t (p (Behavior t Builder)))
-> (((b, Behavior t Builder) -> Behavior t Builder)
    -> p (b, Behavior t Builder) -> p (Behavior t Builder))
-> ((b, Behavior t Builder) -> Behavior t Builder)
-> Event t (p (b, Behavior t Builder))
-> Event t (p (Behavior t Builder))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((b, Behavior t Builder) -> Behavior t Builder)
-> p (b, Behavior t Builder) -> p (Behavior t Builder)
forall a b. (a -> b) -> p a -> p b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (b, Behavior t Builder) -> Behavior t Builder
forall a b. (a, b) -> b
snd Event t (p (b, Behavior t Builder))
children'
  outputs <- holdIncremental outputs0 outputs'
  StaticDomBuilderT $ modify $ (:) $ pull $ do
    os <- sample $ currentIncremental outputs
    fmap mconcat $ forM (IntMap.toList os) $ \(Int
_, Behavior t Builder
o) -> do
      Behavior t Builder -> PullM t Builder
forall a. Behavior t a -> PullM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Builder
o
  return (result0, result')

hoistDMapWithKeyWithAdjust :: forall (k :: Type -> Type) v v' t m p.
  ( Adjustable t m
  , MonadHold t m
  , PatchTarget (p k (Constant (Behavior t Builder))) ~ DMap k (Constant (Behavior t Builder))
  , Patch (p k (Constant (Behavior t Builder)))
  , Ref m ~ IORef, MonadIO m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m -- TODO remove
  )
  => (forall vv vv'.
         (forall a. k a -> vv a -> m (vv' a))
      -> DMap k vv
      -> Event t (p k vv)
      -> m (DMap k vv', Event t (p k vv'))
     ) -- ^ The base monad's traversal
  -> (forall vv vv'. (forall a. vv a -> vv' a) -> p k vv -> p k vv') -- ^ A way of mapping over the patch type
  -> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
  -> DMap k v
  -> Event t (p k v)
  -> StaticDomBuilderT t m (DMap k v', Event t (p k v'))
hoistDMapWithKeyWithAdjust :: forall (k :: * -> *) (v :: * -> *) (v' :: * -> *) t (m :: * -> *)
       (p :: (* -> *) -> (* -> *) -> *).
(Adjustable t m, MonadHold t m,
 PatchTarget (p k (Constant (Behavior t Builder)))
 ~ DMap k (Constant (Behavior t Builder)),
 Patch (p k (Constant (Behavior t Builder))), Ref m ~ IORef,
 MonadIO m, MonadFix m, PerformEvent t m,
 MonadReflexCreateTrigger t m, MonadRef m) =>
(forall (vv :: * -> *) (vv' :: * -> *).
 (forall a. k a -> vv a -> m (vv' a))
 -> DMap k vv
 -> Event t (p k vv)
 -> m (DMap k vv', Event t (p k vv')))
-> (forall (vv :: * -> *) (vv' :: * -> *).
    (forall a. vv a -> vv' a) -> p k vv -> p k vv')
-> (forall a. k a -> v a -> StaticDomBuilderT t m (v' a))
-> DMap k v
-> Event t (p k v)
-> StaticDomBuilderT t m (DMap k v', Event t (p k v'))
hoistDMapWithKeyWithAdjust forall (vv :: * -> *) (vv' :: * -> *).
(forall a. k a -> vv a -> m (vv' a))
-> DMap k vv
-> Event t (p k vv)
-> m (DMap k vv', Event t (p k vv'))
base forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> p k vv -> p k vv'
mapPatch forall a. k a -> v a -> StaticDomBuilderT t m (v' a)
f DMap k v
dm0 Event t (p k v)
dm' = do
  e <- ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
-> StaticDomBuilderT t m (StaticDomBuilderEnv t)
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (StaticDomBuilderEnv t)
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
  (children0, children') <- lift $ base (\k a
k v a
v -> ((v' a, Behavior t Builder)
 -> Compose ((,) (Behavior t Builder)) v' a)
-> m (v' a, Behavior t Builder)
-> m (Compose ((,) (Behavior t Builder)) v' a)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Behavior t Builder, v' a)
-> Compose ((,) (Behavior t Builder)) v' a
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((Behavior t Builder, v' a)
 -> Compose ((,) (Behavior t Builder)) v' a)
-> ((v' a, Behavior t Builder) -> (Behavior t Builder, v' a))
-> (v' a, Behavior t Builder)
-> Compose ((,) (Behavior t Builder)) v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v' a, Behavior t Builder) -> (Behavior t Builder, v' a)
forall a b. (a, b) -> (b, a)
swap) (StaticDomBuilderT t m (v' a)
-> StaticDomBuilderEnv t -> m (v' a, Behavior t Builder)
forall {k} (m :: * -> *) (t :: k) a.
(Monad m, Reflex t) =>
StaticDomBuilderT t m a
-> StaticDomBuilderEnv t -> m (a, Behavior t Builder)
runStaticDomBuilderT (k a -> v a -> StaticDomBuilderT t m (v' a)
forall a. k a -> v a -> StaticDomBuilderT t m (v' a)
f k a
k v a
v) StaticDomBuilderEnv t
e)) dm0 dm'
  let result0 = (forall v. Compose ((,) (Behavior t Builder)) v' v -> v' v)
-> DMap k (Compose ((,) (Behavior t Builder)) v') -> DMap k v'
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map ((Behavior t Builder, v' v) -> v' v
forall a b. (a, b) -> b
snd ((Behavior t Builder, v' v) -> v' v)
-> (Compose ((,) (Behavior t Builder)) v' v
    -> (Behavior t Builder, v' v))
-> Compose ((,) (Behavior t Builder)) v' v
-> v' v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose ((,) (Behavior t Builder)) v' v
-> (Behavior t Builder, v' v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose ((,) (Behavior t Builder)) v')
children0
      result' = Event t (p k (Compose ((,) (Behavior t Builder)) v'))
-> (p k (Compose ((,) (Behavior t Builder)) v') -> p k v')
-> Event t (p k v')
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose ((,) (Behavior t Builder)) v'))
children' ((p k (Compose ((,) (Behavior t Builder)) v') -> p k v')
 -> Event t (p k v'))
-> (p k (Compose ((,) (Behavior t Builder)) v') -> p k v')
-> Event t (p k v')
forall a b. (a -> b) -> a -> b
$ (forall v. Compose ((,) (Behavior t Builder)) v' v -> v' v)
-> p k (Compose ((,) (Behavior t Builder)) v') -> p k v'
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> p k vv -> p k vv'
mapPatch ((forall v. Compose ((,) (Behavior t Builder)) v' v -> v' v)
 -> p k (Compose ((,) (Behavior t Builder)) v') -> p k v')
-> (forall v. Compose ((,) (Behavior t Builder)) v' v -> v' v)
-> p k (Compose ((,) (Behavior t Builder)) v')
-> p k v'
forall a b. (a -> b) -> a -> b
$ (Behavior t Builder, v' a) -> v' a
forall a b. (a, b) -> b
snd ((Behavior t Builder, v' a) -> v' a)
-> (Compose ((,) (Behavior t Builder)) v' a
    -> (Behavior t Builder, v' a))
-> Compose ((,) (Behavior t Builder)) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose ((,) (Behavior t Builder)) v' a
-> (Behavior t Builder, v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
      outputs0 :: DMap k (Constant (Behavior t Builder))
      outputs0 = (forall v.
 Compose ((,) (Behavior t Builder)) v' v
 -> Constant (Behavior t Builder) v)
-> DMap k (Compose ((,) (Behavior t Builder)) v')
-> DMap k (Constant (Behavior t Builder))
forall {k1} (f :: k1 -> *) (g :: k1 -> *) (k2 :: k1 -> *).
(forall (v :: k1). f v -> g v) -> DMap k2 f -> DMap k2 g
DMap.map (Behavior t Builder -> Constant (Behavior t Builder) v
forall {k} a (b :: k). a -> Constant a b
Constant (Behavior t Builder -> Constant (Behavior t Builder) v)
-> (Compose ((,) (Behavior t Builder)) v' v -> Behavior t Builder)
-> Compose ((,) (Behavior t Builder)) v' v
-> Constant (Behavior t Builder) v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Behavior t Builder, v' v) -> Behavior t Builder
forall a b. (a, b) -> a
fst ((Behavior t Builder, v' v) -> Behavior t Builder)
-> (Compose ((,) (Behavior t Builder)) v' v
    -> (Behavior t Builder, v' v))
-> Compose ((,) (Behavior t Builder)) v' v
-> Behavior t Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose ((,) (Behavior t Builder)) v' v
-> (Behavior t Builder, v' v)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) DMap k (Compose ((,) (Behavior t Builder)) v')
children0
      outputs' :: Event t (p k (Constant (Behavior t Builder)))
      outputs' = Event t (p k (Compose ((,) (Behavior t Builder)) v'))
-> (p k (Compose ((,) (Behavior t Builder)) v')
    -> p k (Constant (Behavior t Builder)))
-> Event t (p k (Constant (Behavior t Builder)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Event t (p k (Compose ((,) (Behavior t Builder)) v'))
children' ((p k (Compose ((,) (Behavior t Builder)) v')
  -> p k (Constant (Behavior t Builder)))
 -> Event t (p k (Constant (Behavior t Builder))))
-> (p k (Compose ((,) (Behavior t Builder)) v')
    -> p k (Constant (Behavior t Builder)))
-> Event t (p k (Constant (Behavior t Builder)))
forall a b. (a -> b) -> a -> b
$ (forall v.
 Compose ((,) (Behavior t Builder)) v' v
 -> Constant (Behavior t Builder) v)
-> p k (Compose ((,) (Behavior t Builder)) v')
-> p k (Constant (Behavior t Builder))
forall (vv :: * -> *) (vv' :: * -> *).
(forall a. vv a -> vv' a) -> p k vv -> p k vv'
mapPatch ((forall v.
  Compose ((,) (Behavior t Builder)) v' v
  -> Constant (Behavior t Builder) v)
 -> p k (Compose ((,) (Behavior t Builder)) v')
 -> p k (Constant (Behavior t Builder)))
-> (forall v.
    Compose ((,) (Behavior t Builder)) v' v
    -> Constant (Behavior t Builder) v)
-> p k (Compose ((,) (Behavior t Builder)) v')
-> p k (Constant (Behavior t Builder))
forall a b. (a -> b) -> a -> b
$ Behavior t Builder -> Constant (Behavior t Builder) a
forall {k} a (b :: k). a -> Constant a b
Constant (Behavior t Builder -> Constant (Behavior t Builder) a)
-> (Compose ((,) (Behavior t Builder)) v' a -> Behavior t Builder)
-> Compose ((,) (Behavior t Builder)) v' a
-> Constant (Behavior t Builder) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Behavior t Builder, v' a) -> Behavior t Builder
forall a b. (a, b) -> a
fst ((Behavior t Builder, v' a) -> Behavior t Builder)
-> (Compose ((,) (Behavior t Builder)) v' a
    -> (Behavior t Builder, v' a))
-> Compose ((,) (Behavior t Builder)) v' a
-> Behavior t Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose ((,) (Behavior t Builder)) v' a
-> (Behavior t Builder, v' a)
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose
  outputs <- holdIncremental outputs0 outputs'
  StaticDomBuilderT $ modify $ (:) $ pull $ do
    os <- sample $ currentIncremental outputs
    fmap mconcat $ forM (DMap.toList os) $ \(k a
_ :=> Constant Behavior t Builder
o) -> do
      Behavior t Builder -> PullM t Builder
forall a. Behavior t a -> PullM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Builder
o
  return (result0, result')

instance SupportsStaticDomBuilder t m => NotReady t (StaticDomBuilderT t m) where
  notReadyUntil :: forall a. Event t a -> StaticDomBuilderT t m ()
notReadyUntil Event t a
_ = () -> StaticDomBuilderT t m ()
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  notReady :: StaticDomBuilderT t m ()
notReady = () -> StaticDomBuilderT t m ()
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- TODO: the uses of illegal lenses in this instance causes it to be somewhat less efficient than it can be. replacing them with explicit cases to get the underlying Maybe Event and working with those is ideal.
instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where
  type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace
  {-# INLINABLE textNode #-}
  textNode :: TextNodeConfig t
-> StaticDomBuilderT
     t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
textNode (TextNodeConfig Text
initialContents Maybe (Event t Text)
mSetContents) = ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
-> StaticDomBuilderT
     t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT (ReaderT
   (StaticDomBuilderEnv t)
   (StateT [Behavior t Builder] m)
   (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
 -> StaticDomBuilderT
      t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t))
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
-> StaticDomBuilderT
     t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a b. (a -> b) -> a -> b
$ do
    --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
    shouldEscape <- (StaticDomBuilderEnv t -> Bool)
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) Bool
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks StaticDomBuilderEnv t -> Bool
forall {k} (t :: k). StaticDomBuilderEnv t -> Bool
_staticDomBuilderEnv_shouldEscape
    let escape = if Bool
shouldEscape then Text -> Builder
fromHtmlEscapedText else StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Text -> StrictByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
encodeUtf8
    modify . (:) =<< case mSetContents of
      Maybe (Event t Text)
Nothing -> Behavior t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a.
a
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Behavior t Builder
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Builder
escape Text
initialContents))
      Just Event t Text
setContents -> Builder
-> Event t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a.
a
-> Event t a
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold (Text -> Builder
escape Text
initialContents) (Event t Builder
 -> ReaderT
      (StaticDomBuilderEnv t)
      (StateT [Behavior t Builder] m)
      (Behavior t Builder))
-> Event t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a b. (a -> b) -> a -> b
$ (Text -> Builder) -> Event t Text -> Event t Builder
forall {k} (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap Text -> Builder
escape Event t Text
setContents --Only because it doesn't get optimized when profiling is on
    return $ TextNode ()
  {-# INLINABLE commentNode #-}
  commentNode :: CommentNodeConfig t
-> StaticDomBuilderT
     t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
commentNode (CommentNodeConfig Text
initialContents Maybe (Event t Text)
mSetContents) = ReaderT
  (StaticDomBuilderEnv t)
  (StateT [Behavior t Builder] m)
  (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
-> StaticDomBuilderT
     t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall {k} (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT (ReaderT
   (StaticDomBuilderEnv t)
   (StateT [Behavior t Builder] m)
   (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
 -> StaticDomBuilderT
      t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t))
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
-> StaticDomBuilderT
     t m (CommentNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a b. (a -> b) -> a -> b
$ do
    --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5
    shouldEscape <- (StaticDomBuilderEnv t -> Bool)
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) Bool
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks StaticDomBuilderEnv t -> Bool
forall {k} (t :: k). StaticDomBuilderEnv t -> Bool
_staticDomBuilderEnv_shouldEscape
    let escape = if Bool
shouldEscape then Text -> Builder
fromHtmlEscapedText else StrictByteString -> Builder
byteString (StrictByteString -> Builder)
-> (Text -> StrictByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> StrictByteString
encodeUtf8
    (modify . (:)) . (\Behavior t Builder
c -> Behavior t Builder
"<!--" Behavior t Builder -> Behavior t Builder -> Behavior t Builder
forall a. Semigroup a => a -> a -> a
<> Behavior t Builder
c Behavior t Builder -> Behavior t Builder -> Behavior t Builder
forall a. Semigroup a => a -> a -> a
<> Behavior t Builder
"-->") =<< case mSetContents of
      Maybe (Event t Text)
Nothing -> Behavior t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a.
a
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> Behavior t Builder
forall a. a -> Behavior t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Builder
escape Text
initialContents))
      Just Event t Text
setContents -> Builder
-> Event t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a.
a
-> Event t a
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold (Text -> Builder
escape Text
initialContents) (Event t Builder
 -> ReaderT
      (StaticDomBuilderEnv t)
      (StateT [Behavior t Builder] m)
      (Behavior t Builder))
-> Event t Builder
-> ReaderT
     (StaticDomBuilderEnv t)
     (StateT [Behavior t Builder] m)
     (Behavior t Builder)
forall a b. (a -> b) -> a -> b
$ (Text -> Builder) -> Event t Text -> Event t Builder
forall {k} (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap Text -> Builder
escape Event t Text
setContents --Only because it doesn't get optimized when profiling is on
    return $ CommentNode ()
  {-# INLINABLE element #-}
  element :: forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m a
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, a)
element Text
elementTag ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
cfg StaticDomBuilderT t m a
child = do
    -- https://www.w3.org/TR/html-markup/syntax.html#syntax-elements
    let voidElements :: Set Text
voidElements = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"area", Text
"base", Text
"br", Text
"col", Text
"command", Text
"embed", Text
"hr", Text
"img", Text
"input", Text
"keygen", Text
"link", Text
"meta", Text
"param", Text
"source", Text
"track", Text
"wbr"]
    let noEscapeElements :: Set Text
noEscapeElements = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList [Text
"style", Text
"script"]
    let toAttr :: AttributeName -> Text -> Builder
toAttr (AttributeName Maybe Text
_mns Text
k) Text
v = StrictByteString -> Builder
byteString (Text -> StrictByteString
encodeUtf8 Text
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString StrictByteString
"=\"" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromHtmlEscapedText Text
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString StrictByteString
"\""
    es <- (forall a.
 WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (EventSelector t (WrapArg er EventName))
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
forall (k :: * -> *).
GCompare k =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (EventSelector t k)
newFanEventWithTrigger ((forall a.
  WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
 -> StaticDomBuilderT t m (EventSelector t (WrapArg er EventName)))
-> (forall a.
    WrapArg er EventName a -> EventTrigger t a -> IO (IO ()))
-> StaticDomBuilderT t m (EventSelector t (WrapArg er EventName))
forall a b. (a -> b) -> a -> b
$ \WrapArg er EventName a
_ EventTrigger t a
_ -> IO () -> IO (IO ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    StaticDomBuilderT $ do
      let shouldEscape = Text
elementTag Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Text
noEscapeElements
      nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
      (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing nextRunWithReplaceKey
      attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
      selectValue <- asks _staticDomBuilderEnv_selectValue
      let addSelectedAttr Map k a
attrs a
sel = case k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"value" Map k a
attrs of
            Just a
v | a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
sel -> Map k a
attrs Map k a -> Map k a -> Map k a
forall a. Semigroup a => a -> a -> a
<> k -> a -> Map k a
forall k a. k -> a -> Map k a
Map.singleton k
"selected" a
""
            Maybe a
_ -> k -> Map k a -> Map k a
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete k
"selected" Map k a
attrs
      let attrs1 = case (Text
elementTag, Maybe (Behavior t Text)
selectValue) of
            (Text
"option", Just Behavior t Text
sv) -> PullM t (Map AttributeName Text)
-> Behavior t (Map AttributeName Text)
forall a. PullM t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => PullM t a -> Behavior t a
pull (PullM t (Map AttributeName Text)
 -> Behavior t (Map AttributeName Text))
-> PullM t (Map AttributeName Text)
-> Behavior t (Map AttributeName Text)
forall a b. (a -> b) -> a -> b
$ Map AttributeName Text -> Text -> Map AttributeName Text
forall {k} {a}.
(Ord k, IsString k, IsString a, Eq a) =>
Map k a -> a -> Map k a
addSelectedAttr (Map AttributeName Text -> Text -> Map AttributeName Text)
-> PullM t (Map AttributeName Text)
-> PullM t (Text -> Map AttributeName Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t (Map AttributeName Text)
-> PullM t (Map AttributeName Text)
forall a. Behavior t a -> PullM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t (Map AttributeName Text)
-> Behavior t (Map AttributeName Text)
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map AttributeName Text)
attrs0) PullM t (Text -> Map AttributeName Text)
-> PullM t Text -> PullM t (Map AttributeName Text)
forall a b. PullM t (a -> b) -> PullM t a -> PullM t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t Text -> PullM t Text
forall a. Behavior t a -> PullM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t Text
sv
            (Text, Maybe (Behavior t Text))
_ -> Dynamic t (Map AttributeName Text)
-> Behavior t (Map AttributeName Text)
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map AttributeName Text)
attrs0
      let attrs2 = Behavior t (Map AttributeName Text)
-> (Map AttributeName Text -> Builder) -> Behavior t Builder
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Behavior t (Map AttributeName Text)
attrs1 ((Map AttributeName Text -> Builder) -> Behavior t Builder)
-> (Map AttributeName Text -> Builder) -> Behavior t Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map AttributeName Text -> [Builder])
-> Map AttributeName Text
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((AttributeName, Text) -> Builder)
-> [(AttributeName, Text)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(AttributeName
k, Text
v) -> Builder
" " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> AttributeName -> Text -> Builder
toAttr AttributeName
k Text
v) ([(AttributeName, Text)] -> [Builder])
-> (Map AttributeName Text -> [(AttributeName, Text)])
-> Map AttributeName Text
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map AttributeName Text -> [(AttributeName, Text)]
forall k a. Map k a -> [(k, a)]
Map.toList
      let tagBS = Text -> StrictByteString
encodeUtf8 Text
elementTag
      if Set.member elementTag voidElements
        then modify $ (:) $ mconcat [constant ("<" <> byteString tagBS), attrs2, constant (byteString " />")]
        else do
          let open = [Behavior t Builder] -> Behavior t Builder
forall a. Monoid a => [a] -> a
mconcat [Builder -> Behavior t Builder
forall a. a -> Behavior t a
forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant (Builder
"<" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StrictByteString -> Builder
byteString StrictByteString
tagBS), Behavior t Builder
attrs2, Builder -> Behavior t Builder
forall a. a -> Behavior t a
forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant (StrictByteString -> Builder
byteString StrictByteString
">")]
          let close = Builder -> Behavior t Builder
forall a. a -> Behavior t a
forall {k} (t :: k) a. Reflex t => a -> Behavior t a
constant (Builder -> Behavior t Builder) -> Builder -> Behavior t Builder
forall a b. (a -> b) -> a -> b
$ StrictByteString -> Builder
byteString (StrictByteString -> Builder) -> StrictByteString -> Builder
forall a b. (a -> b) -> a -> b
$ StrictByteString
"</" StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
tagBS StrictByteString -> StrictByteString -> StrictByteString
forall a. Semigroup a => a -> a -> a
<> StrictByteString
">"
          modify $ (:) $ mconcat [open, innerHtml, close]
      let e = Element
            { _element_events :: EventSelector t (WrapArg er EventName)
_element_events = EventSelector t (WrapArg er EventName)
es
            , _element_raw :: RawElement StaticDomSpace
_element_raw = ()
            }
      return (e, result)
  {-# INLINABLE inputElement #-}
  inputElement :: forall (er :: EventTag -> *).
InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT
     t m (InputElement er (DomBuilderSpace (StaticDomBuilderT t m)) t)
inputElement InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
cfg = do
    -- Tweak the config to update the "value" and "checked" attributes appropriately.
    -- TODO: warn upon overwriting values.
    let setInitialValue :: Map AttributeName Text -> Map AttributeName Text
setInitialValue = AttributeName
-> Text -> Map AttributeName Text -> Map AttributeName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AttributeName
"value" (InputElementConfig er t StaticDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Text
_inputElementConfig_initialValue InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg)
        setUpdatedValue :: Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
setUpdatedValue Event t (Map AttributeName (Maybe Text))
updatedAttrs = case InputElementConfig er t StaticDomSpace -> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Maybe (Event t Text)
_inputElementConfig_setValue InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg of
          Maybe (Event t Text)
Nothing -> Event t (Map AttributeName (Maybe Text))
updatedAttrs
          Just Event t Text
e -> (AttributeName -> Maybe Text -> Map AttributeName (Maybe Text)
forall k a. k -> a -> Map k a
Map.singleton AttributeName
"value" (Maybe Text -> Map AttributeName (Maybe Text))
-> (Text -> Maybe Text) -> Text -> Map AttributeName (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Map AttributeName (Maybe Text))
-> Event t Text -> Event t (Map AttributeName (Maybe Text))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Event t Text
e) Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall a. Semigroup a => a -> a -> a
<> Event t (Map AttributeName (Maybe Text))
updatedAttrs
        setInitialChecked :: Map AttributeName Text -> Map AttributeName Text
setInitialChecked = case InputElementConfig er t StaticDomSpace -> Bool
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg of
          Bool
True -> AttributeName
-> Text -> Map AttributeName Text -> Map AttributeName Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert AttributeName
"checked" Text
"checked"
          Bool
False -> Map AttributeName Text -> Map AttributeName Text
forall a. a -> a
id
        setUpdatedChecked :: Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
setUpdatedChecked Event t (Map AttributeName (Maybe Text))
updatedAttrs = case InputElementConfig er t StaticDomSpace -> Maybe (Event t Bool)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Maybe (Event t Bool)
_inputElementConfig_setChecked InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg of
          Maybe (Event t Bool)
Nothing -> Event t (Map AttributeName (Maybe Text))
updatedAttrs
          Just Event t Bool
e -> (AttributeName -> Maybe Text -> Map AttributeName (Maybe Text)
forall k a. k -> a -> Map k a
Map.singleton AttributeName
"checked" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"checked") Map AttributeName (Maybe Text)
-> Event t Bool -> Event t (Map AttributeName (Maybe Text))
forall a b. a -> Event t b -> Event t a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Event t Bool
e) Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall a. Semigroup a => a -> a -> a
<> Event t (Map AttributeName (Maybe Text))
updatedAttrs
        adjustedConfig :: ElementConfig er t StaticDomSpace
adjustedConfig = InputElementConfig er t StaticDomSpace
-> ElementConfig er t StaticDomSpace
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> ElementConfig er t s
_inputElementConfig_elementConfig InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg
          ElementConfig er t StaticDomSpace
-> (ElementConfig er t StaticDomSpace
    -> ElementConfig er t StaticDomSpace)
-> ElementConfig er t StaticDomSpace
forall a b. a -> (a -> b) -> b
& (Map AttributeName Text -> Identity (Map AttributeName Text))
-> ElementConfig er t StaticDomSpace
-> Identity (ElementConfig er t StaticDomSpace)
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2)
       (f :: * -> *).
Functor f =>
(Map AttributeName Text -> f (Map AttributeName Text))
-> ElementConfig er t s -> f (ElementConfig er t s)
elementConfig_initialAttributes ((Map AttributeName Text -> Identity (Map AttributeName Text))
 -> ElementConfig er t StaticDomSpace
 -> Identity (ElementConfig er t StaticDomSpace))
-> (Map AttributeName Text -> Map AttributeName Text)
-> ElementConfig er t StaticDomSpace
-> ElementConfig er t StaticDomSpace
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Map AttributeName Text -> Map AttributeName Text
setInitialValue (Map AttributeName Text -> Map AttributeName Text)
-> (Map AttributeName Text -> Map AttributeName Text)
-> Map AttributeName Text
-> Map AttributeName Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map AttributeName Text -> Map AttributeName Text
setInitialChecked
          ElementConfig er t StaticDomSpace
-> (ElementConfig er t StaticDomSpace
    -> ElementConfig er t StaticDomSpace)
-> ElementConfig er t StaticDomSpace
forall a b. a -> (a -> b) -> b
& (Event t (Map AttributeName (Maybe Text))
 -> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig er t StaticDomSpace
-> Identity (ElementConfig er t StaticDomSpace)
forall {k1} {k2} (t :: k1) (er :: EventTag -> *) (m :: k2).
Reflex t =>
Lens'
  (ElementConfig er t m) (Event t (Map AttributeName (Maybe Text)))
Lens'
  (ElementConfig er t StaticDomSpace)
  (Event t (Map AttributeName (Maybe Text)))
elementConfig_modifyAttributes ((Event t (Map AttributeName (Maybe Text))
  -> Identity (Event t (Map AttributeName (Maybe Text))))
 -> ElementConfig er t StaticDomSpace
 -> Identity (ElementConfig er t StaticDomSpace))
-> (Event t (Map AttributeName (Maybe Text))
    -> Event t (Map AttributeName (Maybe Text)))
-> ElementConfig er t StaticDomSpace
-> ElementConfig er t StaticDomSpace
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
setUpdatedValue (Event t (Map AttributeName (Maybe Text))
 -> Event t (Map AttributeName (Maybe Text)))
-> (Event t (Map AttributeName (Maybe Text))
    -> Event t (Map AttributeName (Maybe Text)))
-> Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Map AttributeName (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
setUpdatedChecked
    (e, _result) <- Text
-> ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m ()
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ())
forall t (m :: * -> *) (er :: EventTag -> *) a.
DomBuilder t m =>
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m a
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, a)
element Text
"input" ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
ElementConfig er t StaticDomSpace
adjustedConfig (StaticDomBuilderT t m ()
 -> StaticDomBuilderT
      t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ()))
-> StaticDomBuilderT t m ()
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ())
forall a b. (a -> b) -> a -> b
$ () -> StaticDomBuilderT t m ()
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    v <- case _inputElementConfig_setValue cfg of
      Maybe (Event t Text)
Nothing -> Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text))
-> Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Dynamic t Text
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg InputElementConfig er t StaticDomSpace
-> Getting Text (InputElementConfig er t StaticDomSpace) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (InputElementConfig er t StaticDomSpace) Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2)
       (f :: * -> *).
Functor f =>
(Text -> f Text)
-> InputElementConfig er t s -> f (InputElementConfig er t s)
inputElementConfig_initialValue)
      Just Event t Text
ev -> Text -> Event t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a. a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg InputElementConfig er t StaticDomSpace
-> Getting Text (InputElementConfig er t StaticDomSpace) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (InputElementConfig er t StaticDomSpace) Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2)
       (f :: * -> *).
Functor f =>
(Text -> f Text)
-> InputElementConfig er t s -> f (InputElementConfig er t s)
inputElementConfig_initialValue) Event t Text
ev
    c <- case _inputElementConfig_setChecked cfg of
      Maybe (Event t Bool)
Nothing -> Dynamic t Bool -> StaticDomBuilderT t m (Dynamic t Bool)
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dynamic t Bool -> StaticDomBuilderT t m (Dynamic t Bool))
-> Dynamic t Bool -> StaticDomBuilderT t m (Dynamic t Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Dynamic t Bool
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (Bool -> Dynamic t Bool) -> Bool -> Dynamic t Bool
forall a b. (a -> b) -> a -> b
$ InputElementConfig er t StaticDomSpace -> Bool
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg
      Just Event t Bool
ev -> Bool -> Event t Bool -> StaticDomBuilderT t m (Dynamic t Bool)
forall a. a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (InputElementConfig er t StaticDomSpace -> Bool
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (s :: k2).
InputElementConfig er t s -> Bool
_inputElementConfig_initialChecked InputElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
InputElementConfig er t StaticDomSpace
cfg) Event t Bool
ev
    let hasFocus = Bool -> Dynamic t Bool
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Bool
False -- TODO should this be coming from initialAtttributes
    return $ InputElement
      { _inputElement_value = v
      , _inputElement_checked = c
      , _inputElement_checkedChange = never
      , _inputElement_input = never
      , _inputElement_hasFocus = hasFocus
      , _inputElement_element = e
      , _inputElement_raw = ()
      , _inputElement_files = constDyn mempty
      }
  {-# INLINABLE textAreaElement #-}
  textAreaElement :: forall (er :: EventTag -> *).
TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT
     t
     m
     (TextAreaElement er (DomBuilderSpace (StaticDomBuilderT t m)) t)
textAreaElement TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
cfg = do
    (e, _domElement) <- Text
-> ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m ()
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ())
forall t (m :: * -> *) (er :: EventTag -> *) a.
DomBuilder t m =>
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m a
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, a)
element Text
"textarea" (TextAreaElementConfig er t StaticDomSpace
-> ElementConfig er t StaticDomSpace
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> ElementConfig er t m
_textAreaElementConfig_elementConfig TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
TextAreaElementConfig er t StaticDomSpace
cfg) (StaticDomBuilderT t m ()
 -> StaticDomBuilderT
      t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ()))
-> StaticDomBuilderT t m ()
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t, ())
forall a b. (a -> b) -> a -> b
$ do
      -- Set the initial value
      StaticDomBuilderT t m (TextNode StaticDomSpace t)
-> StaticDomBuilderT t m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StaticDomBuilderT t m (TextNode StaticDomSpace t)
 -> StaticDomBuilderT t m ())
-> StaticDomBuilderT t m (TextNode StaticDomSpace t)
-> StaticDomBuilderT t m ()
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t
-> StaticDomBuilderT
     t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall t (m :: * -> *).
DomBuilder t m =>
TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)
textNode (TextNodeConfig t
 -> StaticDomBuilderT
      t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t))
-> TextNodeConfig t
-> StaticDomBuilderT
     t m (TextNode (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t
forall a. Default a => a
def
        TextNodeConfig t
-> (TextNodeConfig t -> TextNodeConfig t) -> TextNodeConfig t
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> TextNodeConfig t -> Identity (TextNodeConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Text -> f Text) -> TextNodeConfig t -> f (TextNodeConfig t)
textNodeConfig_initialContents ((Text -> Identity Text)
 -> TextNodeConfig t -> Identity (TextNodeConfig t))
-> Text -> TextNodeConfig t -> TextNodeConfig t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TextAreaElementConfig er t StaticDomSpace -> Text
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Text
_textAreaElementConfig_initialValue TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
TextAreaElementConfig er t StaticDomSpace
cfg
        TextNodeConfig t
-> (TextNodeConfig t -> TextNodeConfig t) -> TextNodeConfig t
forall a b. a -> (a -> b) -> b
& (Event t Text -> Identity (Event t Text))
-> TextNodeConfig t -> Identity (TextNodeConfig t)
forall {k} (t :: k).
Reflex t =>
Lens' (TextNodeConfig t) (Event t Text)
Lens' (TextNodeConfig t) (Event t Text)
textNodeConfig_setContents ((Event t Text -> Identity (Event t Text))
 -> TextNodeConfig t -> Identity (TextNodeConfig t))
-> Event t Text -> TextNodeConfig t -> TextNodeConfig t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Event t Text -> Maybe (Event t Text) -> Event t Text
forall a. a -> Maybe a -> a
fromMaybe Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never (TextAreaElementConfig er t StaticDomSpace -> Maybe (Event t Text)
forall {k1} {k2} (er :: EventTag -> *) (t :: k1) (m :: k2).
TextAreaElementConfig er t m -> Maybe (Event t Text)
_textAreaElementConfig_setValue TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
TextAreaElementConfig er t StaticDomSpace
cfg)
    v <- case _textAreaElementConfig_setValue cfg of
      Maybe (Event t Text)
Nothing -> Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a. a -> StaticDomBuilderT t m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text))
-> Dynamic t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a b. (a -> b) -> a -> b
$ Text -> Dynamic t Text
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
TextAreaElementConfig er t StaticDomSpace
cfg TextAreaElementConfig er t StaticDomSpace
-> Getting Text (TextAreaElementConfig er t StaticDomSpace) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TextAreaElementConfig er t StaticDomSpace) Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2)
       (f :: * -> *).
Functor f =>
(Text -> f Text)
-> TextAreaElementConfig er t m -> f (TextAreaElementConfig er t m)
textAreaElementConfig_initialValue)
      Just Event t Text
ev -> Text -> Event t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a. a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (TextAreaElementConfig
  er t (DomBuilderSpace (StaticDomBuilderT t m))
TextAreaElementConfig er t StaticDomSpace
cfg TextAreaElementConfig er t StaticDomSpace
-> Getting Text (TextAreaElementConfig er t StaticDomSpace) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (TextAreaElementConfig er t StaticDomSpace) Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2)
       (f :: * -> *).
Functor f =>
(Text -> f Text)
-> TextAreaElementConfig er t m -> f (TextAreaElementConfig er t m)
textAreaElementConfig_initialValue) Event t Text
ev
    let hasFocus = Bool -> Dynamic t Bool
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Bool
False -- TODO should this be coming from initialAtttributes
    return $ TextAreaElement
      { _textAreaElement_value = v
      , _textAreaElement_input = never
      , _textAreaElement_hasFocus = hasFocus
      , _textAreaElement_element = e
      , _textAreaElement_raw = ()
      }
  selectElement :: forall (er :: EventTag -> *) a.
SelectElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m a
-> StaticDomBuilderT
     t
     m
     (SelectElement er (DomBuilderSpace (StaticDomBuilderT t m)) t, a)
selectElement SelectElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
cfg StaticDomBuilderT t m a
child = do
    v <- Text -> Event t Text -> StaticDomBuilderT t m (Dynamic t Text)
forall a. a -> Event t a -> StaticDomBuilderT t m (Dynamic t a)
forall {k} (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn (SelectElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
SelectElementConfig er t StaticDomSpace
cfg SelectElementConfig er t StaticDomSpace
-> Getting Text (SelectElementConfig er t StaticDomSpace) Text
-> Text
forall s a. s -> Getting a s a -> a
^. Getting Text (SelectElementConfig er t StaticDomSpace) Text
forall (er :: EventTag -> *) k1 (t :: k1) k2 (m :: k2)
       (f :: * -> *).
Functor f =>
(Text -> f Text)
-> SelectElementConfig er t m -> f (SelectElementConfig er t m)
selectElementConfig_initialValue) (SelectElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
SelectElementConfig er t StaticDomSpace
cfg SelectElementConfig er t StaticDomSpace
-> Getting
     (Event t Text)
     (SelectElementConfig er t StaticDomSpace)
     (Event t Text)
-> Event t Text
forall s a. s -> Getting a s a -> a
^. Getting
  (Event t Text)
  (SelectElementConfig er t StaticDomSpace)
  (Event t Text)
forall {k1} {k2} (t :: k1) (er :: EventTag -> *) (m :: k2).
Reflex t =>
Lens' (SelectElementConfig er t m) (Event t Text)
Lens' (SelectElementConfig er t StaticDomSpace) (Event t Text)
selectElementConfig_setValue)
    (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) $ do
      (a, innerHtml) <- StaticDomBuilderT $ do
        nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
        lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False (Just $ current v) nextRunWithReplaceKey
      StaticDomBuilderT $ lift $ modify $ (:) innerHtml
      return a
    let wrapped = SelectElement
          { _selectElement_value :: Dynamic t Text
_selectElement_value = Dynamic t Text
v
          , _selectElement_change :: Event t Text
_selectElement_change = Event t Text
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never
          , _selectElement_hasFocus :: Dynamic t Bool
_selectElement_hasFocus = Bool -> Dynamic t Bool
forall {k} (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Bool
False --TODO: How do we make sure this is correct?
          , _selectElement_element :: Element er StaticDomSpace t
_selectElement_element = Element er StaticDomSpace t
e
          , _selectElement_raw :: RawSelectElement StaticDomSpace
_selectElement_raw = ()
          }
    return (wrapped, result)
  placeRawElement :: RawElement (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT t m ()
placeRawElement () = () -> StaticDomBuilderT t m ()
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  wrapRawElement :: forall (er :: EventTag -> *).
RawElement (DomBuilderSpace (StaticDomBuilderT t m))
-> RawElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t)
wrapRawElement () RawElementConfig er t (DomBuilderSpace (StaticDomBuilderT t m))
_ = Element er (DomBuilderSpace (StaticDomBuilderT t m)) t
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a. a -> StaticDomBuilderT t m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t
 -> StaticDomBuilderT
      t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t))
-> Element er (DomBuilderSpace (StaticDomBuilderT t m)) t
-> StaticDomBuilderT
     t m (Element er (DomBuilderSpace (StaticDomBuilderT t m)) t)
forall a b. (a -> b) -> a -> b
$ EventSelector t (WrapArg er EventName)
-> RawElement (DomBuilderSpace (StaticDomBuilderT t m))
-> Element er (DomBuilderSpace (StaticDomBuilderT t m)) t
forall {k} {k1} (er :: EventTag -> *) (d :: k) (t :: k1).
EventSelector t (WrapArg er EventName)
-> RawElement d -> Element er d t
Element ((forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall {k} (t :: k) (k1 :: * -> *).
(forall a. k1 a -> Event t a) -> EventSelector t k1
EventSelector ((forall a. WrapArg er EventName a -> Event t a)
 -> EventSelector t (WrapArg er EventName))
-> (forall a. WrapArg er EventName a -> Event t a)
-> EventSelector t (WrapArg er EventName)
forall a b. (a -> b) -> a -> b
$ Event t a -> WrapArg er EventName a -> Event t a
forall a b. a -> b -> a
const Event t a
forall a. Event t a
forall {k} (t :: k) a. Reflex t => Event t a
never) ()

--TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better
type StaticWidget x = PostBuildT DomTimeline (StaticDomBuilderT DomTimeline (PerformEventT DomTimeline DomHost))

{-# INLINE renderStatic #-}
renderStatic :: StaticWidget x a -> IO (a, ByteString)
renderStatic :: forall {k} (x :: k) a. StaticWidget x a -> IO (a, StrictByteString)
renderStatic StaticWidget x a
w = do
  DomHost (a, StrictByteString) -> IO (a, StrictByteString)
forall a. DomHost a -> IO a
runDomHost (DomHost (a, StrictByteString) -> IO (a, StrictByteString))
-> DomHost (a, StrictByteString) -> IO (a, StrictByteString)
forall a b. (a -> b) -> a -> b
$ do
    (postBuild, postBuildTriggerRef) <- SpiderHost
  Global
  (Event DomTimeline (), IORef (Maybe (RootTrigger Global ())))
SpiderHost
  Global
  (Event DomTimeline (),
   Ref (SpiderHost Global) (Maybe (EventTrigger DomTimeline ())))
forall t (m :: * -> *) a.
(MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) =>
m (Event t a, Ref m (Maybe (EventTrigger t a)))
newEventWithTriggerRef
    nextRunWithReplaceKey <- newRef 0
    let env0 = Bool
-> Maybe (Behavior DomTimeline Text)
-> IORef Int
-> StaticDomBuilderEnv DomTimeline
forall {k} (t :: k).
Bool
-> Maybe (Behavior t Text) -> IORef Int -> StaticDomBuilderEnv t
StaticDomBuilderEnv Bool
True Maybe (Behavior DomTimeline Text)
forall a. Maybe a
Nothing IORef Int
nextRunWithReplaceKey
    ((res, bs), FireCommand fire) <- hostPerformEventT $ runStaticDomBuilderT (runPostBuildT w postBuild) env0
    mPostBuildTrigger <- readRef postBuildTriggerRef
    forM_ mPostBuildTrigger $ \RootTrigger Global ()
postBuildTrigger -> [DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a.
[DSum (EventTrigger DomTimeline) Identity]
-> ReadPhase (SpiderHost Global) a -> SpiderHost Global [a]
fire [RootTrigger Global ()
postBuildTrigger RootTrigger Global ()
-> Identity () -> DSum (RootTrigger Global) Identity
forall {k} (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> () -> Identity ()
forall a. a -> Identity a
Identity ()] (ReadPhase (SpiderHost Global) () -> SpiderHost Global [()])
-> ReadPhase (SpiderHost Global) () -> SpiderHost Global [()]
forall a b. (a -> b) -> a -> b
$ () -> ReadPhase (SpiderHost Global) ()
forall a. a -> ReadPhase (SpiderHost Global) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    bs' <- sample bs
    return (res, LBS.toStrict $ toLazyByteString bs')