-----------------------------------------------------------------------------
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans       #-}
-----------------------------------------------------------------------------
#ifdef PRODUCTION
#define MISO_JS_PATH "js/miso.prod.js"
#else
#define MISO_JS_PATH "js/miso.js"
#endif
-----------------------------------------------------------------------------
-- |
-- Module      :  Miso.Runtime
-- Copyright   :  (C) 2016-2026 David M. Johnson
-- License     :  BSD3-style (see the file LICENSE)
-- Maintainer  :  David M. Johnson <code@dmj.io>
-- Stability   :  experimental
-- Portability :  non-portable
-----------------------------------------------------------------------------
module Miso.Runtime
  ( -- * Internal functions
    initialize
  , freshComponentId
  , buildVTree
  , renderStyles
  , renderScripts
  , Hydrate(..)
  -- * Subscription
  , startSub
  , stopSub
  -- * Pub / Sub
  , subscribe
  , unsubscribe
  , publish
  , Topic (..)
  , topic
  -- * Component
  , ComponentState (..)
  -- ** Communication
  , mail
  , checkMail
  , broadcast
  , parent
  , mailParent
  , mailChildren
  , mailAncestors
  , mailDescendants
  -- ** WebSocket
  , websocketConnect
  , websocketConnectJSON
  , websocketConnectText
  , websocketConnectArrayBuffer
  , websocketConnectBLOB
  , websocketSend
  , websocketClose
  , socketState
  , emptyWebSocket
  , WebSocket (..)
  , URL
  , SocketState (..)
  , CloseCode (..)
  , Closed (..)
  -- ** EventSource
  , eventSourceConnectText
  , eventSourceConnectJSON
  , eventSourceClose
  , emptyEventSource
  , EventSource (..)
  -- ** Payload
  , Payload (..)
  , json
  , blob
  , arrayBuffer
  -- ** Internal Component state
  , components
  , schedulerThread
  , componentIds
  , rootComponentId
  , componentId
  , modifyComponent
  , componentModel
  -- ** Scheduler
  , scheduler
#ifdef WASM
  , evalFile
#endif
  , topLevelComponentId
  , initComponent
  , withJS
  ) where
-----------------------------------------------------------------------------
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import           Control.Category ((.))
import           Control.Concurrent
import           Control.Exception (SomeException, catch, evaluate)
import           Control.Monad (forM, forM_, when, void, (<=<), zipWithM_, forever, foldM, unless)
import           Control.Monad.Reader (ask, asks)
import           Control.Monad.State hiding (state)
import           Miso.JSON (FromJSON, ToJSON, Result(..), Value, encode, fromJSON, jsonStringify, toJSON)

import           Data.Foldable (foldl')
import           Data.Maybe
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import           Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import           Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef, atomicWriteIORef)
import qualified Data.Sequence as S
import           Data.Sequence (Seq)
import           GHC.Conc (ThreadStatus(ThreadDied, ThreadFinished), threadStatus)
import           Prelude hiding ((.))
import           System.IO.Unsafe (unsafePerformIO)
import           System.Mem.StableName (makeStableName)
import           System.Mem (performMajorGC)
#ifdef BENCH
import           Text.Printf
#endif
import           Unsafe.Coerce (unsafeCoerce)
-----------------------------------------------------------------------------
import           Miso.Binding (Precedence(..))
import           Miso.Concurrent (Waiter(..), waiter)
import           Miso.CSS (renderStyleSheet)
import           Miso.Delegate (delegator)
import qualified Miso.Diff as Diff
import           Miso.DSL
#ifdef WASM
import           Miso.DSL.TH.File (evalFile)
#endif
import           Miso.Effect
  ( ComponentInfo(..), Sub, Sink, Effect, Schedule(..), runEffect
  , io_, withSink, Synchronicity(..)
  )
import qualified Miso.FFI.Internal as FFI
import           Miso.FFI.Internal (Blob(..), ArrayBuffer(..))
import qualified Miso.Hydrate as Hydrate
import           Miso.Lens hiding (view)
import           Miso.String (ToMisoString(..))
import           Miso.Types
import           Miso.Util
-----------------------------------------------------------------------------
-- | Helper function to abstract out initialization of t'Miso.Types.Component' between top-level API functions.
initialize
  :: (Eq parent, Eq model, Eq props)
  => Events
  -> ComponentId
  -> Hydrate
  -> Bool
  -- ^ Is the root node being rendered?
  -> props
  -- ^ Initial props for this component
  -> Maybe Key
  -- ^ Optional key for stable hot-reload model recovery
  -> Component parent props model action
  -> IO DOMRef
  -- ^ Callback function is used for obtaining the t'Miso.Types.Component' 'DOMRef'.
  -> IO (ComponentState parent props model action)
initialize :: forall parent model props action.
(Eq parent, Eq model, Eq props) =>
Events
-> Int
-> Hydrate
-> Bool
-> props
-> Maybe Key
-> Component parent props model action
-> IO DOMRef
-> IO (ComponentState parent props model action)
initialize Events
events Int
_componentParentId Hydrate
hydrate Bool
isRoot props
initialProps Maybe Key
maybeKey comp :: Component parent props model action
comp@Component {model
Bool
[Binding parent model]
[JS]
[CSS]
[Sub action]
Maybe action
Maybe (IO model)
Maybe MisoString
Maybe (props -> props -> action)
LogLevel
props -> model -> View model action
action -> Effect parent props model action
Value -> Maybe action
model :: model
hydrateModel :: Maybe (IO model)
update :: action -> Effect parent props model action
view :: props -> model -> View model action
subs :: [Sub action]
styles :: [CSS]
scripts :: [JS]
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Value -> Maybe action
bindings :: [Binding parent model]
eventPropagation :: Bool
mount :: Maybe action
unmount :: Maybe action
onPropsChanged :: Maybe (props -> props -> action)
onPropsChanged :: forall parent props model action.
Component parent props model action
-> Maybe (props -> props -> action)
unmount :: forall parent props model action.
Component parent props model action -> Maybe action
mount :: forall parent props model action.
Component parent props model action -> Maybe action
eventPropagation :: forall parent props model action.
Component parent props model action -> Bool
bindings :: forall parent props model action.
Component parent props model action -> [Binding parent model]
mailbox :: forall parent props model action.
Component parent props model action -> Value -> Maybe action
logLevel :: forall parent props model action.
Component parent props model action -> LogLevel
mountPoint :: forall parent props model action.
Component parent props model action -> Maybe MisoString
scripts :: forall parent props model action.
Component parent props model action -> [JS]
styles :: forall parent props model action.
Component parent props model action -> [CSS]
subs :: forall parent props model action.
Component parent props model action -> [Sub action]
view :: forall parent props model action.
Component parent props model action
-> props -> model -> View model action
update :: forall parent props model action.
Component parent props model action
-> action -> Effect parent props model action
hydrateModel :: forall parent props model action.
Component parent props model action -> Maybe (IO model)
model :: forall parent props model action.
Component parent props model action -> model
..} IO DOMRef
getComponentMountPoint = do
  _componentId <- IO Int
freshComponentId
  let
    _componentProps = props
initialProps
    _componentSink = \action
action -> do
      IORef (Queue action)
-> (Queue action -> (Queue action, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue action)
forall action. IORef (Queue action)
globalQueue (\Queue action
q -> (Int -> action -> Queue action -> Queue action
forall action. Int -> action -> Queue action -> Queue action
enqueue Int
_componentId action
action Queue action
q, ()))
      Waiter -> IO ()
notify Waiter
globalWaiter

  initializedModel <-
    case (hydrate, hydrateModel) of
      (Hydrate
Hydrate, Just IO model
m) -> IO model
m
      (Hydrate
Draw, Maybe (IO model)
_) -> do
        vcomps <- IORef
  (IntMap
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
        case maybeKey of
          Just Key
k  -> model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (model -> IO model) -> model -> IO model
forall a b. (a -> b) -> a -> b
$ model -> Maybe model -> model
forall a. a -> Maybe a -> a
fromMaybe model
model (Maybe model -> model) -> Maybe model -> model
forall a b. (a -> b) -> a -> b
$ [model] -> Maybe model
forall a. [a] -> Maybe a
listToMaybe
            [ ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
cs ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
-> Lens
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
     model
-> model
forall record field. record -> Lens record field -> field
^. Lens
  (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
  model
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel
            | ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
cs <- IntMap
  (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
-> [ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)]
forall a. IntMap a -> [a]
IM.elems IntMap
  (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
vcomps
            , ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
cs ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
-> Lens
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
     (Maybe Key)
-> Maybe Key
forall record field. record -> Lens record field -> field
^. Lens
  (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
  (Maybe Key)
forall parent props model action.
Lens (ComponentState parent props model action) (Maybe Key)
componentKey Maybe Key -> Maybe Key -> Bool
forall a. Eq a => a -> a -> Bool
== Key -> Maybe Key
forall a. a -> Maybe a
Just Key
k
            ]
          Maybe Key
Nothing -> model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model
      (Hydrate, Maybe (IO model))
_ -> model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model
  _componentScripts <-
    if web
    then
      IM.lookup _componentId <$> readIORef components >>= \case
        Maybe
  (ComponentState
     (ZonkAny 124) (ZonkAny 125) (ZonkAny 126) (ZonkAny 127))
Nothing -> [DOMRef] -> [DOMRef] -> [DOMRef]
forall a. [a] -> [a] -> [a]
(++) ([DOMRef] -> [DOMRef] -> [DOMRef])
-> IO [DOMRef] -> IO ([DOMRef] -> [DOMRef])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JS] -> IO [DOMRef]
renderScripts [JS]
scripts IO ([DOMRef] -> [DOMRef]) -> IO [DOMRef] -> IO [DOMRef]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CSS] -> IO [DOMRef]
renderStyles [CSS]
styles
        Just ComponentState
  (ZonkAny 124) (ZonkAny 125) (ZonkAny 126) (ZonkAny 127)
cs -> [DOMRef] -> IO [DOMRef]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentState
  (ZonkAny 124) (ZonkAny 125) (ZonkAny 126) (ZonkAny 127)
-> [DOMRef]
forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentScripts ComponentState
  (ZonkAny 124) (ZonkAny 125) (ZonkAny 126) (ZonkAny 127)
cs) -- hot reload scenario, reuse already mounted scripts
    else
      pure []

  _componentDOMRef <- getComponentMountPoint
  let _componentIsDirty = Bool
False
  _componentVTree <- newIORef (VTree (Object jsNull))
  _componentSubThreads <- newIORef M.empty

  frame <- newEmptyMVar :: IO (MVar Double)
  let _componentMailbox = Seq a
forall a. Seq a
S.empty

  rAFCallback <-
    asyncCallback1 $ \DOMRef
jsval -> do
      MVar Double -> Double -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar Double
frame (Double -> IO ()) -> IO Double -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DOMRef -> IO Double
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
jsval

  let _componentDraw = \model
newModel -> do
        currentProps <- (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)
-> Lens
     (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
     props
-> props
forall record field. record -> Lens record field -> field
^. Lens
  (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
  props
forall parent props model action.
Lens (ComponentState parent props model action) props
componentProps) (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)
 -> props)
-> (IntMap
      (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
    -> ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
-> IntMap
     (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
-> props
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (IntMap
  (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
-> Int
-> ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)
forall a. IntMap a -> Int -> a
IM.! Int
_componentId) (IntMap
   (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130))
 -> props)
-> IO
     (IntMap
        (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)))
-> IO props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 128) props (ZonkAny 129) (ZonkAny 130)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
        newVTree <-
          buildVTree events _componentParentId _componentId Draw
            _componentSink logLevel (view currentProps newModel)
        oldVTree <- readIORef _componentVTree
        _frame <- requestAnimationFrame rAFCallback
        _timestamp :: Double <- takeMVar frame
        Diff.diff (Just oldVTree) (Just newVTree) _componentDOMRef
        FFI.updateRef oldVTree newVTree
        atomicWriteIORef _componentVTree newVTree
        FFI.flush

  let _componentApplyActions = \(Seq action
actions :: Seq action) model
model_ IntMap (ComponentState p props model a)
comps props
currentProps -> do
        let info :: ComponentInfo parent props
info = Int -> Int -> DOMRef -> props -> ComponentInfo parent props
forall parent props.
Int -> Int -> DOMRef -> props -> ComponentInfo parent props
ComponentInfo Int
_componentId Int
_componentParentId DOMRef
_componentDOMRef props
currentProps
        ((IntMap (ComponentState p props model a), model,
  [Schedule action], ComponentIds)
 -> action
 -> (IntMap (ComponentState p props model a), model,
     [Schedule action], ComponentIds))
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
-> Seq action
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
forall b a. (b -> a -> b) -> b -> Seq a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(IntMap (ComponentState p props model a)
vcomps, model
m, [Schedule action]
ss, ComponentIds
dirtySet) action
a ->
          case Effect parent props model action
-> ComponentInfo parent props
-> model
-> (model, [Schedule action])
forall parent props model action.
Effect parent props model action
-> ComponentInfo parent props
-> model
-> (model, [Schedule action])
runEffect (action -> Effect parent props model action
update action
a) ComponentInfo parent props
forall {parent}. ComponentInfo parent props
info model
m of
            (model
n, [Schedule action]
sss) ->
              let (IntMap (ComponentState p props model a)
newComps, ComponentIds
newDirty)
                    | model -> model -> Bool
forall a. Eq a => a -> a -> Bool
modelCheck model
m model
n =
                        let cs :: ComponentState p props model a
cs = IntMap (ComponentState p props model a)
vcomps IntMap (ComponentState p props model a)
-> Int -> ComponentState p props model a
forall a. IntMap a -> Int -> a
IM.! Int
_componentId
                        in Int
-> IntMap (ComponentState p props model a)
-> (IntMap (ComponentState p props model a), ComponentIds)
forall p props m a.
Int
-> IntMap (ComponentState p props m a)
-> (IntMap (ComponentState p props m a), ComponentIds)
propagate Int
_componentId
                          (Int
-> ComponentState p props model a
-> IntMap (ComponentState p props model a)
-> IntMap (ComponentState p props model a)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
_componentId (ComponentState p props model a
cs { _componentModel = n }) IntMap (ComponentState p props model a)
vcomps)
                    | Bool
otherwise = (IntMap (ComponentState p props model a)
vcomps, ComponentIds
forall a. Monoid a => a
mempty)
              in (IntMap (ComponentState p props model a)
newComps, model
n, [Schedule action]
ss [Schedule action] -> [Schedule action] -> [Schedule action]
forall a. Semigroup a => a -> a -> a
<> [Schedule action]
sss, ComponentIds
dirtySet ComponentIds -> ComponentIds -> ComponentIds
forall a. Semigroup a => a -> a -> a
<> ComponentIds
newDirty)
          ) (IntMap (ComponentState p props model a)
comps, model
model_, [], ComponentIds
forall a. Monoid a => a
mempty) Seq action
actions

  let vcomponent = ComponentState
        { _componentEvents :: Events
_componentEvents = Events
events
        , _componentKey :: Maybe Key
_componentKey = Maybe Key
maybeKey
        , _componentMailbox :: Value -> Maybe action
_componentMailbox = Value -> Maybe action
mailbox
        , _componentBindings :: [Binding parent model]
_componentBindings = [Binding parent model]
bindings
        , _componentTopics :: Map MisoString (Value -> IO ())
_componentTopics = Map MisoString (Value -> IO ())
forall a. Monoid a => a
mempty
        , _componentModelDirty :: model -> model -> Bool
_componentModelDirty = model -> model -> Bool
forall a. Eq a => a -> a -> Bool
modelCheck
        , _componentChildren :: ComponentIds
_componentChildren = ComponentIds
forall a. Monoid a => a
mempty
        , _componentModel :: model
_componentModel = model
initializedModel
        , _prevComponentProps :: props
_prevComponentProps = props
_componentProps
        , _componentPropsPhase :: props -> props -> IO ()
_componentPropsPhase = \props
oldProps props
newProps ->
            case Maybe (props -> props -> action)
onPropsChanged of
              Just props -> props -> action
f -> Sink action
forall {action}. action -> IO ()
_componentSink (props -> props -> action
f props
oldProps props
newProps)
              Maybe (props -> props -> action)
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        , props
Bool
Int
[DOMRef]
IORef (Map MisoString ThreadId)
IORef VTree
DOMRef
model -> IO ()
Sink action
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
forall {action}. action -> IO ()
forall {p} {props} {a}.
Seq action
-> model
-> IntMap (ComponentState p props model a)
-> props
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
_componentParentId :: Int
_componentId :: Int
_componentProps :: props
_componentSink :: forall {action}. action -> IO ()
_componentScripts :: [DOMRef]
_componentScripts :: [DOMRef]
_componentDOMRef :: DOMRef
_componentIsDirty :: Bool
_componentVTree :: IORef VTree
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDraw :: model -> IO ()
_componentApplyActions :: forall {p} {props} {a}.
Seq action
-> model
-> IntMap (ComponentState p props model a)
-> props
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: DOMRef
_componentDraw :: model -> IO ()
_componentId :: Int
_componentIsDirty :: Bool
_componentParentId :: Int
_componentProps :: props
_componentSink :: Sink action
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentVTree :: IORef VTree
..
        }

  when isRoot (delegator _componentDOMRef _componentVTree events (logLevel `elem` [DebugEvents, DebugAll]))
  registerComponent vcomponent

  -- Inherit bindings state (if applicable)
  _componentModel <- inheritParentBindings _componentParentId initializedModel bindings
  modifyComponent _componentId (componentModel .= _componentModel)

  initSubs subs _componentSubThreads _componentSink
  initialDraw _componentModel events hydrate isRoot comp vcomponent
  forM_ mount _componentSink
  when bts (FFI.mountComponent _componentId =<< toObject jsNull)
  pure vcomponent
-----------------------------------------------------------------------------
inheritParentBindings
  :: ComponentId
  -- ^ ParentId
  -> child
  -- ^ Child model
  -> [ Binding parent child ]
  -> IO child
inheritParentBindings :: forall child parent.
Int -> child -> [Binding parent child] -> IO child
inheritParentBindings Int
compParentId child
childModel [Binding parent child]
bindings = do
  Int -> child -> [Binding parent child] -> IO ()
forall child parent.
Int -> child -> [Binding parent child] -> IO ()
inheritChildBindings Int
compParentId child
childModel [Binding parent child]
bindings
  (child -> Binding parent child -> IO child)
-> child -> [Binding parent child] -> IO child
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\child
m -> \case
            ParentToChild parent -> field
getParentField field -> child -> child
setChildField -> do
              ComponentState {..} <- (IntMap
  (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101))
-> Int
-> ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101)
forall a. IntMap a -> Int -> a
IM.! Int
compParentId) (IntMap
   (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101))
 -> ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101))
-> IO
     (IntMap
        (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101)))
-> IO
     (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 99) (ZonkAny 100) parent (ZonkAny 101)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
              pure (setChildField (getParentField _componentModel) m)
            Bidirectional Precedence
Parent parent -> field
getParentField field -> parent -> parent
_ child -> field
_ field -> child -> child
setChildField -> do
              ComponentState {..} <- (IntMap
  (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104))
-> Int
-> ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104)
forall a. IntMap a -> Int -> a
IM.! Int
compParentId) (IntMap
   (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104))
 -> ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104))
-> IO
     (IntMap
        (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104)))
-> IO
     (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 102) (ZonkAny 103) parent (ZonkAny 104)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
              pure (setChildField (getParentField _componentModel) m)
            Binding parent child
_ -> child -> IO child
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure child
m
        ) child
childModel [Binding parent child]
bindings
-----------------------------------------------------------------------------
inheritChildBindings
  :: ComponentId
  -- ^ ParentId
  -> child
  -- ^ Child component
  -> [ Binding parent child ]
  -> IO ()
inheritChildBindings :: forall child parent.
Int -> child -> [Binding parent child] -> IO ()
inheritChildBindings Int
compParentId child
childState [Binding parent child]
bindings = do
  [Binding parent child] -> (Binding parent child -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Binding parent child]
bindings ((Binding parent child -> IO ()) -> IO ())
-> (Binding parent child -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
     ChildToParent field -> parent -> parent
setParentField child -> field
getChildField -> do
       Int
-> State
     (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
compParentId (State
   (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) ()
 -> IO ())
-> State
     (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
         Lens
  (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95))
  parent
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens
  (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95))
  parent
-> (parent -> parent)
-> State
     (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> parent -> parent
setParentField (child -> field
getChildField child
childState)
         Lens
  (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens
  (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) Bool
-> Bool
-> State
     (ComponentState (ZonkAny 93) (ZonkAny 94) parent (ZonkAny 95)) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Bool
True
     Bidirectional Precedence
Child parent -> field
_ field -> parent -> parent
setParentField child -> field
getChildField field -> child -> child
_ -> do
       Int
-> State
     (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
compParentId (State
   (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) ()
 -> IO ())
-> State
     (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
         Lens
  (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98))
  parent
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens
  (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98))
  parent
-> (parent -> parent)
-> State
     (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> parent -> parent
setParentField (child -> field
getChildField child
childState)
         Lens
  (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens
  (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) Bool
-> Bool
-> State
     (ComponentState (ZonkAny 96) (ZonkAny 97) parent (ZonkAny 98)) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Bool
True
     Binding parent child
_ -> do
       () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
-----------------------------------------------------------------------------
initSubs :: [Sub action] -> IORef (Map MisoString ThreadId) -> Sink action -> IO ()
initSubs :: forall action.
[Sub action] -> IORef (Map MisoString ThreadId) -> Sub action
initSubs [Sub action]
subs_ IORef (Map MisoString ThreadId)
_componentSubThreads Sink action
_componentSink = do
  [Sub action] -> (Sub action -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Sub action]
subs_ ((Sub action -> IO ()) -> IO ()) -> (Sub action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Sub action
sub_ -> do
    threadId <- IO () -> IO ThreadId
forkIO (Sub action
sub_ Sink action
_componentSink)
    subKey <- freshSubId
    atomicModifyIORef' _componentSubThreads $ \Map MisoString ThreadId
m ->
      (MisoString
-> ThreadId -> Map MisoString ThreadId -> Map MisoString ThreadId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert MisoString
subKey ThreadId
threadId Map MisoString ThreadId
m, ())
-----------------------------------------------------------------------------
-- | Diffs two models, returning True if a redraw is necessary
modelCheck :: Eq model => model -> model -> Bool
modelCheck :: forall a. Eq a => a -> a -> Bool
modelCheck model
c model
n = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO (IO Bool -> Bool) -> IO Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
  currentName <- model
c model -> IO (StableName model) -> IO (StableName model)
forall a b. a -> b -> b
`seq` model -> IO (StableName model)
forall a. a -> IO (StableName a)
makeStableName model
c
  updatedName <- n `seq` makeStableName n
  pure (currentName /= updatedName && c /= n)
-----------------------------------------------------------------------------
-- | Checks if the Component is mounted before executing actions
isMounted :: ComponentId -> IO Bool
isMounted :: Int -> IO Bool
isMounted Int
vcompId = Maybe
  (ComponentState
     (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
-> Bool
forall a. Maybe a -> Bool
isJust (Maybe
   (ComponentState
      (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
 -> Bool)
-> (IntMap
      (ComponentState
         (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
    -> Maybe
         (ComponentState
            (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81)))
-> IntMap
     (ComponentState
        (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int
-> IntMap
     (ComponentState
        (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
-> Maybe
     (ComponentState
        (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81))
 -> Bool)
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81)))
-> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 78) (ZonkAny 79) (ZonkAny 80) (ZonkAny 81)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
-----------------------------------------------------------------------------
-- | The scheduler processes all events in the system and is responsible
-- for propagating changes across model states both asynchronously
-- and synchronously (via 'Binding'). It also is responsible for
-- top-down rendering of the UI Component tree.
scheduler :: IO ()
scheduler :: IO ()
scheduler =
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IO (Maybe (Int, Seq (ZonkAny 88)))
forall action. IO (Maybe (Int, Seq action))
getBatch IO (Maybe (Int, Seq (ZonkAny 88)))
-> (Maybe (Int, Seq (ZonkAny 88)) -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (Int, Seq (ZonkAny 88))
Nothing -> Waiter -> IO ()
wait Waiter
globalWaiter
      Just (Int
vcompId, Seq (ZonkAny 88)
S.Empty)
        | Int
vcompId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> do
            -- props propagation, negated 'ComponentId' indicates render-phase only.
            vcomps <- IORef
  (IntMap
     (ComponentState
        (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
            forM_ (IM.lookup (negate vcompId) vcomps) $ \ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 89) (ZonkAny 91)]
Maybe Key
ZonkAny 90
ZonkAny 91
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 90 -> ZonkAny 90 -> IO ()
ZonkAny 91 -> IO ()
ZonkAny 91 -> ZonkAny 91 -> Bool
ZonkAny 92 -> IO ()
Seq (ZonkAny 92)
-> ZonkAny 91
-> IntMap
     (ComponentState
        (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92))
-> ZonkAny 90
-> (IntMap
      (ComponentState
         (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)),
    ZonkAny 91, [Schedule (ZonkAny 92)], ComponentIds)
Value -> Maybe (ZonkAny 92)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 90
_prevComponentProps :: ZonkAny 90
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 92 -> IO ()
_componentModel :: ZonkAny 91
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 89) (ZonkAny 91)]
_componentMailbox :: Value -> Maybe (ZonkAny 92)
_componentDraw :: ZonkAny 91 -> IO ()
_componentPropsPhase :: ZonkAny 90 -> ZonkAny 90 -> IO ()
_componentModelDirty :: ZonkAny 91 -> ZonkAny 91 -> Bool
_componentApplyActions :: Seq (ZonkAny 92)
-> ZonkAny 91
-> IntMap
     (ComponentState
        (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92))
-> ZonkAny 90
-> (IntMap
      (ComponentState
         (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)),
    ZonkAny 91, [Schedule (ZonkAny 92)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
              ZonkAny 91 -> IO ()
_componentDraw ZonkAny 91
_componentModel
              ZonkAny 90 -> ZonkAny 90 -> IO ()
_componentPropsPhase ZonkAny 90
_prevComponentProps ZonkAny 90
_componentProps

      Just (Int
vcompId, Seq (ZonkAny 88)
actions) -> do
        mounted <- Int -> IO Bool
isMounted Int
vcompId
        when mounted (run vcompId actions)
  where
    -----------------------------------------------------------------------------
    -- | Execute the commit phase against the model, perform top-down render
    -- of the entire Component tree.
    run :: ComponentId -> Seq action -> IO ()
    run :: forall action. Int -> Seq action -> IO ()
run Int
vcompId = ComponentIds -> IO ()
renderComponents (ComponentIds -> IO ())
-> (Seq action -> IO ComponentIds) -> Seq action -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> Seq action -> IO ComponentIds
forall action. Int -> Seq action -> IO ComponentIds
commit Int
vcompId
    -----------------------------------------------------------------------------
    -- | Apply the actions across the model, evaluate async and sync IO.
    commit :: ComponentId -> Seq action -> IO ComponentIds
    commit :: forall action. Int -> Seq action -> IO ComponentIds
commit Int
vcompId Seq action
events = do
      (updatedModel, schedules, dirtySet, ComponentState{..}) <- do
        IORef
  (IntMap
     (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action))
-> (IntMap
      (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
    -> (IntMap
          (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
        (ZonkAny 84, [Schedule action], ComponentIds,
         ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)))
-> IO
     (ZonkAny 84, [Schedule action], ComponentIds,
      ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef
  (IntMap
     (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap
    (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
  -> (IntMap
        (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
      (ZonkAny 84, [Schedule action], ComponentIds,
       ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)))
 -> IO
      (ZonkAny 84, [Schedule action], ComponentIds,
       ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action))
-> (IntMap
      (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
    -> (IntMap
          (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
        (ZonkAny 84, [Schedule action], ComponentIds,
         ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)))
-> IO
     (ZonkAny 84, [Schedule action], ComponentIds,
      ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
forall a b. (a -> b) -> a -> b
$ \IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
vcomps -> do
          let cs :: ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action
cs@ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 86) (ZonkAny 84)]
Maybe Key
ZonkAny 84
ZonkAny 87
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
ZonkAny 84 -> IO ()
ZonkAny 84 -> ZonkAny 84 -> Bool
ZonkAny 87 -> ZonkAny 87 -> IO ()
Seq action
-> ZonkAny 84
-> IntMap
     (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
-> ZonkAny 87
-> (IntMap
      (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
    ZonkAny 84, [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 87
_prevComponentProps :: ZonkAny 87
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: ZonkAny 84
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 86) (ZonkAny 84)]
_componentMailbox :: Value -> Maybe action
_componentDraw :: ZonkAny 84 -> IO ()
_componentPropsPhase :: ZonkAny 87 -> ZonkAny 87 -> IO ()
_componentModelDirty :: ZonkAny 84 -> ZonkAny 84 -> Bool
_componentApplyActions :: Seq action
-> ZonkAny 84
-> IntMap
     (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
-> ZonkAny 87
-> (IntMap
      (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
    ZonkAny 84, [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
vcomps IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
-> Int
-> ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action
forall a. IntMap a -> Int -> a
IM.! Int
vcompId
          case Seq action
-> ZonkAny 84
-> IntMap
     (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
-> ZonkAny 87
-> (IntMap
      (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action),
    ZonkAny 84, [Schedule action], ComponentIds)
_componentApplyActions Seq action
events ZonkAny 84
_componentModel IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
vcomps ZonkAny 87
_componentProps of
            (IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
x, ZonkAny 84
updatedModel, [Schedule action]
schedules, ComponentIds
dirtySet) ->
              (IntMap
  (ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action)
x, (ZonkAny 84
updatedModel, [Schedule action]
schedules, ComponentIds
dirtySet, ComponentState (ZonkAny 86) (ZonkAny 87) (ZonkAny 84) action
cs))
      forM_ schedules $ \case
        Schedule Synchronicity
Async (action -> IO ()) -> IO ()
action ->
          Synchronicity -> IO () -> IO ()
evalScheduled Synchronicity
Async ((action -> IO ()) -> IO ()
action action -> IO ()
_componentSink)
        Schedule Synchronicity
Sync (action -> IO ()) -> IO ()
action ->
          Synchronicity -> IO () -> IO ()
evalScheduled Synchronicity
Sync ((action -> IO ()) -> IO ()
action action -> IO ()
_componentSink)
      if _componentModelDirty _componentModel updatedModel
        then do
          modifyComponent _componentId $ do
            isDirty .= True
            componentModel .= updatedModel
          pure dirtySet
        else
          pure mempty
-----------------------------------------------------------------------------
-- | Perform a top-down rendering of the 'Component' tree.
--
-- We lookup the components each time to account for unmounting.
-- Reset the dirty bit if a render occurs
--
renderComponents :: ComponentIds -> IO ()
renderComponents :: ComponentIds -> IO ()
renderComponents ComponentIds
dirtySet =
  (Int -> IO () -> IO ()) -> IO () -> ComponentIds -> IO ()
forall b. (Int -> b -> b) -> b -> ComponentIds -> b
IS.foldr (\Int
vcompId IO ()
acc -> Int -> IO ()
renderOne Int
vcompId IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
acc) (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) ComponentIds
dirtySet
  where
    renderOne :: Int -> IO ()
renderOne Int
vcompId =
      Int
-> IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
-> Maybe
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
 -> Maybe
      (ComponentState
         (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO
  (Maybe
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
-> (Maybe
      (ComponentState
         (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ComponentState (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)
 -> IO ())
-> Maybe
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 74) (ZonkAny 76)]
Maybe Key
ZonkAny 75
ZonkAny 76
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 75 -> ZonkAny 75 -> IO ()
ZonkAny 76 -> IO ()
ZonkAny 76 -> ZonkAny 76 -> Bool
ZonkAny 77 -> IO ()
Seq (ZonkAny 77)
-> ZonkAny 76
-> IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
-> ZonkAny 75
-> (IntMap
      (ComponentState
         (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)),
    ZonkAny 76, [Schedule (ZonkAny 77)], ComponentIds)
Value -> Maybe (ZonkAny 77)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 75
_prevComponentProps :: ZonkAny 75
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 77 -> IO ()
_componentModel :: ZonkAny 76
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 74) (ZonkAny 76)]
_componentMailbox :: Value -> Maybe (ZonkAny 77)
_componentDraw :: ZonkAny 76 -> IO ()
_componentPropsPhase :: ZonkAny 75 -> ZonkAny 75 -> IO ()
_componentModelDirty :: ZonkAny 76 -> ZonkAny 76 -> Bool
_componentApplyActions :: Seq (ZonkAny 77)
-> ZonkAny 76
-> IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77))
-> ZonkAny 75
-> (IntMap
      (ComponentState
         (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)),
    ZonkAny 76, [Schedule (ZonkAny 77)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
_componentIsDirty (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          ZonkAny 76 -> IO ()
_componentDraw ZonkAny 76
_componentModel
          Int -> Object -> IO ()
FFI.modelHydration Int
_componentId (Object -> IO ()) -> IO Object -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DOMRef -> IO Object
forall a. ToObject a => a -> IO Object
toObject DOMRef
jsNull
        Int
-> State
     (ComponentState
        (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
     ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentId (Lens
  (ComponentState
     (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
  Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens
  (ComponentState
     (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
  Bool
-> Bool
-> State
     (ComponentState
        (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
     ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Bool
False)
-----------------------------------------------------------------------------
-- | Modify a single t'Component p m a' at a t'ComponentId'.
--
-- Auxiliary function
modifyComponent
  :: ComponentId
  -> State (ComponentState parent props model action) a
  -> IO ()
modifyComponent :: forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
vcompId State (ComponentState parent props model action) a
go =
  IORef (IntMap (ComponentState parent props model action))
-> (IntMap (ComponentState parent props model action)
    -> (IntMap (ComponentState parent props model action), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState parent props model action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap (ComponentState parent props model action)
  -> (IntMap (ComponentState parent props model action), ()))
 -> IO ())
-> (IntMap (ComponentState parent props model action)
    -> (IntMap (ComponentState parent props model action), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState parent props model action)
vcomps ->
    ((ComponentState parent props model action
 -> ComponentState parent props model action)
-> Int
-> IntMap (ComponentState parent props model action)
-> IntMap (ComponentState parent props model action)
forall a. (a -> a) -> Int -> IntMap a -> IntMap a
IM.adjust (State (ComponentState parent props model action) a
-> ComponentState parent props model action
-> ComponentState parent props model action
forall s a. State s a -> s -> s
execState State (ComponentState parent props model action) a
go) Int
vcompId IntMap (ComponentState parent props model action)
vcomps, ())
----------------------------------------------------------------------------
propagate
  :: ComponentId
  -> IntMap (ComponentState p props m a)
  -> (IntMap (ComponentState p props m a), ComponentIds)
propagate :: forall p props m a.
Int
-> IntMap (ComponentState p props m a)
-> (IntMap (ComponentState p props m a), ComponentIds)
propagate Int
vcompId IntMap (ComponentState p props m a)
vcomps =
  let dfsState :: DFS p props m a
dfsState = State (DFS p props m a) () -> DFS p props m a -> DFS p props m a
forall s a. State s a -> s -> s
execState State (DFS p props m a) ()
forall p props m a. Synch p props m a ()
synch (IntMap (ComponentState p props m a) -> Int -> DFS p props m a
forall p props m a.
IntMap (ComponentState p props m a) -> Int -> DFS p props m a
dfs IntMap (ComponentState p props m a)
vcomps Int
vcompId)
  in (DFS p props m a -> IntMap (ComponentState p props m a)
forall p props m a.
DFS p props m a -> IntMap (ComponentState p props m a)
_state DFS p props m a
dfsState, DFS p props m a -> ComponentIds
forall p props m a. DFS p props m a -> ComponentIds
_visited DFS p props m a
dfsState)
-----------------------------------------------------------------------------
-- | Create an empty DFS state
dfs :: IntMap (ComponentState p props m a) -> ComponentId -> DFS p props m a
dfs :: forall p props m a.
IntMap (ComponentState p props m a) -> Int -> DFS p props m a
dfs IntMap (ComponentState p props m a)
cs Int
vcompId = IntMap (ComponentState p props m a)
-> ComponentIds -> [Int] -> DFS p props m a
forall p props m a.
IntMap (ComponentState p props m a)
-> ComponentIds -> [Int] -> DFS p props m a
DFS IntMap (ComponentState p props m a)
cs ComponentIds
forall a. Monoid a => a
mempty (Int -> [Int]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
vcompId)
-----------------------------------------------------------------------------
type ComponentIds = IntSet
-----------------------------------------------------------------------------
data DFS p props m a
  = DFS
  { forall p props m a.
DFS p props m a -> IntMap (ComponentState p props m a)
_state :: IntMap (ComponentState p props m a)
    -- ^ global component state to alter
  , forall p props m a. DFS p props m a -> ComponentIds
_visited :: ComponentIds
    -- ^ visited set
  , forall p props m a. DFS p props m a -> [Int]
_stack :: [ComponentId]
    -- ^ neighbors queue
  }
-----------------------------------------------------------------------------
type Synch p props m a x = State (DFS p props m a) x
-----------------------------------------------------------------------------
visited :: Lens (DFS p props m a) ComponentIds
visited :: forall p props m a. Lens (DFS p props m a) ComponentIds
visited = (DFS p props m a -> ComponentIds)
-> (DFS p props m a -> ComponentIds -> DFS p props m a)
-> Lens (DFS p props m a) ComponentIds
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens DFS p props m a -> ComponentIds
forall p props m a. DFS p props m a -> ComponentIds
_visited ((DFS p props m a -> ComponentIds -> DFS p props m a)
 -> Lens (DFS p props m a) ComponentIds)
-> (DFS p props m a -> ComponentIds -> DFS p props m a)
-> Lens (DFS p props m a) ComponentIds
forall a b. (a -> b) -> a -> b
$ \DFS p props m a
r ComponentIds
x -> DFS p props m a
r { _visited = x }
-----------------------------------------------------------------------------
state :: Lens (DFS p props m a) (IntMap (ComponentState p props m a))
state :: forall p props m a.
Lens (DFS p props m a) (IntMap (ComponentState p props m a))
state = (DFS p props m a -> IntMap (ComponentState p props m a))
-> (DFS p props m a
    -> IntMap (ComponentState p props m a) -> DFS p props m a)
-> Lens (DFS p props m a) (IntMap (ComponentState p props m a))
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens DFS p props m a -> IntMap (ComponentState p props m a)
forall p props m a.
DFS p props m a -> IntMap (ComponentState p props m a)
_state ((DFS p props m a
  -> IntMap (ComponentState p props m a) -> DFS p props m a)
 -> Lens (DFS p props m a) (IntMap (ComponentState p props m a)))
-> (DFS p props m a
    -> IntMap (ComponentState p props m a) -> DFS p props m a)
-> Lens (DFS p props m a) (IntMap (ComponentState p props m a))
forall a b. (a -> b) -> a -> b
$ \DFS p props m a
r IntMap (ComponentState p props m a)
x -> DFS p props m a
r { _state = x }
-----------------------------------------------------------------------------
stack :: Lens (DFS p props m a) [ComponentId]
stack :: forall p props m a. Lens (DFS p props m a) [Int]
stack = (DFS p props m a -> [Int])
-> (DFS p props m a -> [Int] -> DFS p props m a)
-> Lens (DFS p props m a) [Int]
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens DFS p props m a -> [Int]
forall p props m a. DFS p props m a -> [Int]
_stack ((DFS p props m a -> [Int] -> DFS p props m a)
 -> Lens (DFS p props m a) [Int])
-> (DFS p props m a -> [Int] -> DFS p props m a)
-> Lens (DFS p props m a) [Int]
forall a b. (a -> b) -> a -> b
$ \DFS p props m a
r [Int]
x -> DFS p props m a
r { _stack = x }
-----------------------------------------------------------------------------
synch :: Synch p props m a ()
synch :: forall p props m a. Synch p props m a ()
synch = (ComponentState p props m a
 -> StateT (DFS p props m a) Identity ())
-> Maybe (ComponentState p props m a)
-> StateT (DFS p props m a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComponentState p props m a -> StateT (DFS p props m a) Identity ()
forall p props m a.
ComponentState p props m a -> Synch p props m a ()
go (Maybe (ComponentState p props m a)
 -> StateT (DFS p props m a) Identity ())
-> StateT
     (DFS p props m a) Identity (Maybe (ComponentState p props m a))
-> StateT (DFS p props m a) Identity ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateT
  (DFS p props m a) Identity (Maybe (ComponentState p props m a))
forall p props m a.
Synch p props m a (Maybe (ComponentState p props m a))
pop
  where
    go :: ComponentState p props m a -> Synch p props m a ()
    go :: forall p props m a.
ComponentState p props m a -> Synch p props m a ()
go ComponentState p props m a
cs = do
      seen <- Int -> ComponentIds -> Bool
IS.member (ComponentState p props m a
cs ComponentState p props m a
-> Lens (ComponentState p props m a) Int -> Int
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) Int
forall parent props model action.
Lens (ComponentState parent props model action) Int
componentId) (ComponentIds -> Bool)
-> StateT (DFS p props m a) Identity ComponentIds
-> StateT (DFS p props m a) Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens (DFS p props m a) ComponentIds
-> StateT (DFS p props m a) Identity ComponentIds
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens (DFS p props m a) ComponentIds
forall p props m a. Lens (DFS p props m a) ComponentIds
visited
      unless seen $ do
        propagateParent cs (cs ^. parentId)
        propagateChildren cs (cs ^. children)
        markVisited (cs ^. componentId)
        synch
-----------------------------------------------------------------------------
propagateChildren
  :: forall p props m a
   . ComponentState p props m a
  -> ComponentIds
  -> Synch p props m a ()
propagateChildren :: forall p props m a.
ComponentState p props m a -> ComponentIds -> Synch p props m a ()
propagateChildren ComponentState p props m a
currentState ComponentIds
childComponents = do
  [Int]
-> (Int -> StateT (DFS p props m a) Identity ())
-> StateT (DFS p props m a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ComponentIds -> [Int]
IS.toList ComponentIds
childComponents) ((Int -> StateT (DFS p props m a) Identity ())
 -> StateT (DFS p props m a) Identity ())
-> (Int -> StateT (DFS p props m a) Identity ())
-> StateT (DFS p props m a) Identity ()
forall a b. (a -> b) -> a -> b
$ \Int
childId -> do
    childState <- (IntMap (ZonkAny 48) -> ZonkAny 48)
-> IntMap (ComponentState p props m a)
-> ComponentState m props m a
forall a b. a -> b
unsafeCoerce (IntMap (ZonkAny 48) -> Int -> ZonkAny 48
forall a. IntMap a -> Int -> a
IM.! Int
childId) (IntMap (ComponentState p props m a) -> ComponentState m props m a)
-> StateT
     (DFS p props m a) Identity (IntMap (ComponentState p props m a))
-> StateT (DFS p props m a) Identity (ComponentState m props m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens (DFS p props m a) (IntMap (ComponentState p props m a))
-> StateT
     (DFS p props m a) Identity (IntMap (ComponentState p props m a))
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens (DFS p props m a) (IntMap (ComponentState p props m a))
forall p props m a.
Lens (DFS p props m a) (IntMap (ComponentState p props m a))
state
    updatedChild <- unsafeCoerce <$>
      foldM process childState (childState ^. componentBindings)
    let isChildDirty =
          (ComponentState m props m a -> m -> m -> Bool
forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentModelDirty ComponentState m props m a
childState)
          (ComponentState m props m a -> m
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ComponentState m props m a
childState)
          (ComponentState p props m a -> m
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ComponentState p props m a
updatedChild)
    when isChildDirty $ do
      state.at childId ?= updatedChild { _componentIsDirty = True }
      visit childId
    where
      process
        :: ComponentState m props child a
        -> Binding m child
        -> Synch p props m a (ComponentState m props child a)
      process :: forall child.
ComponentState m props child a
-> Binding m child
-> Synch p props m a (ComponentState m props child a)
process ComponentState m props child a
childState = \case
        ParentToChild m -> field
getCurrentField field -> child -> child
setChildField -> do
          let currentChildModel :: child
currentChildModel = ComponentState m props child a
childState ComponentState m props child a
-> Lens (ComponentState m props child a) child -> child
forall record field. record -> Lens record field -> field
^. Lens (ComponentState m props child a) child
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel
              currentFieldValue :: field
currentFieldValue = m -> field
getCurrentField (ComponentState p props m a
currentState ComponentState p props m a
-> Lens (ComponentState p props m a) m -> m
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) m
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel)
              updatedChildModel :: child
updatedChildModel = field -> child -> child
setChildField field
currentFieldValue child
currentChildModel
          ComponentState m props child a
-> Synch p props m a (ComponentState m props child a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentState m props child a
childState ComponentState m props child a
-> (ComponentState m props child a
    -> ComponentState m props child a)
-> ComponentState m props child a
forall a b. a -> (a -> b) -> b
& Lens (ComponentState m props child a) child
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState m props child a) child
-> child
-> ComponentState m props child a
-> ComponentState m props child a
forall record field. Lens record field -> field -> record -> record
.~ child
updatedChildModel)
        Bidirectional Precedence
_ m -> field
getCurrentField field -> m -> m
_ child -> field
_ field -> child -> child
setChildField -> do
          let currentChildModel :: child
currentChildModel = ComponentState m props child a -> child
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ComponentState m props child a
childState
              currentFieldValue :: field
currentFieldValue = m -> field
getCurrentField (ComponentState p props m a
currentState ComponentState p props m a
-> Lens (ComponentState p props m a) m -> m
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) m
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel)
              updatedChildModel :: child
updatedChildModel = field -> child -> child
setChildField field
currentFieldValue child
currentChildModel
          ComponentState m props child a
-> Synch p props m a (ComponentState m props child a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentState m props child a
childState ComponentState m props child a
-> (ComponentState m props child a
    -> ComponentState m props child a)
-> ComponentState m props child a
forall a b. a -> (a -> b) -> b
& Lens (ComponentState m props child a) child
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState m props child a) child
-> child
-> ComponentState m props child a
-> ComponentState m props child a
forall record field. Lens record field -> field -> record -> record
.~ child
updatedChildModel)
        Binding m child
_ ->
          ComponentState m props child a
-> Synch p props m a (ComponentState m props child a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentState m props child a
childState
-----------------------------------------------------------------------------
propagateParent
  :: forall p props m a
   . ComponentState p props m a
  -> ComponentId
  -> Synch p props m a ()
propagateParent :: forall p props m a.
ComponentState p props m a -> Int -> Synch p props m a ()
propagateParent ComponentState p props m a
currentState Int
parentId_ =
  Int
-> IntMap (ComponentState p props m a)
-> Maybe (ComponentState p props m a)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
parentId_ (IntMap (ComponentState p props m a)
 -> Maybe (ComponentState p props m a))
-> StateT
     (DFS p props m a) Identity (IntMap (ComponentState p props m a))
-> StateT
     (DFS p props m a) Identity (Maybe (ComponentState p props m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lens (DFS p props m a) (IntMap (ComponentState p props m a))
-> StateT
     (DFS p props m a) Identity (IntMap (ComponentState p props m a))
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens (DFS p props m a) (IntMap (ComponentState p props m a))
forall p props m a.
Lens (DFS p props m a) (IntMap (ComponentState p props m a))
state StateT
  (DFS p props m a) Identity (Maybe (ComponentState p props m a))
-> (Maybe (ComponentState p props m a)
    -> StateT (DFS p props m a) Identity ())
-> StateT (DFS p props m a) Identity ()
forall a b.
StateT (DFS p props m a) Identity a
-> (a -> StateT (DFS p props m a) Identity b)
-> StateT (DFS p props m a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ComponentState p props m a
 -> StateT (DFS p props m a) Identity ())
-> Maybe (ComponentState p props m a)
-> StateT (DFS p props m a) Identity ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ \case
    ComponentState p props m a
parentState -> do
      updatedParent <- ComponentState (ZonkAny 49) props p a -> ComponentState p props m a
forall a b. a -> b
unsafeCoerce (ComponentState (ZonkAny 49) props p a
 -> ComponentState p props m a)
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 49) props p a)
-> StateT (DFS p props m a) Identity (ComponentState p props m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (ComponentState (ZonkAny 49) props p a
 -> Binding p m
 -> StateT
      (DFS p props m a) Identity (ComponentState (ZonkAny 49) props p a))
-> ComponentState (ZonkAny 49) props p a
-> [Binding p m]
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 49) props p a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ComponentState (ZonkAny 49) props p a
-> Binding p m
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 49) props p a)
forall x.
ComponentState x props p a
-> Binding p m -> Synch p props m a (ComponentState x props p a)
process (ComponentState p props m a -> ComponentState (ZonkAny 49) props p a
forall a b. a -> b
unsafeCoerce ComponentState p props m a
parentState) (ComponentState p props m a
currentState ComponentState p props m a
-> Lens (ComponentState p props m a) [Binding p m] -> [Binding p m]
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) [Binding p m]
forall p props m a. Lens (ComponentState p props m a) [Binding p m]
componentBindings)
      let isParentDirty =
            (ComponentState p props m a -> m -> m -> Bool
forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentModelDirty ComponentState p props m a
parentState)
            (ComponentState p props m a -> m
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ComponentState p props m a
parentState)
            (ComponentState p props m a -> m
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ComponentState p props m a
updatedParent)
      when isParentDirty $ do
        state.at parentId_ ?= updatedParent { _componentIsDirty = True }
        visit parentId_
  where
    process
      :: ComponentState x props p a
      -> Binding p m
      -> Synch p props m a (ComponentState x props p a)
    process :: forall x.
ComponentState x props p a
-> Binding p m -> Synch p props m a (ComponentState x props p a)
process ComponentState x props p a
parentState = \case
      ChildToParent field -> p -> p
setParentField m -> field
getCurrentField -> do
        let currentParentModel :: p
currentParentModel = ComponentState x props p a
parentState ComponentState x props p a
-> Lens (ComponentState x props p a) p -> p
forall record field. record -> Lens record field -> field
^. Lens (ComponentState x props p a) p
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel
            currentFieldValue :: field
currentFieldValue = m -> field
getCurrentField (ComponentState p props m a
currentState ComponentState p props m a
-> Lens (ComponentState p props m a) m -> m
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) m
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel)
            updatedParentModel :: p
updatedParentModel = field -> p -> p
setParentField field
currentFieldValue p
currentParentModel
        ComponentState x props p a
-> Synch p props m a (ComponentState x props p a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentState x props p a
parentState ComponentState x props p a
-> (ComponentState x props p a -> ComponentState x props p a)
-> ComponentState x props p a
forall a b. a -> (a -> b) -> b
& Lens (ComponentState x props p a) p
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState x props p a) p
-> p -> ComponentState x props p a -> ComponentState x props p a
forall record field. Lens record field -> field -> record -> record
.~ p
updatedParentModel)
      Bidirectional Precedence
_ p -> field
_ field -> p -> p
setParentField m -> field
getCurrentField field -> m -> m
_ -> do
        let currentParentModel :: p
currentParentModel = ComponentState x props p a
parentState ComponentState x props p a
-> Lens (ComponentState x props p a) p -> p
forall record field. record -> Lens record field -> field
^. Lens (ComponentState x props p a) p
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel
            currentFieldValue :: field
currentFieldValue = m -> field
getCurrentField (ComponentState p props m a
currentState ComponentState p props m a
-> Lens (ComponentState p props m a) m -> m
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) m
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel)
            updatedParentModel :: p
updatedParentModel = field -> p -> p
setParentField field
currentFieldValue p
currentParentModel
        ComponentState x props p a
-> Synch p props m a (ComponentState x props p a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ComponentState x props p a
parentState ComponentState x props p a
-> (ComponentState x props p a -> ComponentState x props p a)
-> ComponentState x props p a
forall a b. a -> (a -> b) -> b
& Lens (ComponentState x props p a) p
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState x props p a) p
-> p -> ComponentState x props p a -> ComponentState x props p a
forall record field. Lens record field -> field -> record -> record
.~ p
updatedParentModel)
      Binding p m
_ ->
        ComponentState x props p a
-> Synch p props m a (ComponentState x props p a)
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentState x props p a
parentState
-----------------------------------------------------------------------------
markVisited :: ComponentId -> Synch p props m a ()
markVisited :: forall p props m a. Int -> Synch p props m a ()
markVisited Int
vcompId = Lens (DFS p props m a) ComponentIds
forall p props m a. Lens (DFS p props m a) ComponentIds
visitedLens (DFS p props m a) ComponentIds
-> LensCore (Maybe ()) ComponentIds
-> LensCore (Maybe ()) (DFS p props m a)
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Index ComponentIds
-> Lens ComponentIds (Maybe (IxValue ComponentIds))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index ComponentIds
vcompId LensCore (Maybe ()) (DFS p props m a)
-> () -> StateT (DFS p props m a) Identity ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
?= ()
-----------------------------------------------------------------------------
visit :: ComponentId -> Synch p props m a ()
visit :: forall p props m a. Int -> Synch p props m a ()
visit Int
vcompId = Lens (DFS p props m a) [Int]
forall p props m a. Lens (DFS p props m a) [Int]
stack Lens (DFS p props m a) [Int]
-> ([Int] -> [Int]) -> StateT (DFS p props m a) Identity ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= (Int
vcompIdInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:)
-----------------------------------------------------------------------------
pop :: Synch p props m a (Maybe (ComponentState p props m a))
pop :: forall p props m a.
Synch p props m a (Maybe (ComponentState p props m a))
pop = Lens (DFS p props m a) [Int]
-> StateT (DFS p props m a) Identity [Int]
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use Lens (DFS p props m a) [Int]
forall p props m a. Lens (DFS p props m a) [Int]
stack StateT (DFS p props m a) Identity [Int]
-> ([Int]
    -> StateT
         (DFS p props m a) Identity (Maybe (ComponentState p props m a)))
-> StateT
     (DFS p props m a) Identity (Maybe (ComponentState p props m a))
forall a b.
StateT (DFS p props m a) Identity a
-> (a -> StateT (DFS p props m a) Identity b)
-> StateT (DFS p props m a) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  [] ->
    Maybe (ComponentState p props m a)
-> StateT
     (DFS p props m a) Identity (Maybe (ComponentState p props m a))
forall a. a -> StateT (DFS p props m a) Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (ComponentState p props m a)
forall a. Maybe a
Nothing
  Int
x : [Int]
xs -> do
    Lens (DFS p props m a) [Int]
forall p props m a. Lens (DFS p props m a) [Int]
stack Lens (DFS p props m a) [Int]
-> [Int] -> StateT (DFS p props m a) Identity ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= [Int]
xs
    Lens (DFS p props m a) (Maybe (ComponentState p props m a))
-> StateT
     (DFS p props m a) Identity (Maybe (ComponentState p props m a))
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> m field
use (Lens (DFS p props m a) (IntMap (ComponentState p props m a))
forall p props m a.
Lens (DFS p props m a) (IntMap (ComponentState p props m a))
state Lens (DFS p props m a) (IntMap (ComponentState p props m a))
-> LensCore
     (Maybe (ComponentState p props m a))
     (IntMap (ComponentState p props m a))
-> Lens (DFS p props m a) (Maybe (ComponentState p props m a))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (IntMap (ComponentState p props m a))
-> Lens
     (IntMap (ComponentState p props m a))
     (Maybe (IxValue (IntMap (ComponentState p props m a))))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index (IntMap (ComponentState p props m a))
x)
-----------------------------------------------------------------------------
initialDraw
  :: (Eq m, Eq props)
  => m
  -> Events
  -> Hydrate
  -> Bool
  -> Component p props m a
  -> ComponentState p props m a
  -> IO ()
initialDraw :: forall m props p a.
(Eq m, Eq props) =>
m
-> Events
-> Hydrate
-> Bool
-> Component p props m a
-> ComponentState p props m a
-> IO ()
initialDraw m
initializedModel Events
events Hydrate
hydrate Bool
isRoot Component {m
Bool
[Binding p m]
[JS]
[CSS]
[Sub a]
Maybe a
Maybe (IO m)
Maybe MisoString
Maybe (props -> props -> a)
LogLevel
props -> m -> View m a
a -> Effect p props m a
Value -> Maybe a
onPropsChanged :: forall parent props model action.
Component parent props model action
-> Maybe (props -> props -> action)
unmount :: forall parent props model action.
Component parent props model action -> Maybe action
mount :: forall parent props model action.
Component parent props model action -> Maybe action
eventPropagation :: forall parent props model action.
Component parent props model action -> Bool
bindings :: forall parent props model action.
Component parent props model action -> [Binding parent model]
mailbox :: forall parent props model action.
Component parent props model action -> Value -> Maybe action
logLevel :: forall parent props model action.
Component parent props model action -> LogLevel
mountPoint :: forall parent props model action.
Component parent props model action -> Maybe MisoString
scripts :: forall parent props model action.
Component parent props model action -> [JS]
styles :: forall parent props model action.
Component parent props model action -> [CSS]
subs :: forall parent props model action.
Component parent props model action -> [Sub action]
view :: forall parent props model action.
Component parent props model action
-> props -> model -> View model action
update :: forall parent props model action.
Component parent props model action
-> action -> Effect parent props model action
hydrateModel :: forall parent props model action.
Component parent props model action -> Maybe (IO model)
model :: forall parent props model action.
Component parent props model action -> model
model :: m
hydrateModel :: Maybe (IO m)
update :: a -> Effect p props m a
view :: props -> m -> View m a
subs :: [Sub a]
styles :: [CSS]
scripts :: [JS]
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Value -> Maybe a
bindings :: [Binding p m]
eventPropagation :: Bool
mount :: Maybe a
unmount :: Maybe a
onPropsChanged :: Maybe (props -> props -> a)
..} ComponentState {m
props
Bool
Int
[DOMRef]
[Binding p m]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
m -> IO ()
m -> m -> Bool
props -> props -> IO ()
a -> IO ()
Seq a
-> m
-> IntMap (ComponentState p props m a)
-> props
-> (IntMap (ComponentState p props m a), m, [Schedule a],
    ComponentIds)
Value -> Maybe a
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: a -> IO ()
_componentModel :: m
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding p m]
_componentMailbox :: Value -> Maybe a
_componentDraw :: m -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: m -> m -> Bool
_componentApplyActions :: Seq a
-> m
-> IntMap (ComponentState p props m a)
-> props
-> (IntMap (ComponentState p props m a), m, [Schedule a],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
#ifdef BENCH
  start <- FFI.now
#endif
  vtree <- Events
-> Int
-> Int
-> Hydrate
-> (a -> IO ())
-> LogLevel
-> View m a
-> IO VTree
forall model action.
Eq model =>
Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
buildVTree Events
events Int
_componentParentId Int
_componentId Hydrate
hydrate a -> IO ()
_componentSink LogLevel
logLevel
    (props -> m -> View m a
view props
_componentProps m
initializedModel)
#ifdef BENCH
  end <- FFI.now
  when isRoot $ FFI.consoleLog $ ms (printf "buildVTree: %.3f ms" (end - start) :: String)
#endif
  case hydrate of
    Hydrate
Draw -> do
      Maybe VTree -> Maybe VTree -> DOMRef -> IO ()
Diff.diff Maybe VTree
forall a. Maybe a
Nothing (VTree -> Maybe VTree
forall a. a -> Maybe a
Just VTree
vtree) DOMRef
_componentDOMRef
      IORef VTree -> VTree -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef VTree
_componentVTree VTree
vtree
    Hydrate
Hydrate -> do
      if Bool
isRoot
        then do
          hydrated <- LogLevel -> DOMRef -> VTree -> IO Bool
Hydrate.hydrate LogLevel
logLevel DOMRef
_componentDOMRef VTree
vtree
          if hydrated
            then do
              atomicWriteIORef _componentVTree vtree
            else do
              newTree <-
                buildVTree events _componentParentId _componentId Draw
                  _componentSink logLevel (view _componentProps initializedModel)
              Diff.diff Nothing (Just newTree) _componentDOMRef
              atomicWriteIORef _componentVTree newTree
        else
          IORef VTree -> VTree -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef VTree
_componentVTree VTree
vtree
-----------------------------------------------------------------------------
-- | Pulls the next Component for processing out of the queue, along with
-- its events.
getBatch :: IO (Maybe (ComponentId, Seq action))
getBatch :: forall action. IO (Maybe (Int, Seq action))
getBatch = do
  IORef (Queue action)
-> (Queue action -> (Queue action, Maybe (Int, Seq action)))
-> IO (Maybe (Int, Seq action))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue action)
forall action. IORef (Queue action)
globalQueue ((Queue action -> (Queue action, Maybe (Int, Seq action)))
 -> IO (Maybe (Int, Seq action)))
-> (Queue action -> (Queue action, Maybe (Int, Seq action)))
-> IO (Maybe (Int, Seq action))
forall a b. (a -> b) -> a -> b
$ \Queue action
q ->
    case Queue action -> Maybe (Int, Seq action, Queue action)
forall action.
Queue action -> Maybe (Int, Seq action, Queue action)
dequeue Queue action
q of
      Maybe (Int, Seq action, Queue action)
Nothing -> (Queue action
q, Maybe (Int, Seq action)
forall a. Maybe a
Nothing)
      Just (Int
vcompId, Seq action
actions, Queue action
newQueue) ->
        (Queue action
newQueue, (Int, Seq action) -> Maybe (Int, Seq action)
forall a. a -> Maybe a
Just (Int
vcompId, Seq action
actions))
-----------------------------------------------------------------------------
-- | Helper for event extraction at a specific 'ComponentId'
drainQueueAt :: ComponentId -> IO (Seq a)
drainQueueAt :: forall a. Int -> IO (Seq a)
drainQueueAt Int
vcompId = IORef (Queue a) -> (Queue a -> (Queue a, Seq a)) -> IO (Seq a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue a)
forall action. IORef (Queue action)
globalQueue (Int -> Queue a -> (Queue a, Seq a)
forall action. Int -> Queue action -> (Queue action, Seq action)
dequeueAt Int
vcompId)
-----------------------------------------------------------------------------
-- | Data type for holding the events in the system along with
-- the schedule of what events should be processed next
data Queue action
  = Queue
  { forall action. Queue action -> IntMap (Seq action)
_queue :: IntMap (Seq action)
  , forall action. Queue action -> Seq Int
_queueSchedule :: Seq ComponentId
  } deriving (Int -> Queue action -> ShowS
[Queue action] -> ShowS
Queue action -> String
(Int -> Queue action -> ShowS)
-> (Queue action -> String)
-> ([Queue action] -> ShowS)
-> Show (Queue action)
forall action. Show action => Int -> Queue action -> ShowS
forall action. Show action => [Queue action] -> ShowS
forall action. Show action => Queue action -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall action. Show action => Int -> Queue action -> ShowS
showsPrec :: Int -> Queue action -> ShowS
$cshow :: forall action. Show action => Queue action -> String
show :: Queue action -> String
$cshowList :: forall action. Show action => [Queue action] -> ShowS
showList :: [Queue action] -> ShowS
Show, Queue action -> Queue action -> Bool
(Queue action -> Queue action -> Bool)
-> (Queue action -> Queue action -> Bool) -> Eq (Queue action)
forall action. Eq action => Queue action -> Queue action -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall action. Eq action => Queue action -> Queue action -> Bool
== :: Queue action -> Queue action -> Bool
$c/= :: forall action. Eq action => Queue action -> Queue action -> Bool
/= :: Queue action -> Queue action -> Bool
Eq)
-----------------------------------------------------------------------------
emptyQueue :: Queue action
emptyQueue :: forall action. Queue action
emptyQueue = Queue action
forall a. Monoid a => a
mempty
-----------------------------------------------------------------------------
instance Semigroup (Queue action) where
  Queue IntMap (Seq action)
q1 Seq Int
s1 <> :: Queue action -> Queue action -> Queue action
<> Queue IntMap (Seq action)
q2 Seq Int
s2 = IntMap (Seq action) -> Seq Int -> Queue action
forall action. IntMap (Seq action) -> Seq Int -> Queue action
Queue (IntMap (Seq action)
q1 IntMap (Seq action) -> IntMap (Seq action) -> IntMap (Seq action)
forall a. Semigroup a => a -> a -> a
<> IntMap (Seq action)
q2) (Seq Int
s1 Seq Int -> Seq Int -> Seq Int
forall a. Semigroup a => a -> a -> a
<> Seq Int
s2)
-----------------------------------------------------------------------------
instance Monoid (Queue action) where
  mempty :: Queue action
mempty = IntMap (Seq action) -> Seq Int -> Queue action
forall action. IntMap (Seq action) -> Seq Int -> Queue action
Queue IntMap (Seq action)
forall a. Monoid a => a
mempty Seq Int
forall a. Monoid a => a
mempty
-----------------------------------------------------------------------------
queue :: Lens (Queue action) (IntMap (Seq action))
queue :: forall action. Lens (Queue action) (IntMap (Seq action))
queue = (Queue action -> IntMap (Seq action))
-> (Queue action -> IntMap (Seq action) -> Queue action)
-> Lens (Queue action) (IntMap (Seq action))
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens Queue action -> IntMap (Seq action)
forall action. Queue action -> IntMap (Seq action)
_queue ((Queue action -> IntMap (Seq action) -> Queue action)
 -> Lens (Queue action) (IntMap (Seq action)))
-> (Queue action -> IntMap (Seq action) -> Queue action)
-> Lens (Queue action) (IntMap (Seq action))
forall a b. (a -> b) -> a -> b
$ \Queue action
r IntMap (Seq action)
f -> Queue action
r { _queue = f }
-----------------------------------------------------------------------------
queueSchedule :: Lens (Queue action) (Seq ComponentId)
queueSchedule :: forall action. Lens (Queue action) (Seq Int)
queueSchedule = (Queue action -> Seq Int)
-> (Queue action -> Seq Int -> Queue action)
-> Lens (Queue action) (Seq Int)
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens Queue action -> Seq Int
forall action. Queue action -> Seq Int
_queueSchedule ((Queue action -> Seq Int -> Queue action)
 -> Lens (Queue action) (Seq Int))
-> (Queue action -> Seq Int -> Queue action)
-> Lens (Queue action) (Seq Int)
forall a b. (a -> b) -> a -> b
$ \Queue action
r Seq Int
f -> Queue action
r { _queueSchedule = f }
-----------------------------------------------------------------------------
enqueue :: ComponentId -> action -> Queue action -> Queue action
enqueue :: forall action. Int -> action -> Queue action -> Queue action
enqueue Int
vcompId action
action Queue action
q =
  Queue action
q Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (IntMap (Seq action))
forall action. Lens (Queue action) (IntMap (Seq action))
queue Lens (Queue action) (IntMap (Seq action))
-> (IntMap (Seq action) -> IntMap (Seq action))
-> Queue action
-> Queue action
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (Seq action -> Seq action -> Seq action)
-> Int -> Seq action -> IntMap (Seq action) -> IntMap (Seq action)
forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
IM.insertWith ((Seq action -> Seq action -> Seq action)
-> Seq action -> Seq action -> Seq action
forall a b c. (a -> b -> c) -> b -> a -> c
flip Seq action -> Seq action -> Seq action
forall a. Semigroup a => a -> a -> a
(<>)) Int
vcompId (action -> Seq action
forall a. a -> Seq a
S.singleton action
action)
    Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue action) (Seq Int)
-> (Seq Int -> Seq Int) -> Queue action -> Queue action
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
S.|> Int
vcompId)
-----------------------------------------------------------------------------
-- | Used to fast track to render phase, bypassing commit phase. Used in 'props'
-- feature.
enqueueSchedule :: ComponentId -> IO ()
enqueueSchedule :: Int -> IO ()
enqueueSchedule Int
vcompId =
  IORef (Queue (ZonkAny 47))
-> (Queue (ZonkAny 47) -> (Queue (ZonkAny 47), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue (ZonkAny 47))
forall action. IORef (Queue action)
globalQueue ((Queue (ZonkAny 47) -> (Queue (ZonkAny 47), ())) -> IO ())
-> (Queue (ZonkAny 47) -> (Queue (ZonkAny 47), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Queue (ZonkAny 47)
q ->
     (Queue (ZonkAny 47)
q Queue (ZonkAny 47)
-> (Queue (ZonkAny 47) -> Queue (ZonkAny 47)) -> Queue (ZonkAny 47)
forall a b. a -> (a -> b) -> b
& Lens (Queue (ZonkAny 47)) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue (ZonkAny 47)) (Seq Int)
-> (Seq Int -> Seq Int) -> Queue (ZonkAny 47) -> Queue (ZonkAny 47)
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
S.|> Int -> Int
forall a. Num a => a -> a
negate Int
vcompId), ())
-----------------------------------------------------------------------------
-- | Case on queue schedule, get first item, span on the rest of queueSchedule, get length.
-- set schedule with whatever remains.
--
-- Take the length of the queue schedule found, looking up with vcompId (from first element)
-- in the queue, splitAt the queue.
--
dequeue
  :: forall action
   . Queue action
  -> Maybe (ComponentId, Seq action, Queue action)
dequeue :: forall action.
Queue action -> Maybe (Int, Seq action, Queue action)
dequeue Queue action
q =
  case Queue action
q Queue action -> Lens (Queue action) (Seq Int) -> Seq Int
forall record field. record -> Lens record field -> field
^. Lens (Queue action) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule of
    Seq Int
S.Empty -> Maybe (Int, Seq action, Queue action)
forall a. Maybe a
Nothing
    sched :: Seq Int
sched@(Int
vcompId S.:<| Seq Int
_) ->
      case Queue action
q Queue action
-> Lens (Queue action) (Maybe (Seq action)) -> Maybe (Seq action)
forall record field. record -> Lens record field -> field
^. Lens (Queue action) (IntMap (Seq action))
forall action. Lens (Queue action) (IntMap (Seq action))
queue Lens (Queue action) (IntMap (Seq action))
-> LensCore (Maybe (Seq action)) (IntMap (Seq action))
-> Lens (Queue action) (Maybe (Seq action))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (IntMap (Seq action))
-> Lens
     (IntMap (Seq action)) (Maybe (IxValue (IntMap (Seq action))))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index (IntMap (Seq action))
vcompId of
        Maybe (Seq action)
Nothing ->
          let (Seq Int
_, Seq Int
remaining) = (Int -> Bool) -> Seq Int -> (Seq Int, Seq Int)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
vcompId) Seq Int
sched
          in (Int, Seq action, Queue action)
-> Maybe (Int, Seq action, Queue action)
forall a. a -> Maybe a
Just (Int
vcompId, Seq action
forall a. Seq a
S.empty, Queue action
q Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue action) (Seq Int)
-> Seq Int -> Queue action -> Queue action
forall record field. Lens record field -> field -> record -> record
.~ Seq Int
remaining)
        Just Seq action
actions ->
          case (Int -> Bool) -> Seq Int -> (Seq Int, Seq Int)
forall a. (a -> Bool) -> Seq a -> (Seq a, Seq a)
S.spanl (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
vcompId) Seq Int
sched of
            (Seq Int
scheduled, Seq Int
remaining) ->
              case Int -> Seq action -> (Seq action, Seq action)
forall a. Int -> Seq a -> (Seq a, Seq a)
S.splitAt (Seq Int -> Int
forall a. Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq Int
scheduled) Seq action
actions of
                (Seq action
process, Seq action
rest) -> do
                  let updated :: Queue action
updated =
                        Queue action
q Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue action) (Seq Int)
-> Seq Int -> Queue action -> Queue action
forall record field. Lens record field -> field -> record -> record
.~ Seq Int
remaining
                          Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (IntMap (Seq action))
forall action. Lens (Queue action) (IntMap (Seq action))
queueLens (Queue action) (IntMap (Seq action))
-> LensCore (Maybe (Seq action)) (IntMap (Seq action))
-> Lens (Queue action) (Maybe (Seq action))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Index (IntMap (Seq action))
-> Lens
     (IntMap (Seq action)) (Maybe (IxValue (IntMap (Seq action))))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index (IntMap (Seq action))
vcompId Lens (Queue action) (Maybe (Seq action))
-> Maybe (Seq action) -> Queue action -> Queue action
forall record field. Lens record field -> field -> record -> record
.~ do if Seq action -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Seq action
rest then Maybe (Seq action)
forall a. Maybe a
Nothing else Seq action -> Maybe (Seq action)
forall a. a -> Maybe a
Just Seq action
rest
                  (Int, Seq action, Queue action)
-> Maybe (Int, Seq action, Queue action)
forall a. a -> Maybe a
Just (Int
vcompId, Seq action
process, Queue action
updated)
-----------------------------------------------------------------------------
-- | Dequeues everything from the Queue at a specific t'ComponentId', draining
-- both the queue events and the queue schedule.
dequeueAt
  :: forall action
   . ComponentId
  -> Queue action
  -> (Queue action, Seq action)
dequeueAt :: forall action. Int -> Queue action -> (Queue action, Seq action)
dequeueAt Int
vcompId Queue action
q =
  case Queue action
q Queue action
-> Lens (Queue action) (Maybe (Seq action)) -> Maybe (Seq action)
forall record field. record -> Lens record field -> field
^. Lens (Queue action) (IntMap (Seq action))
forall action. Lens (Queue action) (IntMap (Seq action))
queue Lens (Queue action) (IntMap (Seq action))
-> LensCore (Maybe (Seq action)) (IntMap (Seq action))
-> Lens (Queue action) (Maybe (Seq action))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Index (IntMap (Seq action))
-> Lens
     (IntMap (Seq action)) (Maybe (IxValue (IntMap (Seq action))))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index (IntMap (Seq action))
vcompId of
    Maybe (Seq action)
Nothing -> (Queue action
q, Seq action
forall a. Seq a
S.empty)
    Just Seq action
actions -> do
      -- dmj: remove from schedule, extract all events
      let updated :: Queue action
updated = Queue action
q Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue action) (Seq Int)
-> (Seq Int -> Seq Int) -> Queue action -> Queue action
forall record field.
Lens record field -> (field -> field) -> record -> record
%~ (Int -> Bool) -> Seq Int -> Seq Int
forall a. (a -> Bool) -> Seq a -> Seq a
S.filter (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
vcompId)
                      Queue action -> (Queue action -> Queue action) -> Queue action
forall a b. a -> (a -> b) -> b
& Lens (Queue action) (IntMap (Seq action))
forall action. Lens (Queue action) (IntMap (Seq action))
queueLens (Queue action) (IntMap (Seq action))
-> LensCore (Maybe (Seq action)) (IntMap (Seq action))
-> Lens (Queue action) (Maybe (Seq action))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Index (IntMap (Seq action))
-> Lens
     (IntMap (Seq action)) (Maybe (IxValue (IntMap (Seq action))))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index (IntMap (Seq action))
vcompId Lens (Queue action) (Maybe (Seq action))
-> Maybe (Seq action) -> Queue action -> Queue action
forall record field. Lens record field -> field -> record -> record
.~ Maybe (Seq action)
forall a. Maybe a
Nothing
      (Queue action
updated, Seq action
actions)
-----------------------------------------------------------------------------
globalWaiter :: Waiter
{-# NOINLINE globalWaiter #-}
globalWaiter :: Waiter
globalWaiter = IO Waiter -> Waiter
forall a. IO a -> a
unsafePerformIO IO Waiter
waiter
-----------------------------------------------------------------------------
globalQueue :: IORef (Queue action)
{-# NOINLINE globalQueue #-}
globalQueue :: forall action. IORef (Queue action)
globalQueue = IO (IORef (Queue action)) -> IORef (Queue action)
forall a. IO a -> a
unsafePerformIO (Queue action -> IO (IORef (Queue action))
forall a. a -> IO (IORef a)
newIORef Queue action
forall action. Queue action
emptyQueue)
-----------------------------------------------------------------------------
componentId :: Lens (ComponentState parent props model action) ComponentId
componentId :: forall parent props model action.
Lens (ComponentState parent props model action) Int
componentId = (ComponentState parent props model action -> Int)
-> (ComponentState parent props model action
    -> Int -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentId ((ComponentState parent props model action
  -> Int -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) Int)
-> (ComponentState parent props model action
    -> Int -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Int
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record Int
field -> ComponentState parent props model action
record { _componentId = field }
-----------------------------------------------------------------------------
componentKey :: Lens (ComponentState parent props model action) (Maybe Key)
componentKey :: forall parent props model action.
Lens (ComponentState parent props model action) (Maybe Key)
componentKey = (ComponentState parent props model action -> Maybe Key)
-> (ComponentState parent props model action
    -> Maybe Key -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) (Maybe Key)
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> Maybe Key
forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentKey ((ComponentState parent props model action
  -> Maybe Key -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) (Maybe Key))
-> (ComponentState parent props model action
    -> Maybe Key -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) (Maybe Key)
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record Maybe Key
field -> ComponentState parent props model action
record { _componentKey = field }
-----------------------------------------------------------------------------
parentId :: Lens (ComponentState parent props model action) ComponentId
parentId :: forall parent props model action.
Lens (ComponentState parent props model action) Int
parentId = (ComponentState parent props model action -> Int)
-> (ComponentState parent props model action
    -> Int -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Int
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentParentId ((ComponentState parent props model action
  -> Int -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) Int)
-> (ComponentState parent props model action
    -> Int -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Int
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record Int
field -> ComponentState parent props model action
record { _componentParentId = field }
-----------------------------------------------------------------------------
children :: Lens (ComponentState parent props model action) ComponentIds
children :: forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
children = (ComponentState parent props model action -> ComponentIds)
-> (ComponentState parent props model action
    -> ComponentIds -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) ComponentIds
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> ComponentIds
forall parent props model action.
ComponentState parent props model action -> ComponentIds
_componentChildren ((ComponentState parent props model action
  -> ComponentIds -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) ComponentIds)
-> (ComponentState parent props model action
    -> ComponentIds -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) ComponentIds
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record ComponentIds
field -> ComponentState parent props model action
record { _componentChildren = field }
-----------------------------------------------------------------------------
componentTopics :: Lens (ComponentState parent props model action) (Map MisoString (Value -> IO ()))
componentTopics :: forall parent props model action.
Lens
  (ComponentState parent props model action)
  (Map MisoString (Value -> IO ()))
componentTopics = (ComponentState parent props model action
 -> Map MisoString (Value -> IO ()))
-> (ComponentState parent props model action
    -> Map MisoString (Value -> IO ())
    -> ComponentState parent props model action)
-> Lens
     (ComponentState parent props model action)
     (Map MisoString (Value -> IO ()))
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action
-> Map MisoString (Value -> IO ())
forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentTopics ((ComponentState parent props model action
  -> Map MisoString (Value -> IO ())
  -> ComponentState parent props model action)
 -> Lens
      (ComponentState parent props model action)
      (Map MisoString (Value -> IO ())))
-> (ComponentState parent props model action
    -> Map MisoString (Value -> IO ())
    -> ComponentState parent props model action)
-> Lens
     (ComponentState parent props model action)
     (Map MisoString (Value -> IO ()))
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record Map MisoString (Value -> IO ())
field -> ComponentState parent props model action
record { _componentTopics = field }
-----------------------------------------------------------------------------
isDirty :: Lens (ComponentState parent props model action) Bool
isDirty :: forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty = (ComponentState parent props model action -> Bool)
-> (ComponentState parent props model action
    -> Bool -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Bool
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> Bool
forall parent props model action.
ComponentState parent props model action -> Bool
_componentIsDirty ((ComponentState parent props model action
  -> Bool -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) Bool)
-> (ComponentState parent props model action
    -> Bool -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) Bool
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record Bool
field -> ComponentState parent props model action
record { _componentIsDirty = field }
-----------------------------------------------------------------------------
componentModel :: Lens (ComponentState parent props model action) model
componentModel :: forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel = (ComponentState parent props model action -> model)
-> (ComponentState parent props model action
    -> model -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) model
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> model
forall parent props model action.
ComponentState parent props model action -> model
_componentModel ((ComponentState parent props model action
  -> model -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) model)
-> (ComponentState parent props model action
    -> model -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) model
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record model
field -> ComponentState parent props model action
record { _componentModel = field }
-----------------------------------------------------------------------------
componentBindings :: Lens (ComponentState p props m a) [Binding p m]
componentBindings :: forall p props m a. Lens (ComponentState p props m a) [Binding p m]
componentBindings = (ComponentState p props m a -> [Binding p m])
-> (ComponentState p props m a
    -> [Binding p m] -> ComponentState p props m a)
-> Lens (ComponentState p props m a) [Binding p m]
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState p props m a -> [Binding p m]
forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentBindings ((ComponentState p props m a
  -> [Binding p m] -> ComponentState p props m a)
 -> Lens (ComponentState p props m a) [Binding p m])
-> (ComponentState p props m a
    -> [Binding p m] -> ComponentState p props m a)
-> Lens (ComponentState p props m a) [Binding p m]
forall a b. (a -> b) -> a -> b
$ \ComponentState p props m a
record [Binding p m]
field -> ComponentState p props m a
record { _componentBindings = field }
-----------------------------------------------------------------------------
componentProps :: Lens (ComponentState parent props model action) props
componentProps :: forall parent props model action.
Lens (ComponentState parent props model action) props
componentProps = (ComponentState parent props model action -> props)
-> (ComponentState parent props model action
    -> props -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) props
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> props
forall parent props model action.
ComponentState parent props model action -> props
_componentProps ((ComponentState parent props model action
  -> props -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) props)
-> (ComponentState parent props model action
    -> props -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) props
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record props
field -> ComponentState parent props model action
record { _componentProps = field }
-----------------------------------------------------------------------------
prevComponentProps :: Lens (ComponentState parent props model action) props
prevComponentProps :: forall parent props model action.
Lens (ComponentState parent props model action) props
prevComponentProps = (ComponentState parent props model action -> props)
-> (ComponentState parent props model action
    -> props -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) props
forall record field.
(record -> field)
-> (record -> field -> record) -> Lens record field
lens ComponentState parent props model action -> props
forall parent props model action.
ComponentState parent props model action -> props
_prevComponentProps ((ComponentState parent props model action
  -> props -> ComponentState parent props model action)
 -> Lens (ComponentState parent props model action) props)
-> (ComponentState parent props model action
    -> props -> ComponentState parent props model action)
-> Lens (ComponentState parent props model action) props
forall a b. (a -> b) -> a -> b
$ \ComponentState parent props model action
record props
field -> ComponentState parent props model action
record { _prevComponentProps = field }
-----------------------------------------------------------------------------
-- | Hydrate avoids calling @diff@, and instead calls @hydrate@
-- 'Draw' invokes 'Miso.Diff.diff'
data Hydrate
  = Draw
  | Hydrate
  deriving (Int -> Hydrate -> ShowS
[Hydrate] -> ShowS
Hydrate -> String
(Int -> Hydrate -> ShowS)
-> (Hydrate -> String) -> ([Hydrate] -> ShowS) -> Show Hydrate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hydrate -> ShowS
showsPrec :: Int -> Hydrate -> ShowS
$cshow :: Hydrate -> String
show :: Hydrate -> String
$cshowList :: [Hydrate] -> ShowS
showList :: [Hydrate] -> ShowS
Show, Hydrate -> Hydrate -> Bool
(Hydrate -> Hydrate -> Bool)
-> (Hydrate -> Hydrate -> Bool) -> Eq Hydrate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hydrate -> Hydrate -> Bool
== :: Hydrate -> Hydrate -> Bool
$c/= :: Hydrate -> Hydrate -> Bool
/= :: Hydrate -> Hydrate -> Bool
Eq)
-----------------------------------------------------------------------------
-- | t'Miso.Types.Component' state, data associated with the lifetime of a t'Miso.Types.Component'
data ComponentState parent props model action
  = ComponentState
  { forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: ComponentId
  -- ^ The ID of the current t'Miso.Types.Component'
  , forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentKey :: Maybe Key
  -- ^ Optional key for stable hot-reload model recovery
  , forall parent props model action.
ComponentState parent props model action -> Int
_componentParentId :: ComponentId
  -- ^ The ID of the t'Miso.Types.Component''s parent
  , forall parent props model action.
ComponentState parent props model action -> props
_componentProps :: props
  -- ^ The current props passed to this t'Miso.Types.Component'
  , forall parent props model action.
ComponentState parent props model action -> props
_prevComponentProps :: props
  -- ^ The previous Component props passed to this t'Miso.Types.Component'
  , forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentSubThreads :: IORef (Map MisoString ThreadId)
  -- ^ Mapping of all 'Sub' in use by t'Miso.Types.Component'
  , forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDOMRef :: DOMRef
  -- ^ The DOM reference the t'Miso.Types.Component' is mounted on
  , forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentVTree :: IORef VTree
  -- ^ A reference to the current virtual DOM (i.e. t'VTree')
  , forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSink :: action -> IO ()
  -- ^ t'Miso.Types.Component' t'Sink' used to enter events into the system
  , forall parent props model action.
ComponentState parent props model action -> model
_componentModel :: model
  -- ^ t'Miso.Types.Component' state
  , forall parent props model action.
ComponentState parent props model action -> Bool
_componentIsDirty :: Bool
  -- ^ Indicator if t'Miso.Types.Component' needs to be drawn
  , forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentScripts :: [DOMRef]
  -- ^ DOM references for \<script\> and \<style\> appended to \<head\>
  , forall parent props model action.
ComponentState parent props model action -> Events
_componentEvents :: Events
  -- ^ List of events a t'Miso.Types.Component' listens on
  , forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentBindings :: [Binding parent model]
  -- ^ Declarative bindings between t'Miso.Types.Component' 'model'.
  , forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentMailbox :: Value -> Maybe action
  -- ^ Mailbox for asynchronous t'Miso.Types.Component' communication
  , forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentDraw :: model -> IO ()
  -- ^ Helper function for t'Miso.Types.Component' rendering
  , forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentPropsPhase :: props -> props -> IO ()
  -- ^ Helper function for t'Miso.Types.Component' props changed phase.
  , forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentModelDirty :: model -> model -> Bool
  -- ^ Model diffing
  , forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentApplyActions
      :: Seq action
      -> model
      -> IntMap (ComponentState parent props model action)
      -> props
      -> (IntMap (ComponentState parent props model action), model, [Schedule action], ComponentIds)
  -- ^ t'Miso.Types.Component' actions application
  , forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentTopics :: Map MisoString (Value -> IO ())
  -- ^ t'Miso.Types.Component' topics using for Pub Sub async communication.
  , forall parent props model action.
ComponentState parent props model action -> ComponentIds
_componentChildren :: ComponentIds
  -- ^ 'IntSet' of children t'Miso.Types.ComponentId'
  }
-----------------------------------------------------------------------------
-- | A @Topic@ represents a place to send and receive messages. @Topic@ is used to facilitate
-- communication between t'Miso.Types.Component'. t'Miso.Types.Component' can 'subscribe' to or 'publish' to any @Topic@,
-- within the same t'Miso.Types.Component' or across t'Miso.Types.Component'.
--
-- This requires creating a custom 'ToJSON' / 'FromJSON'. Any other t'Miso.Types.Component'
-- can 'publish' or 'subscribe' to this @Topic message@. It is a way to provide
-- loosely-coupled communication between @Components@.
--
-- See 'publish', 'subscribe', 'unsubscribe' for more details.
--
-- When distributing t'Miso.Types.Component' for third-party use, it is recommended to export
-- the @Topic@, where message is the JSON protocol.
--
--
-- @since 1.9.0.0
newtype Topic a = Topic MisoString
  deriving (Eq (Topic a)
Eq (Topic a) =>
(Topic a -> Topic a -> Ordering)
-> (Topic a -> Topic a -> Bool)
-> (Topic a -> Topic a -> Bool)
-> (Topic a -> Topic a -> Bool)
-> (Topic a -> Topic a -> Bool)
-> (Topic a -> Topic a -> Topic a)
-> (Topic a -> Topic a -> Topic a)
-> Ord (Topic a)
Topic a -> Topic a -> Bool
Topic a -> Topic a -> Ordering
Topic a -> Topic a -> Topic a
forall a. Eq (Topic a)
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Topic a -> Topic a -> Bool
forall a. Topic a -> Topic a -> Ordering
forall a. Topic a -> Topic a -> Topic a
$ccompare :: forall a. Topic a -> Topic a -> Ordering
compare :: Topic a -> Topic a -> Ordering
$c< :: forall a. Topic a -> Topic a -> Bool
< :: Topic a -> Topic a -> Bool
$c<= :: forall a. Topic a -> Topic a -> Bool
<= :: Topic a -> Topic a -> Bool
$c> :: forall a. Topic a -> Topic a -> Bool
> :: Topic a -> Topic a -> Bool
$c>= :: forall a. Topic a -> Topic a -> Bool
>= :: Topic a -> Topic a -> Bool
$cmax :: forall a. Topic a -> Topic a -> Topic a
max :: Topic a -> Topic a -> Topic a
$cmin :: forall a. Topic a -> Topic a -> Topic a
min :: Topic a -> Topic a -> Topic a
Ord, Topic a -> Topic a -> Bool
(Topic a -> Topic a -> Bool)
-> (Topic a -> Topic a -> Bool) -> Eq (Topic a)
forall a. Topic a -> Topic a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Topic a -> Topic a -> Bool
== :: Topic a -> Topic a -> Bool
$c/= :: forall a. Topic a -> Topic a -> Bool
/= :: Topic a -> Topic a -> Bool
Eq, Int -> Topic a -> ShowS
[Topic a] -> ShowS
Topic a -> String
(Int -> Topic a -> ShowS)
-> (Topic a -> String) -> ([Topic a] -> ShowS) -> Show (Topic a)
forall a. Int -> Topic a -> ShowS
forall a. [Topic a] -> ShowS
forall a. Topic a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Topic a -> ShowS
showsPrec :: Int -> Topic a -> ShowS
$cshow :: forall a. Topic a -> String
show :: Topic a -> String
$cshowList :: forall a. [Topic a] -> ShowS
showList :: [Topic a] -> ShowS
Show, Topic a -> MisoString
(Topic a -> MisoString) -> ToMisoString (Topic a)
forall a. Topic a -> MisoString
forall str. (str -> MisoString) -> ToMisoString str
$ctoMisoString :: forall a. Topic a -> MisoString
toMisoString :: Topic a -> MisoString
ToMisoString)
-----------------------------------------------------------------------------
-- | Smart constructor for creating a @Topic message@ to write to
--
-- @
--
-- data Message
--   = Increment
--   | Decrement
--   deriving (Show, Eq, Generic, ToJSON, FromJSON)
--
-- arithmetic :: Topic Message
-- arithmetic = topic "arithmetic"
--
-- data Action
--   = Notification (Result Message)
--   | Subscribe
--   | Unsubscribe
--
-- update_ :: Action -> Effect parent props Int Action
-- update_ = \case
--   Unsubscribe ->
--     unsubscribe arithmetic
--   Subscribe ->
--     subscribe arithmetic Notification
--   Notification (Success Increment) ->
--     update_ AddOne
--   Notification (Success Decrement) ->
--     update_ SubtractOne
--   Notification (Error msg) ->
--     io_ $ consoleError ("Decode failure: " <> ms msg)
--
-- @
--
-- @since 1.9.0.0
topic :: MisoString -> Topic a
topic :: forall a. MisoString -> Topic a
topic = MisoString -> Topic a
forall a. MisoString -> Topic a
Topic
-----------------------------------------------------------------------------
-- | Subscribes a t'Miso.Types.Component' to a t'Topic'.
--
-- Registers a callback in the component that decodes incoming messages
-- using its own 'FromJSON' instance and dispatches them to the component's
-- 'Sink'. If the component is already subscribed to the named topic the
-- previous callback is replaced.
--
-- Because each subscriber uses its own 'FromJSON', components can use
-- different Haskell types for the same topic as long as the underlying
-- JSON is compatible, enabling loose coupling between t'Miso.Types.Component'.
--
-- @
--
-- data Message = Increment | Decrement
--   deriving (Show, Eq, Generic, ToJSON, FromJSON)
--
-- arithmetic :: Topic Message
-- arithmetic = topic "arithmetic"
--
-- data Action
--   = Notify Message
--   | NotifyError MisoString
--   | Subscribe
--   | Unsubscribe
--   | AddOne
--   | SubtractOne
--
-- update_ :: Action -> Effect parent props Int Action
-- update_ = \\case
--   Subscribe ->
--     subscribe arithmetic Notify NotifyError
--   Unsubscribe ->
--     unsubscribe arithmetic
--   Notify Increment -> update_ AddOne
--   Notify Decrement -> update_ SubtractOne
--   NotifyError msg ->
--     io_ $ consoleError ("Decode failure: " <> msg)
--   AddOne -> _count += 1
--   SubtractOne -> _count -= 1
--
-- @
--
-- @since 1.9.0.0
subscribe
  :: FromJSON message
  => Topic message
  -> (message -> action)
  -> (MisoString -> action)
  -> Effect parent props model action
subscribe :: forall message action parent props model.
FromJSON message =>
Topic message
-> (message -> action)
-> (MisoString -> action)
-> Effect parent props model action
subscribe (Topic MisoString
topicName) message -> action
successful MisoString -> action
errorful = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  withSink $ \Sink action
sink ->
    Int
-> State
     (ComponentState
        (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
     ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentInfoId (State
   (ComponentState
      (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
   ()
 -> IO ())
-> State
     (ComponentState
        (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
     ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Lens
  (ComponentState
     (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
  (Map MisoString (Value -> IO ()))
forall parent props model action.
Lens
  (ComponentState parent props model action)
  (Map MisoString (Value -> IO ()))
componentTopics Lens
  (ComponentState
     (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
  (Map MisoString (Value -> IO ()))
-> (Map MisoString (Value -> IO ())
    -> Map MisoString (Value -> IO ()))
-> State
     (ComponentState
        (ZonkAny 50) (ZonkAny 51) (ZonkAny 52) (ZonkAny 53))
     ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= do
        MisoString
-> (Value -> IO ())
-> Map MisoString (Value -> IO ())
-> Map MisoString (Value -> IO ())
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert MisoString
topicName ((Value -> IO ())
 -> Map MisoString (Value -> IO ())
 -> Map MisoString (Value -> IO ()))
-> (Value -> IO ())
-> Map MisoString (Value -> IO ())
-> Map MisoString (Value -> IO ())
forall a b. (a -> b) -> a -> b
$ \Value
value ->
          Sink action
sink (case Value -> Result message
forall a. FromJSON a => Value -> Result a
fromJSON Value
value of
                  Success message
s -> message -> action
successful message
s
                  Error MisoString
e -> MisoString -> action
errorful MisoString
e)
-----------------------------------------------------------------------------
-- | Unsubscribes a t'Miso.Types.Component' from a t'Topic'.
--
-- Removes the callback registered by 'subscribe' so the component no longer
-- receives messages published to the topic. If the component is not
-- currently subscribed this is a no-op.
--
-- See 'subscribe' for example usage.
--
-- @since 1.9.0.0
unsubscribe :: Topic message -> Effect parent props model action
unsubscribe :: forall message parent props model action.
Topic message -> Effect parent props model action
unsubscribe (Topic MisoString
topicName) = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ modifyComponent _componentInfoId $ do
    componentTopics %= M.delete topicName
-----------------------------------------------------------------------------
-- | Publish to a t'Topic message'
--
-- t'Topic message' are generated dynamically if they do not exist. When using 'publish'
-- all subscribers are immediately notified of a new message. A message is distributed as a 'Value'
-- The underlying 'ToJSON' instance is used to construct this 'Value'.
--
-- We recommend documenting a public API for the JSON protocol message when distributing a t'Miso.Types.Component'
-- downstream to end users for consumption (be it inside a single cabal project or across multiple
-- cabal projects).
--
-- @
--
-- arithmetic :: Topic Message
-- arithmetic = topic "arithmetic"
--
-- server :: Component parent props () Action
-- server = component () update_ $ \() ->
--   div_
--   []
--   [ "Server component"
--   , button_ [ onClick AddOne ] [ "+" ]
--   , button_ [ onClick SubtractOne ] [ "-" ]
--   , component_ (client_ "client 1")
--   , component_ (client_ "client 2")
--   ] where
--       update_ :: Action -> Effect parent props () Action
--       update_ = \case
--         AddOne ->
--           publish arithmetic Increment
--         SubtractOne ->
--           publish arithemtic Decrement
--
-- @
--
-- @since 1.9.0.0
publish
  :: ToJSON message
  => Topic message
  -> message
  -> IO ()
publish :: forall message. ToJSON message => Topic message -> message -> IO ()
publish (Topic MisoString
topicName) message
message = (ComponentState (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)
 -> IO ())
-> [ComponentState
      (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComponentState (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)
-> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
go ([ComponentState
    (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)]
 -> IO ())
-> (IntMap
      (ComponentState
         (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
    -> [ComponentState
          (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)])
-> IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntMap
  (ComponentState
     (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
-> [ComponentState
      (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)]
forall a. IntMap a -> [a]
IM.elems (IntMap
   (ComponentState
      (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
 -> IO ())
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef
  (IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
  where
    go :: ComponentState parent props model action -> IO ()
go ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} =
      case MisoString
-> Map MisoString (Value -> IO ()) -> Maybe (Value -> IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup MisoString
topicName Map MisoString (Value -> IO ())
_componentTopics of
        Maybe (Value -> IO ())
Nothing ->
          () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Value -> IO ()
f ->
          Value -> IO ()
f (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
message)
-----------------------------------------------------------------------------
subIds :: IORef Int
{-# NOINLINE subIds #-}
subIds :: IORef Int
subIds = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
0
-----------------------------------------------------------------------------
freshSubId :: IO MisoString
freshSubId :: IO MisoString
freshSubId = do
  x <- IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
subIds ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Int
y -> (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
y)
  pure ("miso-sub-id-" <> ms x)
-----------------------------------------------------------------------------
-- | This is used to demarcate the ROOT of a page. This ID will *never*
-- exist in the `components` map.
rootComponentId :: ComponentId
rootComponentId :: Int
rootComponentId = Int
0
-----------------------------------------------------------------------------
-- | This is the top-level ComponentId, hardcoded
topLevelComponentId :: ComponentId
topLevelComponentId :: Int
topLevelComponentId = Int
1
-----------------------------------------------------------------------------
-- | The global store of 'ComponentId', for internal-use only.
--
-- Used internally @freshComponentId@ to allocate new 'ComponentId' on
-- mount.
--
componentIds :: IORef Int
{-# NOINLINE componentIds #-}
componentIds :: IORef Int
componentIds = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (IO (IORef Int) -> IORef Int) -> IO (IORef Int) -> IORef Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
topLevelComponentId
-----------------------------------------------------------------------------
freshComponentId :: IO ComponentId
freshComponentId :: IO Int
freshComponentId = IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
componentIds ((Int -> (Int, Int)) -> IO Int) -> (Int -> (Int, Int)) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Int
y -> (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
y)
-----------------------------------------------------------------------------
-- | 'cleanup' is used to remove previous application state (when using miso w/ GHCi).
--
-- As seen in <https://try.haskell-miso.org>
--
-- * Detect if previous 'Component' tree is present.
-- * Unmount in descending order (top-level 'Component' removed last), invoking finalizers
-- * Kill the scheduler thread (a new one is created on ':r').
-- * Erase all 'Component'
-- * Erase 'Queue'
-- * Reset 'componentId'
-- * Recreate 'DOMRef', GCs previous event listeners in JS.
-- * Yield to the scheduler (unwind thread stacks).
-- * Perform major garbage collection (cleans out old state).
--
-- This GC should remove the previous 'Notify' / 'MVar' as well since the 'sink'
-- closure should go out of scope.
--
cleanup :: Bool -> DOMRef -> IO ()
cleanup :: Bool -> DOMRef -> IO ()
cleanup Bool
live DOMRef
domRef = do
  vcomps <- IORef
  (IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
  when (IM.size vcomps > 0) $ do
    killThread =<< readIORef schedulerThread
    if live
      then do
        -- In hot reload we want to reset subs and connections, and free lifecycle hooks
        forM_ (IM.toDescList vcomps) $ \(Int
_, cs :: ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
cs@ComponentState{Bool
Int
[DOMRef]
[Binding (ZonkAny 66) (ZonkAny 68)]
Maybe Key
ZonkAny 67
ZonkAny 68
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 67 -> ZonkAny 67 -> IO ()
ZonkAny 68 -> IO ()
ZonkAny 68 -> ZonkAny 68 -> Bool
ZonkAny 69 -> IO ()
Seq (ZonkAny 69)
-> ZonkAny 68
-> IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
-> ZonkAny 67
-> (IntMap
      (ComponentState
         (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)),
    ZonkAny 68, [Schedule (ZonkAny 69)], ComponentIds)
Value -> Maybe (ZonkAny 69)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 67
_prevComponentProps :: ZonkAny 67
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 69 -> IO ()
_componentModel :: ZonkAny 68
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 66) (ZonkAny 68)]
_componentMailbox :: Value -> Maybe (ZonkAny 69)
_componentDraw :: ZonkAny 68 -> IO ()
_componentPropsPhase :: ZonkAny 67 -> ZonkAny 67 -> IO ()
_componentModelDirty :: ZonkAny 68 -> ZonkAny 68 -> Bool
_componentApplyActions :: Seq (ZonkAny 69)
-> ZonkAny 68
-> IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
-> ZonkAny 67
-> (IntMap
      (ComponentState
         (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)),
    ZonkAny 68, [Schedule (ZonkAny 69)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..}) -> do
          (ThreadId -> IO ()) -> Map MisoString ThreadId -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
killThread (Map MisoString ThreadId -> IO ())
-> IO (Map MisoString ThreadId) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Map MisoString ThreadId) -> IO (Map MisoString ThreadId)
forall a. IORef a -> IO a
readIORef IORef (Map MisoString ThreadId)
_componentSubThreads
          Int -> IO ()
finalizeWebSockets Int
_componentId
          Int -> IO ()
finalizeEventSources Int
_componentId
          ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
-> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
freeLifecycleHooks ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
cs
      else do
        -- We can do a full unmount if we're not doing hot reload
        forM_ (IM.toDescList vcomps) $ \(Int
_, ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
vcomp_) ->
          ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
-> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
unmountComponent ComponentState (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)
vcomp_
    atomicWriteIORef componentIds topLevelComponentId
    atomicWriteIORef globalQueue mempty
    unless live (atomicWriteIORef components mempty)
    abort <- domRef ! "abort"
    isnull <- isNull abort
    unless isnull $ do
      void $ (domRef # "abort") ()
    yield
    performMajorGC
-----------------------------------------------------------------------------
-- | componentMap
--
-- This is a global t'Miso.Types.Component' @Map@ that holds the state of all currently
-- mounted t'Miso.Types.Component's
components :: IORef (IntMap (ComponentState parent props model action))
{-# NOINLINE components #-}
components :: forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components = IO (IORef (IntMap (ComponentState parent props model action)))
-> IORef (IntMap (ComponentState parent props model action))
forall a. IO a -> a
unsafePerformIO (IntMap (ComponentState parent props model action)
-> IO (IORef (IntMap (ComponentState parent props model action)))
forall a. a -> IO (IORef a)
newIORef IntMap (ComponentState parent props model action)
forall a. Monoid a => a
mempty)
-----------------------------------------------------------------------------
-- | This function evaluates effects according to 'Synchronicity'.
evalScheduled :: Synchronicity -> IO () -> IO ()
evalScheduled :: Synchronicity -> IO () -> IO ()
evalScheduled Synchronicity
Sync IO ()
x = IO ()
x IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ())
-> (SomeException -> IO ()) -> SomeException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeException -> IO ()
exception)
evalScheduled Synchronicity
Async IO ()
x = IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ThreadId
forkIO (IO ()
x IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ())
-> (SomeException -> IO ()) -> SomeException -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SomeException -> IO ()
exception)))
-----------------------------------------------------------------------------
exception :: SomeException -> IO ()
exception :: SomeException -> IO ()
exception SomeException
ex = MisoString -> IO ()
FFI.consoleError (MisoString
"[EXCEPTION]: " MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> SomeException -> MisoString
forall str. ToMisoString str => str -> MisoString
ms SomeException
ex)
-----------------------------------------------------------------------------
-- | Drains the event queue before unmounting, executed synchronously.
drain
  :: ComponentState parent props model action
  -> IO ()
drain :: forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
drain ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
  Int -> IO (Seq action)
forall a. Int -> IO (Seq a)
drainQueueAt Int
_componentId IO (Seq action) -> (Seq action -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Seq action
S.Empty -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Seq action
actions -> do
       vcomps <- IORef (IntMap (ComponentState parent props model action))
-> IO (IntMap (ComponentState parent props model action))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState parent props model action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
       case _componentApplyActions actions _componentModel vcomps _componentProps of
         (IntMap (ComponentState parent props model action)
newVComps, model
_, [Schedule action]
schedules, ComponentIds
_) -> do
           [Schedule action] -> (Schedule action -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Schedule action]
schedules ((Schedule action -> IO ()) -> IO ())
-> (Schedule action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
             -- dmj: process all actions synchronously during unmount
             Schedule Synchronicity
_ (action -> IO ()) -> IO ()
action ->
               (action -> IO ()) -> IO ()
action action -> IO ()
_componentSink
                 IO () -> (SomeException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException
e :: SomeException) -> IO SomeException -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (SomeException -> IO SomeException
forall a. a -> IO a
evaluate SomeException
e))
             -- dmj: Don't recurse on drain, we only fire-off the last set
             -- of events for 'onBeforeUnmounted' hooks. The queue will
             -- ignore the rest of these.
           IORef (IntMap (ComponentState parent props model action))
-> IntMap (ComponentState parent props model action) -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (IntMap (ComponentState parent props model action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IntMap (ComponentState parent props model action)
newVComps
-----------------------------------------------------------------------------
-- | Post unmount call to drop the <style> and <script> in <head>
unloadScripts :: ComponentState parent props model action -> IO ()
unloadScripts :: forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
unloadScripts ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
  head_ <- IO DOMRef
FFI.getHead
  forM_ _componentScripts $ \DOMRef
domRef -> do
    contains <- DOMRef -> IO Bool
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked (DOMRef -> IO Bool) -> IO DOMRef -> IO Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do DOMRef
head_ DOMRef -> MisoString -> [DOMRef] -> IO DOMRef
forall object args.
(ToObject object, ToArgs args) =>
object -> MisoString -> args -> IO DOMRef
# MisoString
"contains" ([DOMRef] -> IO DOMRef) -> [DOMRef] -> IO DOMRef
forall a b. (a -> b) -> a -> b
$ [DOMRef
domRef]
    when contains (FFI.removeChild head_ domRef)
-----------------------------------------------------------------------------
-- | Helper to drop all lifecycle and mounting hooks if defined.
freeLifecycleHooks :: ComponentState parent props model action -> IO ()
freeLifecycleHooks :: forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
freeLifecycleHooks ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
  VTree (Object comp) <- IORef VTree -> IO VTree
forall a. IORef a -> IO a
readIORef IORef VTree
_componentVTree
  mapM_ freeFunction =<< fromJSVal =<< comp ! ("mount" :: MisoString)
  mapM_ freeFunction =<< fromJSVal =<< comp ! ("unmount" :: MisoString)
-----------------------------------------------------------------------------
-- | Helper function for cleanly destroying a t'Miso.Types.Component'
unmountComponent
  :: ComponentState parent props model action
  -> IO ()
unmountComponent :: forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
unmountComponent cs :: ComponentState parent props model action
cs@ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
  (ThreadId -> IO ()) -> Map MisoString ThreadId -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> IO ()
killThread (Map MisoString ThreadId -> IO ())
-> IO (Map MisoString ThreadId) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (Map MisoString ThreadId) -> IO (Map MisoString ThreadId)
forall a. IORef a -> IO a
readIORef IORef (Map MisoString ThreadId)
_componentSubThreads
  ComponentState parent props model action -> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
drain ComponentState parent props model action
cs
  Int -> IO ()
finalizeWebSockets Int
_componentId
  Int -> IO ()
finalizeEventSources Int
_componentId
  ComponentState parent props model action -> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
unloadScripts ComponentState parent props model action
cs
  ComponentState parent props model action -> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
freeLifecycleHooks ComponentState parent props model action
cs
  Int
-> State
     (ComponentState
        (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
     ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentParentId (State
   (ComponentState
      (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
   ()
 -> IO ())
-> State
     (ComponentState
        (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
     ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Lens
  (ComponentState
     (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
  ComponentIds
forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
childrenLens
  (ComponentState
     (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
  ComponentIds
-> LensCore (Maybe ()) ComponentIds
-> LensCore
     (Maybe ())
     (ComponentState
        (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
forall b c a. LensCore b c -> LensCore a b -> LensCore a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.Index ComponentIds
-> Lens ComponentIds (Maybe (IxValue ComponentIds))
forall at. At at => Index at -> Lens at (Maybe (IxValue at))
at Int
Index ComponentIds
_componentId LensCore
  (Maybe ())
  (ComponentState
     (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
-> Maybe ()
-> State
     (ComponentState
        (ZonkAny 58) (ZonkAny 59) (ZonkAny 60) (ZonkAny 61))
     ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Maybe ()
forall a. Maybe a
Nothing
  IORef
  (IntMap
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65)))
-> (IntMap
      (ComponentState
         (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
    -> (IntMap
          (ComponentState
             (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65)),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef
  (IntMap
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap
    (ComponentState
       (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
  -> (IntMap
        (ComponentState
           (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65)),
      ()))
 -> IO ())
-> (IntMap
      (ComponentState
         (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
    -> (IntMap
          (ComponentState
             (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65)),
        ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap
  (ComponentState
     (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
m -> (Int
-> IntMap
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
-> IntMap
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
_componentId IntMap
  (ComponentState
     (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
m, ())
  Int -> IO ()
FFI.unmountComponent Int
_componentId
-----------------------------------------------------------------------------
-- | Internal function for construction of a Virtual DOM.
--
-- Component mounting should be synchronous.
-- Mounting causes a recursive diffing to occur
-- (creating sub components as detected), setting up
-- infrastructure for each sub-component. During this
-- process we go between the Haskell heap and the JS heap.
buildVTree
  :: Eq model
  => Events
  -> ComponentId
  -> ComponentId
  -> Hydrate
  -> Sink action
  -> LogLevel
  -> View model action
  -> IO VTree
buildVTree :: forall model action.
Eq model =>
Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
buildVTree Events
events_ Int
parentId_ Int
vcompId Hydrate
hydrate Sink action
snk LogLevel
logLevel_ = \case
  VComp Maybe Key
maybeKey (SomeComponent props
newProps Component model props model action
app) -> do
    vcomp_ <- IO Object
create

    mountCallback <- do
      syncCallback1' $ \DOMRef
parent_ -> do
        ComponentState {..} <- Events
-> Int
-> Hydrate
-> Bool
-> props
-> Maybe Key
-> Component model props model action
-> IO DOMRef
-> IO (ComponentState model props model action)
forall parent model props action.
(Eq parent, Eq model, Eq props) =>
Events
-> Int
-> Hydrate
-> Bool
-> props
-> Maybe Key
-> Component parent props model action
-> IO DOMRef
-> IO (ComponentState parent props model action)
initialize Events
events_ Int
vcompId Hydrate
hydrate Bool
False props
newProps Maybe Key
maybeKey Component model props model action
app (DOMRef -> IO DOMRef
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DOMRef
parent_)
        modifyComponent vcompId (children %= IS.insert _componentId)
        vtree <- toJSVal =<< readIORef _componentVTree
        FFI.set "parent" vcomp_ (Object vtree)
        obj <- create
        setProp "componentId" _componentId obj
        setProp "componentTree" vtree obj
        toJSVal obj

    unmountCallback <- toJSVal =<< do
      FFI.syncCallback1 $ \DOMRef
vcompId_ -> do
        componentId_ <- DOMRef -> IO Int
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
vcompId_
        IM.lookup componentId_ <$> readIORef components >>= \case
          Maybe
  (ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action
componentState -> do
            Maybe action -> (action -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Component model props model action -> Maybe action
forall parent props model action.
Component parent props model action -> Maybe action
unmount Component model props model action
app) (ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action
-> action -> IO ()
forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSink ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action
componentState)
            ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action
-> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
unmountComponent ComponentState (ZonkAny 112) (ZonkAny 113) (ZonkAny 114) action
componentState

    -- When props are present, install a diffProps callback.
    -- Comparison happens in Haskell against _componentLastProps — no round-trip.
    -- TypeScript calls diffProps() unconditionally; Haskell decides whether to dispatch.
    diffPropsCallback <- toJSVal =<< do
      syncCallback $ do
        componentId_ <- fromJSValUnchecked =<< vcomp_ ! ("componentId" :: MisoString)
        currentProps <- _componentProps . (IM.! componentId_) <$> readIORef components
        when (currentProps /= newProps) $ do
          modifyComponent componentId_ $ do
            componentProps .= newProps
            prevComponentProps .= currentProps
          enqueueSchedule componentId_

    FFI.set "diffProps" diffPropsCallback vcomp_
    FFI.set "child" jsNull vcomp_
    forM_ maybeKey (\Key
key -> MisoString -> Key -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" Key
key Object
vcomp_)
    FFI.set "mount" mountCallback vcomp_
    FFI.set "unmount" unmountCallback vcomp_
    FFI.set "eventPropagation" (eventPropagation app) vcomp_
    FFI.set "type" VCompType vcomp_
    pure (VTree vcomp_)
  VNode Namespace
ns MisoString
tag [Attribute action]
attrs [View model action]
kids -> do
    vnode_ <- MisoString -> Namespace -> MisoString -> IO Object
createNode MisoString
"vnode" Namespace
ns MisoString
tag
    setAttrs vnode_ attrs snk logLevel_ events_
    vchildren <- toJSVal =<< procreate vnode_
    FFI.set "children" vchildren vnode_
    flip (FFI.set "type") vnode_ =<< toJSVal VNodeType
    pure (VTree vnode_)
      where
        procreate :: v -> IO [Object]
procreate v
parentVTree = do
          kidsViews <- ([Object] -> View model action -> IO [Object])
-> [Object] -> [View model action] -> IO [Object]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (v -> [Object] -> View model action -> IO [Object]
forall {model} {v}.
(Eq model, ToJSVal v) =>
v -> [Object] -> View model action -> IO [Object]
buildKid v
parentVTree) [] [View model action]
kids
          let ordered = [Object] -> [Object]
forall a. [a] -> [a]
reverse [Object]
kidsViews
          setNextSibling ordered
          pure ordered
            where
              setNextSibling :: [b] -> IO ()
setNextSibling [b]
xs =
                (b -> b -> IO ()) -> [b] -> [b] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ((b -> MisoString -> b -> IO ()) -> MisoString -> b -> b -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> MisoString -> b -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField MisoString
"nextSibling")
                  [b]
xs (Int -> [b] -> [b]
forall a. Int -> [a] -> [a]
drop Int
1 [b]
xs)
              buildKid :: v -> [Object] -> View model action -> IO [Object]
buildKid v
_ [Object]
acc (VFrag Maybe Key
_ []) = [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Object]
acc
              buildKid v
p [Object]
acc View model action
kid = do
                VTree child <- Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
forall model action.
Eq model =>
Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
buildVTree Events
events_ Int
parentId_ Int
vcompId Hydrate
hydrate Sink action
snk LogLevel
logLevel_ View model action
kid
                FFI.set "parent" p child
                pure (child : acc)
  VText Maybe Key
key MisoString
t -> do
    vtree <- IO Object
create
    flip (FFI.set "type") vtree =<< toJSVal VTextType
    forM_ key $ \Key
k -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" (Key -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Key
k) Object
vtree
    FFI.set "ns" ("text" :: MisoString) vtree
    FFI.set "text" t vtree
    pure (VTree vtree)
  VFrag Maybe Key
maybeKey [View model action]
kids -> do
    frag <- IO Object
create
    FFI.set "type" VFragType frag
    forM_ maybeKey $ \(Key MisoString
k) -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" MisoString
k Object
frag
    vchildren <- toJSVal =<< procreateFragChildren frag
    FFI.set "children" vchildren frag
    pure (VTree frag)
      where
        procreateFragChildren :: p -> IO [Object]
procreateFragChildren p
parentVTree = do
          kidsViews <- ([Object] -> View model action -> IO [Object])
-> [Object] -> [View model action] -> IO [Object]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM [Object] -> View model action -> IO [Object]
forall {model}.
Eq model =>
[Object] -> View model action -> IO [Object]
buildKid [] [View model action]
kids
          let ordered = [Object] -> [Object]
forall a. [a] -> [a]
reverse [Object]
kidsViews
          zipWithM_ (flip setField "nextSibling") ordered (drop 1 ordered)
          pure ordered
            where
              buildKid :: [Object] -> View model action -> IO [Object]
buildKid [Object]
acc (VFrag Maybe Key
_ []) = [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Object]
acc
              buildKid [Object]
acc View model action
kid = do
                VTree child <- Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
forall model action.
Eq model =>
Events
-> Int
-> Int
-> Hydrate
-> Sink action
-> LogLevel
-> View model action
-> IO VTree
buildVTree Events
events_ Int
parentId_ Int
vcompId Hydrate
hydrate Sink action
snk LogLevel
logLevel_ View model action
kid
                FFI.set "parent" parentVTree child
                pure (child : acc)
-----------------------------------------------------------------------------
-- | @createNode@
-- A helper function for constructing a vtree (used for @vcomp@ and @vnode@)
-- Doesn't handle children
createNode :: MisoString -> Namespace -> MisoString -> IO Object
createNode :: MisoString -> Namespace -> MisoString -> IO Object
createNode MisoString
typ Namespace
ns MisoString
tag = do
  vnode_ <- IO Object
create
  cssObj <- create
  propsObj <- create
  eventsObj <- create
  captures <- create
  bubbles <- create
  FFI.set "css" cssObj vnode_
  FFI.set "type" typ vnode_
  FFI.set "props" propsObj vnode_
  FFI.set "events" eventsObj vnode_
  FFI.set "captures" captures eventsObj
  FFI.set "bubbles" bubbles eventsObj
  FFI.set "ns" ns vnode_
  FFI.set "tag" tag vnode_
  pure vnode_
-----------------------------------------------------------------------------
-- | Helper function for populating "props" and "css" fields on a virtual
-- DOM node
setAttrs
  :: Object
  -> [Attribute action]
  -> Sink action
  -> LogLevel
  -> Events
  -> IO ()
setAttrs :: forall action.
Object
-> [Attribute action] -> Sink action -> LogLevel -> Events -> IO ()
setAttrs vnode_ :: Object
vnode_@(Object DOMRef
jval) [Attribute action]
attrs Sink action
snk LogLevel
logLevel Events
events =
  [Attribute action] -> (Attribute action -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Attribute action]
attrs ((Attribute action -> IO ()) -> IO ())
-> (Attribute action -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \case
    Property MisoString
"key" Value
v -> do
      value <- Value -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal Value
v
      FFI.set "key" value vnode_
    ClassList [MisoString]
classes ->
      DOMRef -> [MisoString] -> IO ()
FFI.populateClass DOMRef
jval [MisoString]
classes
    Property MisoString
k Value
v -> do
      value <- Value -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal Value
v
      o <- getProp "props" vnode_
      FFI.set k value (Object o)
    On Sink action -> VTree -> LogLevel -> Events -> IO ()
callback ->
      Sink action -> VTree -> LogLevel -> Events -> IO ()
callback Sink action
snk (Object -> VTree
VTree Object
vnode_) LogLevel
logLevel Events
events
    Styles Map MisoString MisoString
styles -> do
      cssObj <- MisoString -> Object -> IO DOMRef
forall o. ToObject o => MisoString -> o -> IO DOMRef
getProp MisoString
"css" Object
vnode_
      forM_ (M.toList styles) $ \(MisoString
k,MisoString
v) -> do
        MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
k MisoString
v (DOMRef -> Object
Object DOMRef
cssObj)
-----------------------------------------------------------------------------
-- | Registers components in the global state
registerComponent :: MonadIO m => ComponentState parent props model action -> m ()
registerComponent :: forall (m :: * -> *) parent props model action.
MonadIO m =>
ComponentState parent props model action -> m ()
registerComponent ComponentState parent props model action
componentState = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
  IORef (IntMap (ComponentState parent props model action))
-> (IntMap (ComponentState parent props model action)
    -> (IntMap (ComponentState parent props model action), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState parent props model action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap (ComponentState parent props model action)
  -> (IntMap (ComponentState parent props model action), ()))
 -> IO ())
-> (IntMap (ComponentState parent props model action)
    -> (IntMap (ComponentState parent props model action), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState parent props model action)
vcomps' ->
    (Int
-> ComponentState parent props model action
-> IntMap (ComponentState parent props model action)
-> IntMap (ComponentState parent props model action)
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert (ComponentState parent props model action -> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentId ComponentState parent props model action
componentState) ComponentState parent props model action
componentState IntMap (ComponentState parent props model action)
vcomps', ())
-----------------------------------------------------------------------------
-- | Renders styles
--
-- Meant for development purposes
-- Appends CSS to <head>
--
renderStyles :: [CSS] -> IO [DOMRef]
renderStyles :: [CSS] -> IO [DOMRef]
renderStyles [CSS]
styles =
  [CSS] -> (CSS -> IO DOMRef) -> IO [DOMRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CSS]
styles ((CSS -> IO DOMRef) -> IO [DOMRef])
-> (CSS -> IO DOMRef) -> IO [DOMRef]
forall a b. (a -> b) -> a -> b
$ \case
    Href MisoString
url Bool
cacheBust -> MisoString -> Bool -> IO DOMRef
FFI.addStyleSheet MisoString
url Bool
cacheBust
    Style MisoString
css -> MisoString -> IO DOMRef
FFI.addStyle MisoString
css
    Sheet StyleSheet
sheet -> MisoString -> IO DOMRef
FFI.addStyle (StyleSheet -> MisoString
renderStyleSheet StyleSheet
sheet)
-----------------------------------------------------------------------------
-- | Renders scripts
--
-- Meant for development purposes
-- Appends JS to <head>
--
renderScripts :: [JS] -> IO [DOMRef]
renderScripts :: [JS] -> IO [DOMRef]
renderScripts [JS]
scripts =
  [JS] -> (JS -> IO DOMRef) -> IO [DOMRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [JS]
scripts ((JS -> IO DOMRef) -> IO [DOMRef])
-> (JS -> IO DOMRef) -> IO [DOMRef]
forall a b. (a -> b) -> a -> b
$ \case
    Src MisoString
src Bool
cacheBust ->
      MisoString -> Bool -> IO DOMRef
FFI.addSrc MisoString
src Bool
cacheBust
    Script MisoString
script ->
      Bool -> MisoString -> IO DOMRef
FFI.addScript Bool
False MisoString
script
    Module MisoString
src ->
      Bool -> MisoString -> IO DOMRef
FFI.addScript Bool
True MisoString
src
    ImportMap [(MisoString, MisoString)]
importMap -> do
      o <- IO Object
create
      imports <- create
      forM_ importMap $ \(MisoString
k,MisoString
v) ->
        MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
k MisoString
v Object
imports
      FFI.set "imports" imports o
      FFI.addScriptImportMap
        =<< jsonStringify
        =<< toJSVal o
-----------------------------------------------------------------------------
-- | Starts a named 'Sub' dynamically, during the life of a t'Miso.Types.Component'.
-- The 'Sub' can be stopped by calling @Ord subKey => stop subKey@ from the 'update' function.
-- All 'Sub' started will be stopped if a t'Miso.Types.Component' is unmounted.
--
-- @
-- data SubType = LoggerSub | TimerSub
--   deriving (Eq, Ord)
--
-- update Action =
--   startSub LoggerSub $ \\sink -> forever (threadDelay (secs 1) >> consoleLog "test")
-- @
--
-- @since 1.9.0.0
startSub
  :: ToMisoString subKey
  => subKey
  -- ^ The key used to track the 'Sub'
  -> Sub action
  -- ^ The 'Sub'
  -> Effect parent props model action
startSub :: forall subKey action parent props model.
ToMisoString subKey =>
subKey -> Sub action -> Effect parent props model action
startSub subKey
subKey Sub action
sub = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    IM.lookup _componentInfoId <$> liftIO (readIORef components) >>= \case
      Maybe (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just compState :: ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action
compState@ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 5) (ZonkAny 7)]
Maybe Key
ZonkAny 6
ZonkAny 7
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
ZonkAny 6 -> ZonkAny 6 -> IO ()
ZonkAny 7 -> IO ()
ZonkAny 7 -> ZonkAny 7 -> Bool
Seq action
-> ZonkAny 7
-> IntMap
     (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action)
-> ZonkAny 6
-> (IntMap
      (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action),
    ZonkAny 7, [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 6
_prevComponentProps :: ZonkAny 6
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: ZonkAny 7
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 5) (ZonkAny 7)]
_componentMailbox :: Value -> Maybe action
_componentDraw :: ZonkAny 7 -> IO ()
_componentPropsPhase :: ZonkAny 6 -> ZonkAny 6 -> IO ()
_componentModelDirty :: ZonkAny 7 -> ZonkAny 7 -> Bool
_componentApplyActions :: Seq action
-> ZonkAny 7
-> IntMap
     (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action)
-> ZonkAny 6
-> (IntMap
      (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action),
    ZonkAny 7, [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        mtid <- IO (Maybe ThreadId) -> IO (Maybe ThreadId)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MisoString -> Map MisoString ThreadId -> Maybe ThreadId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (subKey -> MisoString
forall str. ToMisoString str => str -> MisoString
ms subKey
subKey) (Map MisoString ThreadId -> Maybe ThreadId)
-> IO (Map MisoString ThreadId) -> IO (Maybe ThreadId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map MisoString ThreadId) -> IO (Map MisoString ThreadId)
forall a. IORef a -> IO a
readIORef IORef (Map MisoString ThreadId)
_componentSubThreads)
        case mtid of
          Maybe ThreadId
Nothing ->
            ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action
compState
          Just ThreadId
tid -> do
            status <- ThreadId -> IO ThreadStatus
threadStatus ThreadId
tid
            case status of
              ThreadStatus
ThreadFinished -> ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action
compState
              ThreadStatus
ThreadDied -> ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) action
compState
              ThreadStatus
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    startThread :: ComponentState parent props model action -> IO ()
startThread ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
      tid <- IO () -> IO ThreadId
forkIO (Sub action
sub action -> IO ()
_componentSink)
      atomicModifyIORef' _componentSubThreads $ \Map MisoString ThreadId
m ->
        (MisoString
-> ThreadId -> Map MisoString ThreadId -> Map MisoString ThreadId
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (subKey -> MisoString
forall str. ToMisoString str => str -> MisoString
ms subKey
subKey) ThreadId
tid Map MisoString ThreadId
m, ())
-----------------------------------------------------------------------------
-- | Stops a named 'Sub' dynamically, during the life of a t'Miso.Types.Component'.
-- All 'Sub' started will be stopped automatically if a t'Miso.Types.Component' is unmounted.
--
-- @
-- data SubType = LoggerSub | TimerSub
--   deriving (Eq, Ord)
--
-- update Action = do
--   stopSub LoggerSub
-- @
--
-- @since 1.9.0.0
stopSub
  :: ToMisoString subKey
  => subKey
  -- ^ The key used to stop the 'Sub'
  -> Effect parent props model action
stopSub :: forall subKey parent props model action.
ToMisoString subKey =>
subKey -> Effect parent props model action
stopSub subKey
subKey = do
  vcompId <- (ComponentInfo parent props -> Int)
-> RWST
     (ComponentInfo parent props) [Schedule action] model Identity Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ComponentInfo parent props -> Int
forall parent props. ComponentInfo parent props -> Int
_componentInfoId
  io_ $ do
    IM.lookup vcompId <$> readIORef components >>= \case
      Maybe
  (ComponentState (ZonkAny 8) (ZonkAny 9) (ZonkAny 10) (ZonkAny 11))
Nothing -> do
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 8) (ZonkAny 10)]
Maybe Key
ZonkAny 9
ZonkAny 10
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 9 -> ZonkAny 9 -> IO ()
ZonkAny 10 -> IO ()
ZonkAny 10 -> ZonkAny 10 -> Bool
ZonkAny 11 -> IO ()
Seq (ZonkAny 11)
-> ZonkAny 10
-> IntMap
     (ComponentState (ZonkAny 8) (ZonkAny 9) (ZonkAny 10) (ZonkAny 11))
-> ZonkAny 9
-> (IntMap
      (ComponentState (ZonkAny 8) (ZonkAny 9) (ZonkAny 10) (ZonkAny 11)),
    ZonkAny 10, [Schedule (ZonkAny 11)], ComponentIds)
Value -> Maybe (ZonkAny 11)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 9
_prevComponentProps :: ZonkAny 9
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 11 -> IO ()
_componentModel :: ZonkAny 10
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 8) (ZonkAny 10)]
_componentMailbox :: Value -> Maybe (ZonkAny 11)
_componentDraw :: ZonkAny 10 -> IO ()
_componentPropsPhase :: ZonkAny 9 -> ZonkAny 9 -> IO ()
_componentModelDirty :: ZonkAny 10 -> ZonkAny 10 -> Bool
_componentApplyActions :: Seq (ZonkAny 11)
-> ZonkAny 10
-> IntMap
     (ComponentState (ZonkAny 8) (ZonkAny 9) (ZonkAny 10) (ZonkAny 11))
-> ZonkAny 9
-> (IntMap
      (ComponentState (ZonkAny 8) (ZonkAny 9) (ZonkAny 10) (ZonkAny 11)),
    ZonkAny 10, [Schedule (ZonkAny 11)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        mtid <- IO (Maybe ThreadId) -> IO (Maybe ThreadId)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (MisoString -> Map MisoString ThreadId -> Maybe ThreadId
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (subKey -> MisoString
forall str. ToMisoString str => str -> MisoString
ms subKey
subKey) (Map MisoString ThreadId -> Maybe ThreadId)
-> IO (Map MisoString ThreadId) -> IO (Maybe ThreadId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Map MisoString ThreadId) -> IO (Map MisoString ThreadId)
forall a. IORef a -> IO a
readIORef IORef (Map MisoString ThreadId)
_componentSubThreads)
        forM_ mtid $ \ThreadId
tid ->
          IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            IORef (Map MisoString ThreadId)
-> (Map MisoString ThreadId -> (Map MisoString ThreadId, ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Map MisoString ThreadId)
_componentSubThreads ((Map MisoString ThreadId -> (Map MisoString ThreadId, ()))
 -> IO ())
-> (Map MisoString ThreadId -> (Map MisoString ThreadId, ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Map MisoString ThreadId
m -> (MisoString -> Map MisoString ThreadId -> Map MisoString ThreadId
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (subKey -> MisoString
forall str. ToMisoString str => str -> MisoString
ms subKey
subKey) Map MisoString ThreadId
m, ())
            ThreadId -> IO ()
killThread ThreadId
tid
-----------------------------------------------------------------------------
-- | Send any @ToJSON message => message@ to a t'Miso.Types.Component' mailbox, by 'ComponentId'
--
-- @
-- io_ $ mail componentId ("test message" :: MisoString) :: Effect parent props model action
-- @
--
-- @since 1.9.0.0
mail
  :: ToJSON message
  => ComponentId
  -- ^ 'ComponentId' to receive 'mail'
  -> message
  -- ^ The message to send
  -> IO ()
mail :: forall message. ToJSON message => Int -> message -> IO ()
mail Int
vcompId message
msg =
  Int
-> IntMap
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
-> Maybe
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
 -> Maybe
      (ComponentState
         (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO
  (Maybe
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)))
-> (Maybe
      (ComponentState
         (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe
  (ComponentState
     (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ComponentState{Bool
Int
[DOMRef]
[Binding (ZonkAny 12) (ZonkAny 14)]
Maybe Key
ZonkAny 13
ZonkAny 14
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 13 -> ZonkAny 13 -> IO ()
ZonkAny 14 -> IO ()
ZonkAny 14 -> ZonkAny 14 -> Bool
ZonkAny 15 -> IO ()
Seq (ZonkAny 15)
-> ZonkAny 14
-> IntMap
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
-> ZonkAny 13
-> (IntMap
      (ComponentState
         (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)),
    ZonkAny 14, [Schedule (ZonkAny 15)], ComponentIds)
Value -> Maybe (ZonkAny 15)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 13
_prevComponentProps :: ZonkAny 13
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 15 -> IO ()
_componentModel :: ZonkAny 14
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 12) (ZonkAny 14)]
_componentMailbox :: Value -> Maybe (ZonkAny 15)
_componentDraw :: ZonkAny 14 -> IO ()
_componentPropsPhase :: ZonkAny 13 -> ZonkAny 13 -> IO ()
_componentModelDirty :: ZonkAny 14 -> ZonkAny 14 -> Bool
_componentApplyActions :: Seq (ZonkAny 15)
-> ZonkAny 14
-> IntMap
     (ComponentState
        (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
-> ZonkAny 13
-> (IntMap
      (ComponentState
         (ZonkAny 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15)),
    ZonkAny 14, [Schedule (ZonkAny 15)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
      case Value -> Maybe (ZonkAny 15)
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
        Maybe (ZonkAny 15)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ZonkAny 15
action ->
          ZonkAny 15 -> IO ()
_componentSink ZonkAny 15
action
-----------------------------------------------------------------------------
-- | Send any @ToJSON message => message@ to the parent's t'Miso.Types.Component' mailbox
--
-- @
-- mailParent ("test message" :: MisoString) :: Effect parent props model action
-- @
--
-- @since 1.9.0.0
mailParent
  :: ToJSON message
  => message
  -- ^ Message to send
  -> Effect parent props model action
mailParent :: forall message parent props model action.
ToJSON message =>
message -> Effect parent props model action
mailParent message
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ (mail _componentInfoParentId msg)
-----------------------------------------------------------------------------
-- | Send any @ToJSON message => message@ to all ancestor t'Miso.Types.Component' 'mailbox'.
--
-- This function walks the t'Miso.Types.Component' ancestor hierarchy, delivering mail
-- along the way.
--
-- @
-- mailAncestors ("test message" :: MisoString) :: Effect parent props model action
-- @
--
-- @since 1.11.0.0
mailAncestors
  :: ToJSON message
  => message
  -- ^ Message to send
  -> Effect parent props model action
mailAncestors :: forall message parent props model action.
ToJSON message =>
message -> Effect parent props model action
mailAncestors message
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ (climb _componentInfoParentId)
    where
      climb :: Int -> IO ()
climb Int
vcompId = do
        Int -> message -> IO ()
forall message. ToJSON message => Int -> message -> IO ()
mail Int
vcompId message
msg
        Int
-> IntMap
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
-> Maybe
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
 -> Maybe
      (ComponentState
         (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO
  (Maybe
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)))
-> (Maybe
      (ComponentState
         (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe
  (ComponentState
     (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)
cs -> Int -> IO ()
climb (ComponentState (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)
-> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentParentId ComponentState (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)
cs)
-----------------------------------------------------------------------------
-- | Send any @ToJSON message => message@ to the children's t'Miso.Types.Component' mailbox
--
-- N.B. this is only relevant for immediate descendants (not all descendants).
--
-- @
-- mailChildren ("test message" :: MisoString) :: Effect parent props model action
-- @
--
-- @since 1.9.0.0
mailChildren
  :: ToJSON message
  => message
  -- ^ Message to send
  -> Effect parent props model action
mailChildren :: forall message parent props model action.
ToJSON message =>
message -> Effect parent props model action
mailChildren message
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    ComponentState {..} <- (IM.! _componentInfoId) <$> readIORef components
    forM_ (IS.toList _componentChildren) (flip mail msg)
-----------------------------------------------------------------------------
-- | Send any @ToJSON message => message@ to all descendants t'Miso.Types.Component' mailbox
--
-- Unlike 'mailChildren', this is relevant for all descendants 'Component'.
--
-- @
-- mailDescendants ("test message" :: MisoString) :: Effect parent props model action
-- @
--
-- @since 1.12.0.0
mailDescendants
  :: ToJSON message
  => message
  -- ^ Message to send
  -> Effect parent props model action
mailDescendants :: forall message parent props model action.
ToJSON message =>
message -> Effect parent props model action
mailDescendants message
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    cs <- (IM.! _componentInfoId) <$> readIORef components
    forM_ (IS.toList (_componentChildren cs)) $ \Int
child -> do
      ComponentState (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)
-> IO ()
forall {parent} {props} {model} {action}.
ComponentState parent props model action -> IO ()
walk (ComponentState (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)
 -> IO ())
-> (IntMap
      (ComponentState
         (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31))
    -> ComponentState
         (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31))
-> IntMap
     (ComponentState
        (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (IntMap
  (ComponentState
     (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31))
-> Int
-> ComponentState
     (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)
forall a. IntMap a -> Int -> a
IM.! Int
child) (IntMap
   (ComponentState
      (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31))
 -> IO ())
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef
  (IntMap
     (ComponentState
        (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 28) (ZonkAny 29) (ZonkAny 30) (ZonkAny 31)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
  where
    walk :: ComponentState parent props model action -> IO ()
walk ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
Maybe Key
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: props
_prevComponentProps :: props
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentPropsPhase :: props -> props -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = do
      Int -> message -> IO ()
forall message. ToJSON message => Int -> message -> IO ()
mail Int
_componentId message
msg
      [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ComponentIds -> [Int]
IS.toList ComponentIds
_componentChildren) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
child -> do
        ComponentState parent props model action -> IO ()
walk (ComponentState parent props model action -> IO ())
-> (IntMap (ComponentState parent props model action)
    -> ComponentState parent props model action)
-> IntMap (ComponentState parent props model action)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (IntMap (ComponentState parent props model action)
-> Int -> ComponentState parent props model action
forall a. IntMap a -> Int -> a
IM.! Int
child) (IntMap (ComponentState parent props model action) -> IO ())
-> IO (IntMap (ComponentState parent props model action)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef (IntMap (ComponentState parent props model action))
-> IO (IntMap (ComponentState parent props model action))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState parent props model action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
----------------------------------------------------------------------------
-- | Helper function for processing @Mail@ from 'mail'.
--
-- @
--
-- data Action
--   = ParsedMail Message
--   | ErrorMail MisoString
--
-- main :: IO ()
-- main = app { mailbox = checkMail ParsedMail ErrorMail }
-- @
--
-- @since 1.9.0.0
checkMail
  :: FromJSON value
  => (value -> action)
  -- ^ Successful callback
  -> (MisoString -> action)
  -- ^ Errorful callback
  -> Value
  -- ^ The message received to parse.
  -> Maybe action
checkMail :: forall value action.
FromJSON value =>
(value -> action)
-> (MisoString -> action) -> Value -> Maybe action
checkMail value -> action
successful MisoString -> action
errorful Value
value =
  action -> Maybe action
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (action -> Maybe action) -> action -> Maybe action
forall a b. (a -> b) -> a -> b
$ case Value -> Result value
forall a. FromJSON a => Value -> Result a
fromJSON Value
value of
    Success value
x -> value -> action
successful value
x
    Error MisoString
err -> MisoString -> action
errorful (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
err)
-----------------------------------------------------------------------------
-- | Fetches the parent `model` from the child (if @parent@ exists).
--
-- N.B. this is a no-op for 'ROOT'.
--
-- @since 1.9.0.0
parent
  :: (parent -> action)
  -- ^ Successful callback
  -> action
  -- ^ Errorful callback
  -> Effect parent props model action
parent :: forall parent action props model.
(parent -> action) -> action -> Effect parent props model action
parent parent -> action
successful action
errorful = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  withSink $ \Sink action
sink -> do
    Int
-> IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
-> Maybe
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentInfoParentId (IntMap
   (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
 -> Maybe
      (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
-> IO
     (Maybe
        (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO
  (IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef
  (IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components) IO
  (Maybe
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)))
-> (Maybe
      (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe
  (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
Nothing -> Sink action
sink action
errorful
      Just ComponentState {parent
Bool
Int
[DOMRef]
[Binding (ZonkAny 32) parent]
Maybe Key
ZonkAny 33
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
parent -> IO ()
parent -> parent -> Bool
ZonkAny 33 -> ZonkAny 33 -> IO ()
ZonkAny 34 -> IO ()
Seq (ZonkAny 34)
-> parent
-> IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
-> ZonkAny 33
-> (IntMap
      (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)),
    parent, [Schedule (ZonkAny 34)], ComponentIds)
Value -> Maybe (ZonkAny 34)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 33
_prevComponentProps :: ZonkAny 33
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 34 -> IO ()
_componentModel :: parent
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 32) parent]
_componentMailbox :: Value -> Maybe (ZonkAny 34)
_componentDraw :: parent -> IO ()
_componentPropsPhase :: ZonkAny 33 -> ZonkAny 33 -> IO ()
_componentModelDirty :: parent -> parent -> Bool
_componentApplyActions :: Seq (ZonkAny 34)
-> parent
-> IntMap
     (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34))
-> ZonkAny 33
-> (IntMap
      (ComponentState (ZonkAny 32) (ZonkAny 33) parent (ZonkAny 34)),
    parent, [Schedule (ZonkAny 34)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        Sink action
sink (parent -> action
successful parent
_componentModel)
-----------------------------------------------------------------------------
-- | Sends a message to all t'Miso.Types.Component' 'mailbox', excluding oneself.
--
-- @
--
-- update :: action -> Effect parent props model action
-- update _ = broadcast (String "public service announcement")
-- @
--
-- @since 1.9.0.0
broadcast
  :: Eq model
  => ToJSON message
  => message
  -- ^ Message to broadcast to all other 'Component'
  -> Effect parent props model action
broadcast :: forall model message parent props action.
(Eq model, ToJSON message) =>
message -> Effect parent props model action
broadcast message
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    vcompIds <- IM.keys <$> readIORef components
    forM_ vcompIds $ \Int
vcompId ->
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
_componentInfoId Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
vcompId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Int
-> IntMap
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
-> Maybe
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
 -> Maybe
      (ComponentState
         (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO
  (Maybe
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)))
-> (Maybe
      (ComponentState
         (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
    -> IO ())
-> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe
  (ComponentState
     (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState{Bool
Int
[DOMRef]
[Binding (ZonkAny 39) (ZonkAny 41)]
Maybe Key
ZonkAny 40
ZonkAny 41
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
ZonkAny 40 -> ZonkAny 40 -> IO ()
ZonkAny 41 -> IO ()
ZonkAny 41 -> ZonkAny 41 -> Bool
ZonkAny 42 -> IO ()
Seq (ZonkAny 42)
-> ZonkAny 41
-> IntMap
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
-> ZonkAny 40
-> (IntMap
      (ComponentState
         (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)),
    ZonkAny 41, [Schedule (ZonkAny 42)], ComponentIds)
Value -> Maybe (ZonkAny 42)
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_componentKey :: forall parent props model action.
ComponentState parent props model action -> Maybe Key
_componentMailbox :: forall parent props model action.
ComponentState parent props model action -> Value -> Maybe action
_componentBindings :: forall parent props model action.
ComponentState parent props model action -> [Binding parent model]
_componentTopics :: forall parent props model action.
ComponentState parent props model action
-> Map MisoString (Value -> IO ())
_componentModelDirty :: forall parent props model action.
ComponentState parent props model action -> model -> model -> Bool
_componentChildren :: forall parent props model action.
ComponentState parent props model action -> ComponentIds
_prevComponentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentPropsPhase :: forall parent props model action.
ComponentState parent props model action -> props -> props -> IO ()
_componentApplyActions :: forall parent props model action.
ComponentState parent props model action
-> Seq action
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentId :: Int
_componentKey :: Maybe Key
_componentParentId :: Int
_componentProps :: ZonkAny 40
_prevComponentProps :: ZonkAny 40
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 42 -> IO ()
_componentModel :: ZonkAny 41
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 39) (ZonkAny 41)]
_componentMailbox :: Value -> Maybe (ZonkAny 42)
_componentDraw :: ZonkAny 41 -> IO ()
_componentPropsPhase :: ZonkAny 40 -> ZonkAny 40 -> IO ()
_componentModelDirty :: ZonkAny 41 -> ZonkAny 41 -> Bool
_componentApplyActions :: Seq (ZonkAny 42)
-> ZonkAny 41
-> IntMap
     (ComponentState
        (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42))
-> ZonkAny 40
-> (IntMap
      (ComponentState
         (ZonkAny 39) (ZonkAny 40) (ZonkAny 41) (ZonkAny 42)),
    ZonkAny 41, [Schedule (ZonkAny 42)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
            case Value -> Maybe (ZonkAny 42)
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
              Maybe (ZonkAny 42)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just ZonkAny 42
action -> ZonkAny 42 -> IO ()
_componentSink ZonkAny 42
action
-----------------------------------------------------------------------------
type Socket = JSVal
-----------------------------------------------------------------------------
type WebSockets = IM.IntMap (IM.IntMap Socket)
-----------------------------------------------------------------------------
type EventSources = IM.IntMap (IM.IntMap Socket)
-----------------------------------------------------------------------------
websocketConnections :: IORef WebSockets
{-# NOINLINE websocketConnections #-}
websocketConnections :: IORef WebSockets
websocketConnections = IO (IORef WebSockets) -> IORef WebSockets
forall a. IO a -> a
unsafePerformIO (WebSockets -> IO (IORef WebSockets)
forall a. a -> IO (IORef a)
newIORef WebSockets
forall a. IntMap a
IM.empty)
-----------------------------------------------------------------------------
websocketConnectionIds :: IORef Int
{-# NOINLINE websocketConnectionIds #-}
websocketConnectionIds :: IORef Int
websocketConnectionIds = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int))
-----------------------------------------------------------------------------
websocketConnectText
  :: URL
  -- ^ t'WebSocket' 'URL'
  -> (WebSocket -> action)
  -- ^ onOpen
  -> (Closed -> action)
  -- ^ onClosed
  -> (MisoString -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
websocketConnectText :: forall action parent props model.
MisoString
-> (WebSocket -> action)
-> (Closed -> action)
-> (MisoString -> action)
-> (MisoString -> action)
-> Effect parent props model action
websocketConnectText MisoString
url WebSocket -> action
onOpen Closed -> action
onClosed MisoString -> action
onMessage MisoString -> action
onError =
  (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.websocketConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ WebSocket -> action
onOpen WebSocket
webSocketId)
      (Sink action
sink Sink action -> (Closed -> action) -> Closed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Closed -> action
onClosed (Closed -> IO ()) -> (DOMRef -> IO Closed) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO Closed
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onMessage (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked))
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
True
-----------------------------------------------------------------------------
websocketConnectBLOB
  :: URL
  -- ^ t'WebSocket' 'URL'
  -> (WebSocket -> action)
  -- ^ onOpen
  -> (Closed -> action)
  -- ^ onClosed
  -> (Blob -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
websocketConnectBLOB :: forall action parent props model.
MisoString
-> (WebSocket -> action)
-> (Closed -> action)
-> (Blob -> action)
-> (MisoString -> action)
-> Effect parent props model action
websocketConnectBLOB MisoString
url WebSocket -> action
onOpen Closed -> action
onClosed Blob -> action
onMessage MisoString -> action
onError =
  (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.websocketConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ WebSocket -> action
onOpen WebSocket
webSocketId)
      (Sink action
sink Sink action -> (Closed -> action) -> Closed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Closed -> action
onClosed (Closed -> IO ()) -> (DOMRef -> IO Closed) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO Closed
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Blob -> action
onMessage (Blob -> action) -> (DOMRef -> Blob) -> DOMRef -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DOMRef -> Blob
Blob))
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
False
-----------------------------------------------------------------------------
websocketConnectArrayBuffer
  :: URL
  -- ^ t'WebSocket' 'URL'
  -> (WebSocket -> action)
  -- ^ onOpen
  -> (Closed -> action)
  -- ^ onClosed
  -> (ArrayBuffer -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
websocketConnectArrayBuffer :: forall action parent props model.
MisoString
-> (WebSocket -> action)
-> (Closed -> action)
-> (ArrayBuffer -> action)
-> (MisoString -> action)
-> Effect parent props model action
websocketConnectArrayBuffer MisoString
url WebSocket -> action
onOpen Closed -> action
onClosed ArrayBuffer -> action
onMessage MisoString -> action
onError =
  (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.websocketConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ WebSocket -> action
onOpen WebSocket
webSocketId)
      (Sink action
sink Sink action -> (Closed -> action) -> Closed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Closed -> action
onClosed (Closed -> IO ()) -> (DOMRef -> IO Closed) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO Closed
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrayBuffer -> action
onMessage (ArrayBuffer -> action)
-> (DOMRef -> ArrayBuffer) -> DOMRef -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DOMRef -> ArrayBuffer
ArrayBuffer))
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
False
-----------------------------------------------------------------------------
websocketConnectJSON
  :: FromJSON json
  => URL
  -- ^ WebSocket URL
  -> (WebSocket -> action)
  -- ^ onOpen
  -> (Closed -> action)
  -- ^ onClosed
  -> (json -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
websocketConnectJSON :: forall json action parent props model.
FromJSON json =>
MisoString
-> (WebSocket -> action)
-> (Closed -> action)
-> (json -> action)
-> (MisoString -> action)
-> Effect parent props model action
websocketConnectJSON MisoString
url WebSocket -> action
onOpen Closed -> action
onClosed json -> action
onMessage MisoString -> action
onError =
  (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.websocketConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ WebSocket -> action
onOpen WebSocket
webSocketId)
      (Sink action
sink Sink action -> (Closed -> action) -> Closed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Closed -> action
onClosed (Closed -> IO ()) -> (DOMRef -> IO Closed) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO Closed
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\DOMRef
bytes -> do
          value :: Value <- DOMRef -> IO Value
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
bytes
          case fromJSON value of
            Error MisoString
msg -> Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ MisoString -> action
onError (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
msg)
            Success json
x -> Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ json -> action
onMessage json
x))
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
False
-----------------------------------------------------------------------------
websocketConnect
  :: FromJSON json
  => URL
  -- ^ WebSocket URL
  -> (WebSocket -> action)
  -- ^ onOpen
  -> (Closed -> action)
  -- ^ onClosed
  -> (Payload json -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
websocketConnect :: forall json action parent props model.
FromJSON json =>
MisoString
-> (WebSocket -> action)
-> (Closed -> action)
-> (Payload json -> action)
-> (MisoString -> action)
-> Effect parent props model action
websocketConnect MisoString
url WebSocket -> action
onOpen Closed -> action
onClosed Payload json -> action
onMessage MisoString -> action
onError =
  (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.websocketConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ WebSocket -> action
onOpen WebSocket
webSocketId)
      (Sink action
sink Sink action -> (Closed -> action) -> Closed -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Closed -> action
onClosed (Closed -> IO ()) -> (DOMRef -> IO Closed) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO Closed
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Payload json -> action
onMessage (Payload json -> action)
-> (MisoString -> Payload json) -> MisoString -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> Payload json
forall value. MisoString -> Payload value
TEXT (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked))
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\DOMRef
bytes -> do
          value :: Value <- DOMRef -> IO Value
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
bytes
          case fromJSON value of
            Error MisoString
msg -> Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ MisoString -> action
onError (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
msg)
            Success json
x -> Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ Payload json -> action
onMessage (json -> Payload json
forall value. value -> Payload value
JSON json
x)))
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Payload json -> action
onMessage (Payload json -> action)
-> (DOMRef -> Payload json) -> DOMRef -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Blob -> Payload json
forall value. Blob -> Payload value
BLOB (Blob -> Payload json)
-> (DOMRef -> Blob) -> DOMRef -> Payload json
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DOMRef -> Blob
Blob))
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (DOMRef -> action) -> DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Payload json -> action
onMessage (Payload json -> action)
-> (DOMRef -> Payload json) -> DOMRef -> action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrayBuffer -> Payload json
forall value. ArrayBuffer -> Payload value
BUFFER (ArrayBuffer -> Payload json)
-> (DOMRef -> ArrayBuffer) -> DOMRef -> Payload json
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DOMRef -> ArrayBuffer
ArrayBuffer))
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
False
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/WebSocket>
websocketCore
  :: (WebSocket -> Sink action -> IO Socket)
  -> Effect parent props model action
websocketCore :: forall action parent props model.
(WebSocket -> Sink action -> IO DOMRef)
-> Effect parent props model action
websocketCore WebSocket -> Sink action -> IO DOMRef
core = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  withSink $ \Sink action
sink -> do
    webSocketId <- IO WebSocket
freshWebSocket
    socket <- core webSocketId sink
    insertWebSocket _componentInfoId webSocketId socket
  where
    insertWebSocket :: ComponentId -> WebSocket -> Socket -> IO ()
    insertWebSocket :: Int -> WebSocket -> DOMRef -> IO ()
insertWebSocket Int
componentId_ (WebSocket Int
socketId) DOMRef
socket =
      IORef WebSockets -> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
websocketConnections ((WebSockets -> (WebSockets, ())) -> IO ())
-> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebSockets
websockets ->
          (WebSockets -> WebSockets
update WebSockets
websockets, ())
      where
        update :: WebSockets -> WebSockets
update WebSockets
websockets =
          (IntMap DOMRef -> IntMap DOMRef -> IntMap DOMRef)
-> WebSockets -> WebSockets -> WebSockets
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith IntMap DOMRef -> IntMap DOMRef -> IntMap DOMRef
forall a. IntMap a -> IntMap a -> IntMap a
IM.union WebSockets
websockets
            (WebSockets -> WebSockets) -> WebSockets -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> IntMap DOMRef -> WebSockets
forall a. Int -> a -> IntMap a
IM.singleton Int
componentId_
            (IntMap DOMRef -> WebSockets) -> IntMap DOMRef -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> DOMRef -> IntMap DOMRef
forall a. Int -> a -> IntMap a
IM.singleton Int
socketId DOMRef
socket

    freshWebSocket :: IO WebSocket
    freshWebSocket :: IO WebSocket
freshWebSocket = Int -> WebSocket
WebSocket (Int -> WebSocket) -> IO Int -> IO WebSocket
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
websocketConnectionIds (\Int
x -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
x))
-----------------------------------------------------------------------------
getWebSocket :: ComponentId -> WebSocket -> WebSockets -> Maybe Socket
getWebSocket :: Int -> WebSocket -> WebSockets -> Maybe DOMRef
getWebSocket Int
vcompId (WebSocket Int
websocketId) =
  Int -> IntMap DOMRef -> Maybe DOMRef
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
websocketId (IntMap DOMRef -> Maybe DOMRef)
-> (WebSockets -> Maybe (IntMap DOMRef))
-> WebSockets
-> Maybe DOMRef
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId
-----------------------------------------------------------------------------
finalizeWebSockets :: ComponentId -> IO ()
finalizeWebSockets :: Int -> IO ()
finalizeWebSockets Int
vcompId = do
  (IntMap DOMRef -> IO ()) -> Maybe (IntMap DOMRef) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((DOMRef -> IO ()) -> [DOMRef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DOMRef -> IO ()
FFI.websocketClose ([DOMRef] -> IO ())
-> (IntMap DOMRef -> [DOMRef]) -> IntMap DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntMap DOMRef -> [DOMRef]
forall a. IntMap a -> [a]
IM.elems) (Maybe (IntMap DOMRef) -> IO ())
-> (WebSockets -> Maybe (IntMap DOMRef)) -> WebSockets -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> IO ()) -> IO WebSockets -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef WebSockets -> IO WebSockets
forall a. IORef a -> IO a
readIORef IORef WebSockets
websocketConnections
  IO ()
dropComponentWebSockets
    where
      dropComponentWebSockets :: IO ()
      dropComponentWebSockets :: IO ()
dropComponentWebSockets =
        IORef WebSockets -> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
websocketConnections ((WebSockets -> (WebSockets, ())) -> IO ())
-> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebSockets
websockets ->
          (Int -> WebSockets -> WebSockets
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
vcompId WebSockets
websockets, ())
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/close>
websocketClose :: WebSocket -> Effect parent props model action
websocketClose :: forall parent props model action.
WebSocket -> Effect parent props model action
websocketClose WebSocket
socketId = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    result <-
      atomicModifyIORef' websocketConnections $ \WebSockets
imap ->
        Int -> WebSocket -> WebSockets -> WebSockets
dropWebSocket Int
_componentInfoId WebSocket
socketId WebSockets
imap WebSockets -> Maybe DOMRef -> (WebSockets, Maybe DOMRef)
forall k v. k -> v -> (k, v)
=:
          Int -> WebSocket -> WebSockets -> Maybe DOMRef
getWebSocket Int
_componentInfoId WebSocket
socketId WebSockets
imap
    case result of
      Maybe DOMRef
Nothing ->
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just DOMRef
socket ->
        DOMRef -> IO ()
FFI.websocketClose DOMRef
socket
  where
    dropWebSocket :: ComponentId -> WebSocket -> WebSockets -> WebSockets
    dropWebSocket :: Int -> WebSocket -> WebSockets -> WebSockets
dropWebSocket Int
vcompId (WebSocket Int
websocketId) WebSockets
websockets = do
      case Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId WebSockets
websockets of
        Maybe (IntMap DOMRef)
Nothing ->
          WebSockets
websockets
        Just IntMap DOMRef
componentSockets ->
          Int -> IntMap DOMRef -> WebSockets -> WebSockets
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
vcompId (Int -> IntMap DOMRef -> IntMap DOMRef
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
websocketId IntMap DOMRef
componentSockets) WebSockets
websockets
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/WebSocket/send>
websocketSend
  :: ToJSON value
  => WebSocket
  -> Payload value
  -> Effect parent props model action
websocketSend :: forall value parent props model action.
ToJSON value =>
WebSocket -> Payload value -> Effect parent props model action
websocketSend WebSocket
socketId Payload value
msg = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    getWebSocket _componentInfoId socketId <$> readIORef websocketConnections >>= \case
      Maybe DOMRef
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just DOMRef
socket ->
        case Payload value
msg of
          JSON value
json_ ->
            DOMRef -> DOMRef -> IO ()
FFI.websocketSend DOMRef
socket (DOMRef -> IO ()) -> IO DOMRef -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal (value -> MisoString
forall a. ToJSON a => a -> MisoString
encode value
json_)
          BUFFER ArrayBuffer
arrayBuffer_ -> do
            DOMRef -> DOMRef -> IO ()
FFI.websocketSend DOMRef
socket (DOMRef -> IO ()) -> IO DOMRef -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArrayBuffer -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal ArrayBuffer
arrayBuffer_
          TEXT MisoString
txt ->
            DOMRef -> DOMRef -> IO ()
FFI.websocketSend DOMRef
socket (DOMRef -> IO ()) -> IO DOMRef -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal MisoString
txt
          BLOB Blob
blob_ ->
            DOMRef -> DOMRef -> IO ()
FFI.websocketSend DOMRef
socket (DOMRef -> IO ()) -> IO DOMRef -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Blob -> IO DOMRef
forall a. ToJSVal a => a -> IO DOMRef
toJSVal Blob
blob_
-----------------------------------------------------------------------------
-- | Retrieves current status of t'WebSocket'
--
-- If the t'WebSocket' identifier does not exist a 'CLOSED' is returned.
--
socketState :: WebSocket -> (SocketState -> action) -> Effect parent props model action
socketState :: forall action parent props model.
WebSocket
-> (SocketState -> action) -> Effect parent props model action
socketState WebSocket
socketId SocketState -> action
callback = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  withSink $ \Sink action
sink -> do
     Int -> WebSocket -> WebSockets -> Maybe DOMRef
getWebSocket Int
_componentInfoId WebSocket
socketId (WebSockets -> Maybe DOMRef) -> IO WebSockets -> IO (Maybe DOMRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef WebSockets -> IO WebSockets
forall a. IORef a -> IO a
readIORef IORef WebSockets
websocketConnections IO (Maybe DOMRef) -> (Maybe DOMRef -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just DOMRef
socket -> do
        x <- DOMRef
socket DOMRef -> MisoString -> IO DOMRef
forall o. ToObject o => o -> MisoString -> IO DOMRef
! (MisoString
"socketState" :: MisoString)
        socketstate <- toEnum <$> fromJSValUnchecked x
        sink (callback socketstate)
      Maybe DOMRef
Nothing ->
        Sink action
sink (SocketState -> action
callback SocketState
CLOSED)
-----------------------------------------------------------------------------
codeToCloseCode :: Int -> CloseCode
codeToCloseCode :: Int -> CloseCode
codeToCloseCode = \case
  Int
1000 -> CloseCode
CLOSE_NORMAL
  Int
1001 -> CloseCode
CLOSE_GOING_AWAY
  Int
1002 -> CloseCode
CLOSE_PROTOCOL_ERROR
  Int
1003 -> CloseCode
CLOSE_UNSUPPORTED
  Int
1005 -> CloseCode
CLOSE_NO_STATUS
  Int
1006 -> CloseCode
CLOSE_ABNORMAL
  Int
1007 -> CloseCode
Unsupported_Data
  Int
1008 -> CloseCode
Policy_Violation
  Int
1009 -> CloseCode
CLOSE_TOO_LARGE
  Int
1010 -> CloseCode
Missing_Extension
  Int
1011 -> CloseCode
Internal_Error
  Int
1012 -> CloseCode
Service_Restart
  Int
1013 -> CloseCode
Try_Again_Later
  Int
1015 -> CloseCode
TLS_Handshake
  Int
n    -> Int -> CloseCode
OtherCode Int
n
-----------------------------------------------------------------------------
-- | Closed message is sent when a t'WebSocket' has closed
data Closed
  = Closed
  { Closed -> CloseCode
closedCode :: CloseCode
    -- ^ The code used to indicate why a socket closed
  , Closed -> Bool
wasClean :: Bool
    -- ^ If the connection was closed cleanly, or forcefully.
  , Closed -> MisoString
reason :: MisoString
    -- ^ The reason for socket closure.
  } deriving (Closed -> Closed -> Bool
(Closed -> Closed -> Bool)
-> (Closed -> Closed -> Bool) -> Eq Closed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Closed -> Closed -> Bool
== :: Closed -> Closed -> Bool
$c/= :: Closed -> Closed -> Bool
/= :: Closed -> Closed -> Bool
Eq, Int -> Closed -> ShowS
[Closed] -> ShowS
Closed -> String
(Int -> Closed -> ShowS)
-> (Closed -> String) -> ([Closed] -> ShowS) -> Show Closed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Closed -> ShowS
showsPrec :: Int -> Closed -> ShowS
$cshow :: Closed -> String
show :: Closed -> String
$cshowList :: [Closed] -> ShowS
showList :: [Closed] -> ShowS
Show)
-----------------------------------------------------------------------------
instance FromJSVal Closed where
  fromJSVal :: DOMRef -> IO (Maybe Closed)
fromJSVal DOMRef
o = do
    closed_ <- (Int -> CloseCode) -> Maybe Int -> Maybe CloseCode
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> CloseCode
codeToCloseCode (Maybe Int -> Maybe CloseCode)
-> IO (Maybe Int) -> IO (Maybe CloseCode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do DOMRef -> IO (Maybe Int)
forall a. FromJSVal a => DOMRef -> IO (Maybe a)
fromJSVal (DOMRef -> IO (Maybe Int)) -> IO DOMRef -> IO (Maybe Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DOMRef
o DOMRef -> MisoString -> IO DOMRef
forall o. ToObject o => o -> MisoString -> IO DOMRef
! (MisoString
"code" :: MisoString)
    wasClean_ <- fromJSVal =<< o ! ("wasClean" :: MisoString)
    reason_ <- fromJSVal =<< o ! ("reason" :: MisoString)
    pure (Closed <$> closed_ <*> wasClean_ <*> reason_)
-----------------------------------------------------------------------------
-- | URL that the t'WebSocket' will @connect@ to
type URL = MisoString
-----------------------------------------------------------------------------
-- | 'SocketState' corresponding to current t'WebSocket' connection
data SocketState
  = CONNECTING -- ^ 0
  | OPEN       -- ^ 1
  | CLOSING    -- ^ 2
  | CLOSED     -- ^ 3
  deriving (Int -> SocketState -> ShowS
[SocketState] -> ShowS
SocketState -> String
(Int -> SocketState -> ShowS)
-> (SocketState -> String)
-> ([SocketState] -> ShowS)
-> Show SocketState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SocketState -> ShowS
showsPrec :: Int -> SocketState -> ShowS
$cshow :: SocketState -> String
show :: SocketState -> String
$cshowList :: [SocketState] -> ShowS
showList :: [SocketState] -> ShowS
Show, SocketState -> SocketState -> Bool
(SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool) -> Eq SocketState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SocketState -> SocketState -> Bool
== :: SocketState -> SocketState -> Bool
$c/= :: SocketState -> SocketState -> Bool
/= :: SocketState -> SocketState -> Bool
Eq, Eq SocketState
Eq SocketState =>
(SocketState -> SocketState -> Ordering)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> Bool)
-> (SocketState -> SocketState -> SocketState)
-> (SocketState -> SocketState -> SocketState)
-> Ord SocketState
SocketState -> SocketState -> Bool
SocketState -> SocketState -> Ordering
SocketState -> SocketState -> SocketState
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SocketState -> SocketState -> Ordering
compare :: SocketState -> SocketState -> Ordering
$c< :: SocketState -> SocketState -> Bool
< :: SocketState -> SocketState -> Bool
$c<= :: SocketState -> SocketState -> Bool
<= :: SocketState -> SocketState -> Bool
$c> :: SocketState -> SocketState -> Bool
> :: SocketState -> SocketState -> Bool
$c>= :: SocketState -> SocketState -> Bool
>= :: SocketState -> SocketState -> Bool
$cmax :: SocketState -> SocketState -> SocketState
max :: SocketState -> SocketState -> SocketState
$cmin :: SocketState -> SocketState -> SocketState
min :: SocketState -> SocketState -> SocketState
Ord, Int -> SocketState
SocketState -> Int
SocketState -> [SocketState]
SocketState -> SocketState
SocketState -> SocketState -> [SocketState]
SocketState -> SocketState -> SocketState -> [SocketState]
(SocketState -> SocketState)
-> (SocketState -> SocketState)
-> (Int -> SocketState)
-> (SocketState -> Int)
-> (SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> [SocketState])
-> (SocketState -> SocketState -> SocketState -> [SocketState])
-> Enum SocketState
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SocketState -> SocketState
succ :: SocketState -> SocketState
$cpred :: SocketState -> SocketState
pred :: SocketState -> SocketState
$ctoEnum :: Int -> SocketState
toEnum :: Int -> SocketState
$cfromEnum :: SocketState -> Int
fromEnum :: SocketState -> Int
$cenumFrom :: SocketState -> [SocketState]
enumFrom :: SocketState -> [SocketState]
$cenumFromThen :: SocketState -> SocketState -> [SocketState]
enumFromThen :: SocketState -> SocketState -> [SocketState]
$cenumFromTo :: SocketState -> SocketState -> [SocketState]
enumFromTo :: SocketState -> SocketState -> [SocketState]
$cenumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
enumFromThenTo :: SocketState -> SocketState -> SocketState -> [SocketState]
Enum)
-----------------------------------------------------------------------------
-- | Code corresponding to a closed connection
-- https://developer.mozilla.org/en-US/docs/Web/API/CloseEvent
data CloseCode
  = CLOSE_NORMAL
   -- ^ 1000, Normal closure; the connection successfully completed whatever purpose for which it was created.
  | CLOSE_GOING_AWAY
   -- ^ 1001, The endpoint is going away, either because of a server failure or because the browser is navigating away from the page that opened the connection.
  | CLOSE_PROTOCOL_ERROR
   -- ^ 1002, The endpoint is terminating the connection due to a protocol error.
  | CLOSE_UNSUPPORTED
   -- ^ 1003, The connection is being terminated because the endpoint received data of a type it cannot accept (for example, a textonly endpoint received binary data).
  | CLOSE_NO_STATUS
   -- ^ 1005, Reserved.  Indicates that no status code was provided even though one was expected.
  | CLOSE_ABNORMAL
   -- ^ 1006, Reserved. Used to indicate that a connection was closed abnormally (that is, with no close frame being sent) when a status code is expected.
  | Unsupported_Data
   -- ^ 1007, The endpoint is terminating the connection because a message was received that contained inconsistent data (e.g., nonUTF8 data within a text message).
  | Policy_Violation
   -- ^ 1008, The endpoint is terminating the connection because it received a message that violates its policy. This is a generic status code, used when codes 1003 and 1009 are not suitable.
  | CLOSE_TOO_LARGE
   -- ^ 1009, The endpoint is terminating the connection because a data frame was received that is too large.
  | Missing_Extension
   -- ^ 1010, The client is terminating the connection because it expected the server to negotiate one or more extension, but the server didn't.
  | Internal_Error
   -- ^ 1011, The server is terminating the connection because it encountered an unexpected condition that prevented it from fulfilling the request.
  | Service_Restart
   -- ^ 1012, The server is terminating the connection because it is restarting.
  | Try_Again_Later
   -- ^ 1013, The server is terminating the connection due to a temporary condition, e.g. it is overloaded and is casting off some of its clients.
  | TLS_Handshake
   -- ^ 1015, Reserved. Indicates that the connection was closed due to a failure to perform a TLS handshake (e.g., the server certificate can't be verified).
  | OtherCode Int
   -- ^ OtherCode that is reserved and not in the range 0999
  deriving (Int -> CloseCode -> ShowS
[CloseCode] -> ShowS
CloseCode -> String
(Int -> CloseCode -> ShowS)
-> (CloseCode -> String)
-> ([CloseCode] -> ShowS)
-> Show CloseCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CloseCode -> ShowS
showsPrec :: Int -> CloseCode -> ShowS
$cshow :: CloseCode -> String
show :: CloseCode -> String
$cshowList :: [CloseCode] -> ShowS
showList :: [CloseCode] -> ShowS
Show, CloseCode -> CloseCode -> Bool
(CloseCode -> CloseCode -> Bool)
-> (CloseCode -> CloseCode -> Bool) -> Eq CloseCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CloseCode -> CloseCode -> Bool
== :: CloseCode -> CloseCode -> Bool
$c/= :: CloseCode -> CloseCode -> Bool
/= :: CloseCode -> CloseCode -> Bool
Eq)
-----------------------------------------------------------------------------
-- | Type for holding a t'WebSocket' file descriptor.
newtype WebSocket = WebSocket Int
  deriving (WebSocket -> IO DOMRef
(WebSocket -> IO DOMRef) -> ToJSVal WebSocket
forall a. (a -> IO DOMRef) -> ToJSVal a
$ctoJSVal :: WebSocket -> IO DOMRef
toJSVal :: WebSocket -> IO DOMRef
ToJSVal, WebSocket -> WebSocket -> Bool
(WebSocket -> WebSocket -> Bool)
-> (WebSocket -> WebSocket -> Bool) -> Eq WebSocket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WebSocket -> WebSocket -> Bool
== :: WebSocket -> WebSocket -> Bool
$c/= :: WebSocket -> WebSocket -> Bool
/= :: WebSocket -> WebSocket -> Bool
Eq, Integer -> WebSocket
WebSocket -> WebSocket
WebSocket -> WebSocket -> WebSocket
(WebSocket -> WebSocket -> WebSocket)
-> (WebSocket -> WebSocket -> WebSocket)
-> (WebSocket -> WebSocket -> WebSocket)
-> (WebSocket -> WebSocket)
-> (WebSocket -> WebSocket)
-> (WebSocket -> WebSocket)
-> (Integer -> WebSocket)
-> Num WebSocket
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: WebSocket -> WebSocket -> WebSocket
+ :: WebSocket -> WebSocket -> WebSocket
$c- :: WebSocket -> WebSocket -> WebSocket
- :: WebSocket -> WebSocket -> WebSocket
$c* :: WebSocket -> WebSocket -> WebSocket
* :: WebSocket -> WebSocket -> WebSocket
$cnegate :: WebSocket -> WebSocket
negate :: WebSocket -> WebSocket
$cabs :: WebSocket -> WebSocket
abs :: WebSocket -> WebSocket
$csignum :: WebSocket -> WebSocket
signum :: WebSocket -> WebSocket
$cfromInteger :: Integer -> WebSocket
fromInteger :: Integer -> WebSocket
Num)
-----------------------------------------------------------------------------
-- | A null t'WebSocket' is one with a negative descriptor.
emptyWebSocket :: WebSocket
emptyWebSocket :: WebSocket
emptyWebSocket = -WebSocket
1
-----------------------------------------------------------------------------
-- | A type for holding an t'EventSource' descriptor.
newtype EventSource = EventSource Int
  deriving (EventSource -> IO DOMRef
(EventSource -> IO DOMRef) -> ToJSVal EventSource
forall a. (a -> IO DOMRef) -> ToJSVal a
$ctoJSVal :: EventSource -> IO DOMRef
toJSVal :: EventSource -> IO DOMRef
ToJSVal, EventSource -> EventSource -> Bool
(EventSource -> EventSource -> Bool)
-> (EventSource -> EventSource -> Bool) -> Eq EventSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EventSource -> EventSource -> Bool
== :: EventSource -> EventSource -> Bool
$c/= :: EventSource -> EventSource -> Bool
/= :: EventSource -> EventSource -> Bool
Eq, Integer -> EventSource
EventSource -> EventSource
EventSource -> EventSource -> EventSource
(EventSource -> EventSource -> EventSource)
-> (EventSource -> EventSource -> EventSource)
-> (EventSource -> EventSource -> EventSource)
-> (EventSource -> EventSource)
-> (EventSource -> EventSource)
-> (EventSource -> EventSource)
-> (Integer -> EventSource)
-> Num EventSource
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: EventSource -> EventSource -> EventSource
+ :: EventSource -> EventSource -> EventSource
$c- :: EventSource -> EventSource -> EventSource
- :: EventSource -> EventSource -> EventSource
$c* :: EventSource -> EventSource -> EventSource
* :: EventSource -> EventSource -> EventSource
$cnegate :: EventSource -> EventSource
negate :: EventSource -> EventSource
$cabs :: EventSource -> EventSource
abs :: EventSource -> EventSource
$csignum :: EventSource -> EventSource
signum :: EventSource -> EventSource
$cfromInteger :: Integer -> EventSource
fromInteger :: Integer -> EventSource
Num)
-----------------------------------------------------------------------------
-- | A null t'EventSource' is one with a negative descriptor.
emptyEventSource :: EventSource
emptyEventSource :: EventSource
emptyEventSource = -EventSource
1
-----------------------------------------------------------------------------
eventSourceConnections :: IORef EventSources
{-# NOINLINE eventSourceConnections #-}
eventSourceConnections :: IORef WebSockets
eventSourceConnections = IO (IORef WebSockets) -> IORef WebSockets
forall a. IO a -> a
unsafePerformIO (WebSockets -> IO (IORef WebSockets)
forall a. a -> IO (IORef a)
newIORef WebSockets
forall a. IntMap a
IM.empty)
-----------------------------------------------------------------------------
eventSourceConnectionIds :: IORef Int
{-# NOINLINE eventSourceConnectionIds #-}
eventSourceConnectionIds :: IORef Int
eventSourceConnectionIds = IO (IORef Int) -> IORef Int
forall a. IO a -> a
unsafePerformIO (Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int))
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>
eventSourceConnectText
  :: URL
  -- ^ EventSource URL
  -> (EventSource -> action)
  -- ^ onOpen
  -> (MisoString -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
eventSourceConnectText :: forall action parent props model.
MisoString
-> (EventSource -> action)
-> (MisoString -> action)
-> (MisoString -> action)
-> Effect parent props model action
eventSourceConnectText MisoString
url EventSource -> action
onOpen MisoString -> action
onMessage MisoString -> action
onError =
  (EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
eventSourceCore ((EventSource -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \EventSource
eventSourceId Sink action
sink -> do
    MisoString
-> IO ()
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.eventSourceConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ EventSource -> action
onOpen EventSource
eventSourceId)
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ()))
-> (DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a b. (a -> b) -> a -> b
$ \DOMRef
e -> do
          txt <- DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
e
          sink (onMessage txt))
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
True
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>
eventSourceConnectJSON
  :: FromJSON json
  => URL
  -- ^ EventSource URL
  -> (EventSource -> action)
  -- ^ onOpen
  -> (json -> action)
  -- ^ onMessage
  -> (MisoString -> action)
  -- ^ onError
  -> Effect parent props model action
eventSourceConnectJSON :: forall json action parent props model.
FromJSON json =>
MisoString
-> (EventSource -> action)
-> (json -> action)
-> (MisoString -> action)
-> Effect parent props model action
eventSourceConnectJSON MisoString
url EventSource -> action
onOpen json -> action
onMessage MisoString -> action
onError =
  (EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall action parent props model.
(EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
eventSourceCore ((EventSource -> Sink action -> IO DOMRef)
 -> Effect parent props model action)
-> (EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \EventSource
eventSourceId Sink action
sink -> do
    MisoString
-> IO ()
-> Maybe (DOMRef -> IO ())
-> Maybe (DOMRef -> IO ())
-> (DOMRef -> IO ())
-> Bool
-> IO DOMRef
FFI.eventSourceConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ EventSource -> action
onOpen EventSource
eventSourceId)
      Maybe (DOMRef -> IO ())
forall a. Maybe a
Nothing
      ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((DOMRef -> IO ()) -> Maybe (DOMRef -> IO ()))
-> (DOMRef -> IO ()) -> Maybe (DOMRef -> IO ())
forall a b. (a -> b) -> a -> b
$ \DOMRef
e ->
         Value -> Result json
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result json) -> IO Value -> IO (Result json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DOMRef -> IO Value
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked DOMRef
e IO (Result json) -> (Result json -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Error MisoString
errMsg -> Sink action
sink (MisoString -> action
onError (MisoString -> MisoString
forall str. ToMisoString str => str -> MisoString
ms MisoString
errMsg))
            Success json
json_ -> Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ json -> action
onMessage json
json_)
      (Sink action
sink Sink action -> (MisoString -> action) -> MisoString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> action
onError (MisoString -> IO ())
-> (DOMRef -> IO MisoString) -> DOMRef -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< DOMRef -> IO MisoString
forall a. FromJSVal a => DOMRef -> IO a
fromJSValUnchecked)
      Bool
False
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/EventSource>
eventSourceCore
  :: (EventSource -> Sink action -> IO Socket)
  -> Effect parent props model action
eventSourceCore :: forall action parent props model.
(EventSource -> Sink action -> IO DOMRef)
-> Effect parent props model action
eventSourceCore EventSource -> Sink action -> IO DOMRef
core = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  withSink $ \Sink action
sink -> do
    eventSourceId <- IO EventSource
freshEventSource
    socket <- core eventSourceId sink
    insertEventSource _componentInfoId eventSourceId socket
  where
    insertEventSource :: ComponentId -> EventSource -> Socket -> IO ()
    insertEventSource :: Int -> EventSource -> DOMRef -> IO ()
insertEventSource Int
componentId_ (EventSource Int
socketId) DOMRef
socket =
      IORef WebSockets -> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
eventSourceConnections ((WebSockets -> (WebSockets, ())) -> IO ())
-> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebSockets
eventSources ->
        (WebSockets -> WebSockets
update WebSockets
eventSources, ())
      where
        update :: WebSockets -> WebSockets
update WebSockets
eventSources =
          (IntMap DOMRef -> IntMap DOMRef -> IntMap DOMRef)
-> WebSockets -> WebSockets -> WebSockets
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith IntMap DOMRef -> IntMap DOMRef -> IntMap DOMRef
forall a. IntMap a -> IntMap a -> IntMap a
IM.union WebSockets
eventSources
            (WebSockets -> WebSockets) -> WebSockets -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> IntMap DOMRef -> WebSockets
forall a. Int -> a -> IntMap a
IM.singleton Int
componentId_
            (IntMap DOMRef -> WebSockets) -> IntMap DOMRef -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> DOMRef -> IntMap DOMRef
forall a. Int -> a -> IntMap a
IM.singleton Int
socketId DOMRef
socket

    freshEventSource :: IO EventSource
    freshEventSource :: IO EventSource
freshEventSource = Int -> EventSource
EventSource (Int -> EventSource) -> IO Int -> IO EventSource
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
eventSourceConnectionIds (\Int
x -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, Int
x))
-----------------------------------------------------------------------------
-- | <https://developer.mozilla.org/en-US/docs/Web/API/EventSource/close>
eventSourceClose :: EventSource -> Effect parent props model action
eventSourceClose :: forall parent props model action.
EventSource -> Effect parent props model action
eventSourceClose EventSource
socketId = do
  ComponentInfo {..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  io_ $ do
    result <-
      atomicModifyIORef' eventSourceConnections $ \WebSockets
imap ->
        Int -> EventSource -> WebSockets -> WebSockets
dropEventSource Int
_componentInfoId EventSource
socketId WebSockets
imap WebSockets -> Maybe DOMRef -> (WebSockets, Maybe DOMRef)
forall k v. k -> v -> (k, v)
=:
          Int -> EventSource -> WebSockets -> Maybe DOMRef
getEventSource Int
_componentInfoId EventSource
socketId WebSockets
imap
    case result of
      Maybe DOMRef
Nothing ->
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just DOMRef
socket ->
        DOMRef -> IO ()
FFI.eventSourceClose DOMRef
socket
  where
    dropEventSource :: ComponentId -> EventSource -> EventSources -> EventSources
    dropEventSource :: Int -> EventSource -> WebSockets -> WebSockets
dropEventSource Int
vcompId (EventSource Int
eventSourceId) WebSockets
eventSources = do
      case Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId WebSockets
eventSources of
        Maybe (IntMap DOMRef)
Nothing ->
          WebSockets
eventSources
        Just IntMap DOMRef
componentSockets ->
          Int -> IntMap DOMRef -> WebSockets -> WebSockets
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
vcompId (Int -> IntMap DOMRef -> IntMap DOMRef
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
eventSourceId IntMap DOMRef
componentSockets) WebSockets
eventSources

    getEventSource :: ComponentId -> EventSource -> EventSources -> Maybe Socket
    getEventSource :: Int -> EventSource -> WebSockets -> Maybe DOMRef
getEventSource Int
vcompId (EventSource Int
eventSourceId) =
      Int -> IntMap DOMRef -> Maybe DOMRef
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
eventSourceId (IntMap DOMRef -> Maybe DOMRef)
-> (WebSockets -> Maybe (IntMap DOMRef))
-> WebSockets
-> Maybe DOMRef
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId
-----------------------------------------------------------------------------
finalizeEventSources :: ComponentId -> IO ()
finalizeEventSources :: Int -> IO ()
finalizeEventSources Int
vcompId = do
  (IntMap DOMRef -> IO ()) -> Maybe (IntMap DOMRef) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((DOMRef -> IO ()) -> [DOMRef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ DOMRef -> IO ()
FFI.eventSourceClose ([DOMRef] -> IO ())
-> (IntMap DOMRef -> [DOMRef]) -> IntMap DOMRef -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IntMap DOMRef -> [DOMRef]
forall a. IntMap a -> [a]
IM.elems) (Maybe (IntMap DOMRef) -> IO ())
-> (WebSockets -> Maybe (IntMap DOMRef)) -> WebSockets -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
    Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> IO ()) -> IO WebSockets -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef WebSockets -> IO WebSockets
forall a. IORef a -> IO a
readIORef IORef WebSockets
eventSourceConnections
  IO ()
dropComponentEventSources
    where
      dropComponentEventSources :: IO ()
      dropComponentEventSources :: IO ()
dropComponentEventSources =
        IORef WebSockets -> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
eventSourceConnections ((WebSockets -> (WebSockets, ())) -> IO ())
-> (WebSockets -> (WebSockets, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \WebSockets
eventSources ->
          (Int -> WebSockets -> WebSockets
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
vcompId WebSockets
eventSources, ())
-----------------------------------------------------------------------------
-- | Payload is used as the potential source of data when working with t'EventSource'
data Payload value
  = JSON value
  -- ^ JSON-encoded data
  | BLOB Blob
  -- ^ Binary encoded data
  | TEXT MisoString
  -- ^ Text encoded data
  | BUFFER ArrayBuffer
  -- ^ Buffered data
-----------------------------------------------------------------------------
-- | Smart constructor for sending JSON encoded data via an t'EventSource'
json :: ToJSON value => value -> Payload value
json :: forall value. ToJSON value => value -> Payload value
json = value -> Payload value
forall value. value -> Payload value
JSON
-----------------------------------------------------------------------------
-- | Smart constructor for sending binary encoded data via an t'EventSource'
blob :: Blob -> Payload value
blob :: forall value. Blob -> Payload value
blob = Blob -> Payload value
forall value. Blob -> Payload value
BLOB
-----------------------------------------------------------------------------
-- | Smart constructor for sending an @ArrayBuffer@ via an t'EventSource'
arrayBuffer :: ArrayBuffer -> Payload value
arrayBuffer :: forall value. ArrayBuffer -> Payload value
arrayBuffer = ArrayBuffer -> Payload value
forall value. ArrayBuffer -> Payload value
BUFFER
-----------------------------------------------------------------------------
#ifdef WASM
loadedJS :: IORef Bool
{-# NOINLINE loadedJS #-}
loadedJS = unsafePerformIO (newIORef False)
#endif
-----------------------------------------------------------------------------
initComponent
  :: (Eq parent, Eq model)
  => Events
  -> Hydrate
  -> Bool
  -> Component parent () model action
  -> IO ()
initComponent :: forall parent model action.
(Eq parent, Eq model) =>
Events
-> Hydrate -> Bool -> Component parent () model action -> IO ()
initComponent Events
events Hydrate
hydrate Bool
live vcomp_ :: Component parent () model action
vcomp_@Component {model
Bool
[Binding parent model]
[JS]
[CSS]
[Sub action]
Maybe action
Maybe (IO model)
Maybe MisoString
Maybe (() -> () -> action)
LogLevel
action -> Effect parent () model action
() -> model -> View model action
Value -> Maybe action
onPropsChanged :: forall parent props model action.
Component parent props model action
-> Maybe (props -> props -> action)
unmount :: forall parent props model action.
Component parent props model action -> Maybe action
mount :: forall parent props model action.
Component parent props model action -> Maybe action
eventPropagation :: forall parent props model action.
Component parent props model action -> Bool
bindings :: forall parent props model action.
Component parent props model action -> [Binding parent model]
mailbox :: forall parent props model action.
Component parent props model action -> Value -> Maybe action
logLevel :: forall parent props model action.
Component parent props model action -> LogLevel
mountPoint :: forall parent props model action.
Component parent props model action -> Maybe MisoString
scripts :: forall parent props model action.
Component parent props model action -> [JS]
styles :: forall parent props model action.
Component parent props model action -> [CSS]
subs :: forall parent props model action.
Component parent props model action -> [Sub action]
view :: forall parent props model action.
Component parent props model action
-> props -> model -> View model action
update :: forall parent props model action.
Component parent props model action
-> action -> Effect parent props model action
hydrateModel :: forall parent props model action.
Component parent props model action -> Maybe (IO model)
model :: forall parent props model action.
Component parent props model action -> model
model :: model
hydrateModel :: Maybe (IO model)
update :: action -> Effect parent () model action
view :: () -> model -> View model action
subs :: [Sub action]
styles :: [CSS]
scripts :: [JS]
mountPoint :: Maybe MisoString
logLevel :: LogLevel
mailbox :: Value -> Maybe action
bindings :: [Binding parent model]
eventPropagation :: Bool
mount :: Maybe action
unmount :: Maybe action
onPropsChanged :: Maybe (() -> () -> action)
..} = do
#ifdef WASM
  $(evalFile MISO_JS_PATH)
  atomicWriteIORef loadedJS True
#endif
  IO () -> IO ()
forall a. IO a -> IO a
withJS (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    root <- MisoString -> IO DOMRef
Diff.mountElement (Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
mountPoint)
    when web (cleanup live root)
    void $ initialize events rootComponentId hydrate True () Nothing vcomp_ (pure root)
    when (bts || web) (atomicWriteIORef schedulerThread =<< forkIO scheduler)
----------------------------------------------------------------------------
-- | Global variable to hold the scheduler thread
--
-- N.B. 'undefined' is safe here, it will always get populated.
-- Also, we use this in 'cleanup' when interactive mode (GHCi) is detected
-- in that circumstance 'schedulerThread' will always be populated. It's an
-- invariant.
--
schedulerThread :: IORef ThreadId
{-# NOINLINE schedulerThread #-}
schedulerThread :: IORef ThreadId
schedulerThread = IO (IORef ThreadId) -> IORef ThreadId
forall a. IO a -> a
unsafePerformIO (ThreadId -> IO (IORef ThreadId)
forall a. a -> IO (IORef a)
newIORef ThreadId
forall a. HasCallStack => a
undefined)
----------------------------------------------------------------------------
-- | Whether this JS execution context is the Lynx main thread, background
-- thread, or a plain web build.
--
-- N.B. this is invariant for the lifetime of a given JS context, so it's
-- safe to compute once and cache via 'unsafePerformIO' rather than making
-- an FFI call on every 'initialize' \/ 'initComponent'.
--
_mts, bts, web :: Bool
{-# NOINLINE _mts #-}
{-# NOINLINE bts #-}
{-# NOINLINE web #-}
(Bool
_mts, Bool
bts, Bool
web) = IO (Bool, Bool, Bool) -> (Bool, Bool, Bool)
forall a. IO a -> a
unsafePerformIO IO (Bool, Bool, Bool)
FFI.getThreads
----------------------------------------------------------------------------
-- | Loads miso's JavaScript (if not already loaded) and runs an 'IO' action.
--
-- On WASM, @miso.js@ is evaluated once on first call and skipped on subsequent calls.
-- It is safe to call 'withJS' directly (e.g. when implementing WASM tests in Playwright);
-- 'startApp' \/ 'miso' call it for you.
--
withJS
  :: IO a
  -- ^ 'IO' action to execute in between 'evalFile'
  -> IO a
withJS :: forall a. IO a -> IO a
withJS IO a
action = do
#ifdef WASM
  loaded <- readIORef loadedJS
  unless loaded $(evalFile MISO_JS_PATH)
  atomicWriteIORef loadedJS True
#endif
  action
-----------------------------------------------------------------------------