-----------------------------------------------------------------------------
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE BlockArguments             #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE NumericUnderscores         #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
{-# OPTIONS_GHC -fno-warn-orphans       #-}
-----------------------------------------------------------------------------
-- |
-- 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
  , 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)
import           Control.Monad.Reader (ask, asks)
import           Control.Monad.State hiding (state)
import           Miso.JSON (FromJSON, ToJSON, Result(..), fromJSON, toJSON)
import           Data.Foldable (toList)
import qualified Data.List as List
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.JSON (encode, jsonStringify, Value)
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
  -> 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
-> Component parent props model action
-> IO DOMRef
-> IO (ComponentState parent props model action)
initialize Events
events Int
_componentParentId Hydrate
hydrate Bool
isRoot props
initialProps 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 -> 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 (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
        Int
-> IntMap
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
-> Maybe
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentId (IntMap
   (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
 -> Maybe
      (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
-> IO
     (Maybe
        (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 IO
  (Maybe
     (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)))
-> (Maybe
      (ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123))
    -> IO model)
-> IO model
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 121) (ZonkAny 122) model (ZonkAny 123))
Nothing ->
            model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model
          Just ComponentState (ZonkAny 121) (ZonkAny 122) model (ZonkAny 123)
cs ->
            -- hot reload scenario, let it flow
            model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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)
      (Hydrate, Maybe (IO model))
_ -> model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model
  _componentScripts <- (++) <$> renderScripts scripts <*> renderStyles styles
  _componentDOMRef <- getComponentMountPoint
  _componentIsDirty <- pure False
  _componentVTree <- liftIO $ newIORef (VTree (Object jsNull))
  _componentSubThreads <- liftIO (newIORef M.empty)

  frame <- newEmptyMVar :: IO (MVar Double)
  _componentMailbox <- pure 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 125) props (ZonkAny 126) (ZonkAny 127)
-> Lens
     (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
     props
-> props
forall record field. record -> Lens record field -> field
^. Lens
  (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
  props
forall parent props model action.
Lens (ComponentState parent props model action) props
componentProps) (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)
 -> props)
-> (IntMap
      (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
    -> ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
-> IntMap
     (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
-> 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 125) props (ZonkAny 126) (ZonkAny 127))
-> Int
-> ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)
forall a. IntMap a -> Int -> a
IM.! Int
_componentId) (IntMap
   (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127))
 -> props)
-> IO
     (IntMap
        (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)))
-> IO props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 125) props (ZonkAny 126) (ZonkAny 127)))
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 <- liftIO (readIORef _componentVTree)
        _frame <- requestAnimationFrame rAFCallback
        _timestamp :: Double <- takeMVar frame
        Diff.diff (Just oldVTree) (Just newVTree) _componentDOMRef
        FFI.updateRef oldVTree newVTree
        liftIO (atomicWriteIORef _componentVTree newVTree)
        FFI.flush

  let _componentApplyActions = \([action]
actions :: [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)
-> [action]
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.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 model. Eq model => model -> model -> 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) [action]
actions

  let vcomponent = ComponentState
        { _componentEvents :: Events
_componentEvents = Events
events
        , _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 model. Eq model => model -> model -> 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
[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}.
[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]
_componentDOMRef :: DOMRef
_componentIsDirty :: Bool
_componentVTree :: IORef VTree
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDraw :: model -> IO ()
_componentApplyActions :: forall {p} {props} {a}.
[action]
-> model
-> IntMap (ComponentState p props model a)
-> props
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
_componentApplyActions :: [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: model -> IO ()
_componentScripts :: [DOMRef]
_componentIsDirty :: Bool
_componentSink :: Sink action
_componentVTree :: IORef VTree
_componentDOMRef :: DOMRef
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentProps :: props
_componentParentId :: Int
_componentId :: Int
..
        }

  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
  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 <- liftIO freshSubId
    liftIO $ 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 model. Eq model => model -> model -> 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, [ZonkAny 88]))
forall action. IO (Maybe (Int, [action]))
getBatch IO (Maybe (Int, [ZonkAny 88]))
-> (Maybe (Int, [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, [ZonkAny 88])
Nothing -> Waiter -> IO ()
wait Waiter
globalWaiter
      Just (Int
vcompId, [])
        | Int
vcompId Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 -> do
            -- props propagation, negated 'ComponentId' indicates render-phase only.
            vcomps <- IO
  (IntMap
     (ComponentState
        (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 89) (ZonkAny 90) (ZonkAny 91) (ZonkAny 92)))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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)]
ZonkAny 90
ZonkAny 91
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[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)
ZonkAny 90 -> ZonkAny 90 -> IO ()
ZonkAny 91 -> IO ()
ZonkAny 91 -> ZonkAny 91 -> Bool
ZonkAny 92 -> IO ()
Value -> Maybe (ZonkAny 92)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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, [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 -> [action] -> IO ()
    run :: forall action. Int -> [action] -> IO ()
run Int
vcompId = ComponentIds -> IO ()
renderComponents (ComponentIds -> IO ())
-> ([action] -> IO ComponentIds) -> [action] -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> [action] -> IO ComponentIds
forall action. Int -> [action] -> IO ComponentIds
commit Int
vcompId
    -----------------------------------------------------------------------------
    -- | Apply the actions across the model, evaluate async and sync IO.
    commit :: ComponentId -> [action] -> IO ComponentIds
    commit :: forall action. Int -> [action] -> IO ComponentIds
commit Int
vcompId [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)]
ZonkAny 84
ZonkAny 87
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
[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)
ZonkAny 84 -> IO ()
ZonkAny 84 -> ZonkAny 84 -> Bool
ZonkAny 87 -> ZonkAny 87 -> IO ()
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 [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 [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 = do
  [Int] -> (Int -> IO (Maybe ())) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ComponentIds -> [Int]
IS.toAscList ComponentIds
dirtySet) ((Int -> IO (Maybe ())) -> IO ())
-> (Int -> IO (Maybe ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
<$> IO
  (IntMap
     (ComponentState
        (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 74) (ZonkAny 75) (ZonkAny 76) (ZonkAny 77)))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 (Maybe ()))
-> IO (Maybe ())
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 (Maybe ())
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM \ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 74) (ZonkAny 76)]
ZonkAny 75
ZonkAny 76
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[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)
ZonkAny 75 -> ZonkAny 75 -> IO ()
ZonkAny 76 -> IO ()
ZonkAny 76 -> ZonkAny 76 -> Bool
ZonkAny 77 -> IO ()
Value -> Maybe (ZonkAny 77)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 5) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)) ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentId (Lens
  (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
  Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens
  (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8))
  Bool
-> Bool
-> State
     (ComponentState (ZonkAny 5) (ZonkAny 6) (ZonkAny 7) (ZonkAny 8)) ()
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 = 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
$
  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
      when (not 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 52) -> ZonkAny 52)
-> IntMap (ComponentState p props m a)
-> ComponentState m props m a
forall a b. a -> b
unsafeCoerce (IntMap (ZonkAny 52) -> Int -> ZonkAny 52
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 53) props p a -> ComponentState p props m a
forall a b. a -> b
unsafeCoerce (ComponentState (ZonkAny 53) props p a
 -> ComponentState p props m a)
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 53) 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 53) props p a
 -> Binding p m
 -> StateT
      (DFS p props m a) Identity (ComponentState (ZonkAny 53) props p a))
-> ComponentState (ZonkAny 53) props p a
-> [Binding p m]
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 53) props p a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ComponentState (ZonkAny 53) props p a
-> Binding p m
-> StateT
     (DFS p props m a) Identity (ComponentState (ZonkAny 53) 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 53) 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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
m -> IO ()
m -> m -> Bool
props -> props -> IO ()
a -> IO ()
[a]
-> m
-> IntMap (ComponentState p props m a)
-> props
-> (IntMap (ComponentState p props m a), m, [Schedule a],
    ComponentIds)
Value -> Maybe a
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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
              liftIO (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, [action]))
getBatch :: forall action. IO (Maybe (Int, [action]))
getBatch = do
  IO (Maybe (Int, [action])) -> IO (Maybe (Int, [action]))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Int, [action])) -> IO (Maybe (Int, [action])))
-> IO (Maybe (Int, [action])) -> IO (Maybe (Int, [action]))
forall a b. (a -> b) -> a -> b
$ IORef (Queue action)
-> (Queue action -> (Queue action, Maybe (Int, [action])))
-> IO (Maybe (Int, [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, [action])))
 -> IO (Maybe (Int, [action])))
-> (Queue action -> (Queue action, Maybe (Int, [action])))
-> IO (Maybe (Int, [action]))
forall a b. (a -> b) -> a -> b
$ \Queue action
q ->
    case Queue action -> Maybe (Int, [action], Queue action)
forall action. Queue action -> Maybe (Int, [action], Queue action)
dequeue Queue action
q of
      Maybe (Int, [action], Queue action)
Nothing -> (Queue action
q, Maybe (Int, [action])
forall a. Maybe a
Nothing)
      Just (Int
vcompId, [action]
actions, Queue action
newQueue) ->
        (Queue action
newQueue, (Int, [action]) -> Maybe (Int, [action])
forall a. a -> Maybe a
Just (Int
vcompId, [action]
actions))
-----------------------------------------------------------------------------
-- | Helper for event extraction at a specific 'ComponentId'
drainQueueAt :: ComponentId -> IO [a]
drainQueueAt :: forall a. Int -> IO [a]
drainQueueAt Int
vcompId = IO [a] -> IO [a]
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [a] -> IO [a]) -> IO [a] -> IO [a]
forall a b. (a -> b) -> a -> b
$ IORef (Queue a) -> (Queue a -> (Queue a, [a])) -> IO [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, [a])
forall action. Int -> Queue action -> (Queue action, [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 51))
-> (Queue (ZonkAny 51) -> (Queue (ZonkAny 51), ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue (ZonkAny 51))
forall action. IORef (Queue action)
globalQueue ((Queue (ZonkAny 51) -> (Queue (ZonkAny 51), ())) -> IO ())
-> (Queue (ZonkAny 51) -> (Queue (ZonkAny 51), ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Queue (ZonkAny 51)
q ->
     (Queue (ZonkAny 51)
q Queue (ZonkAny 51)
-> (Queue (ZonkAny 51) -> Queue (ZonkAny 51)) -> Queue (ZonkAny 51)
forall a b. a -> (a -> b) -> b
& Lens (Queue (ZonkAny 51)) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue (ZonkAny 51)) (Seq Int)
-> (Seq Int -> Seq Int) -> Queue (ZonkAny 51) -> Queue (ZonkAny 51)
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, [action], Queue action)
dequeue :: forall action. Queue action -> Maybe (Int, [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, [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 model. Eq model => model -> model -> Bool
== Int
vcompId) Seq Int
sched
          in (Int, [action], Queue action)
-> Maybe (Int, [action], Queue action)
forall a. a -> Maybe a
Just (Int
vcompId, [], 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 model. Eq model => model -> model -> 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, [action], Queue action)
-> Maybe (Int, [action], Queue action)
forall a. a -> Maybe a
Just (Int
vcompId, Seq action -> [action]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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, [action])
dequeueAt :: forall action. Int -> Queue action -> (Queue action, [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, [])
    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 model. Eq model => model -> model -> 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 -> [action]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList 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 }
-----------------------------------------------------------------------------
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 -> 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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentApplyActions
      :: [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 to a @Topic@, provides callback function that writes to t'Miso.Types.Component' 'Sink'
--
-- If a @Topic message@ does not exist when calling 'subscribe' it is generated dynamically.
-- Each subscriber decodes the received 'Value' using it's own 'FromJSON' instance. This provides
-- for loose-coupling between t'Miso.Types.Component'. As long as the underlying 'Value' are identical
-- t'Miso.Types.Component' can use their own types without serialization issues. @Topic message@ should
-- have their own JSON API specification when being distributed.
--
-- @
--
-- arithmetic :: Topic Message
-- arithmetic = topic "arithmetic"
--
-- clientComponent :: MisoString -> Component Int Action
-- clientComponent name = component 0 update_ $ \m ->
--   div_
--   []
--   [ br_ []
--   , text (name <> " : " <> ms (m ^. _id))
--   , button_ [ onClick Unsubscribe ] [ "unsubscribe" ]
--   , button_ [ onClick Subscribe ] [ "subscribe" ]
--   ] where
--       update_ :: Action -> Effect Int Action
--       update_ = \case
--         AddOne -> do
--           _id += 1
--         SubtractOne ->
--           _id -= 1
--         Unsubscribe ->
--           unsubscribe arithmetic
--         Subscribe ->
--           subscribe arithmetic Notification
--         Notification (Success Increment) -> do
--           update_ AddOne
--         Notification (Success Decrement) -> do
--           update_ SubtractOne
--         Notification (Error msg) ->
--           io_ $ consoleError ("Decode failure: " <> ms msg)
--         _ -> pure ()
--
-- @
--
-- @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 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
     ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentInfoId (State
   (ComponentState
      (ZonkAny 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
   ()
 -> IO ())
-> State
     (ComponentState
        (ZonkAny 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
     ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Lens
  (ComponentState
     (ZonkAny 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
  (Map MisoString (Value -> IO ()))
forall parent props model action.
Lens
  (ComponentState parent props model action)
  (Map MisoString (Value -> IO ()))
componentTopics Lens
  (ComponentState
     (ZonkAny 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
  (Map MisoString (Value -> IO ()))
-> (Map MisoString (Value -> IO ())
    -> Map MisoString (Value -> IO ()))
-> State
     (ComponentState
        (ZonkAny 54) (ZonkAny 55) (ZonkAny 56) (ZonkAny 57))
     ()
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)
-----------------------------------------------------------------------------
-- Pub / Sub implementation
--
-- (Subscribe)
--
-- Check if you're already subscribed to this topic.
--
--  [true]  - If you're already subscribed, then it's a no-op (warn)
--
--  [false] - If you're not subscribed then fork a new thread that holds the duplicated topic
--            and blocks on the read end of the duplicated topic, sink messages into component sink
--
-- (Unsubscribe)
--
-- Check if you're already subscribed to this topic
--
--  [true] - Kill the thread, delete the subscriber entry
--
--  [false] - If you're not subscribed, then it's a no-op (warn)
--
-- (Publish)
--
-- Check if the Topic exists
--
--  [true] - If it exists then write the message to the topic
--
--  [false] - If it doesn't exist, create it.
--
-- N.B. Components can be both publishers and subscribers to their own topics.
-----------------------------------------------------------------------------
-- | Unsubscribe from a t'Topic'
--
-- Unsubscribes a t'Miso.Types.Component' from receiving messages from t'Topic'
--
-- See 'subscribe' for more use.
--
-- @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 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)
 -> IO ())
-> [ComponentState
      (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComponentState (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)
-> IO ()
forall (m :: * -> *) parent props model action.
MonadIO m =>
ComponentState parent props model action -> m ()
go ([ComponentState
    (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)]
 -> IO ())
-> IO
     [ComponentState
        (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)]
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntMap
  (ComponentState
     (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50))
-> [ComponentState
      (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)]
forall a. IntMap a -> [a]
IM.elems (IntMap
   (ComponentState
      (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50))
 -> [ComponentState
       (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)])
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)))
-> IO
     [ComponentState
        (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 47) (ZonkAny 48) (ZonkAny 49) (ZonkAny 50)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
  where
    go :: ComponentState parent props model action -> f ()
go ComponentState {props
model
Bool
Int
[DOMRef]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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
      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 ->
          () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Value -> IO ()
f -> do
          IO () -> f ()
forall a. IO a -> f a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)))
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 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
cs@ComponentState{Bool
Int
[DOMRef]
[Binding (ZonkAny 70) (ZonkAny 72)]
ZonkAny 71
ZonkAny 72
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[ZonkAny 73]
-> ZonkAny 72
-> IntMap
     (ComponentState
        (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
-> ZonkAny 71
-> (IntMap
      (ComponentState
         (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)),
    ZonkAny 72, [Schedule (ZonkAny 73)], ComponentIds)
ZonkAny 71 -> ZonkAny 71 -> IO ()
ZonkAny 72 -> IO ()
ZonkAny 72 -> ZonkAny 72 -> Bool
ZonkAny 73 -> IO ()
Value -> Maybe (ZonkAny 73)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_componentParentId :: Int
_componentProps :: ZonkAny 71
_prevComponentProps :: ZonkAny 71
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 73 -> IO ()
_componentModel :: ZonkAny 72
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 70) (ZonkAny 72)]
_componentMailbox :: Value -> Maybe (ZonkAny 73)
_componentDraw :: ZonkAny 72 -> IO ()
_componentPropsPhase :: ZonkAny 71 -> ZonkAny 71 -> IO ()
_componentModelDirty :: ZonkAny 72 -> ZonkAny 72 -> Bool
_componentApplyActions :: [ZonkAny 73]
-> ZonkAny 72
-> IntMap
     (ComponentState
        (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73))
-> ZonkAny 71
-> (IntMap
      (ComponentState
         (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)),
    ZonkAny 72, [Schedule (ZonkAny 73)], 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 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
-> IO ()
forall parent props model action.
ComponentState parent props model action -> IO ()
freeLifecycleHooks ComponentState (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
cs
      else do
        -- We can do a full unmount if we're not doing hot reload
        forM_ (IM.toDescList vcomps) $ \(Int
_, ComponentState (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
vcomp_) ->
          ComponentState (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
-> IO ()
forall parent props model action.
ComponentState parent props model action -> IO ()
unmountComponent ComponentState (ZonkAny 70) (ZonkAny 71) (ZonkAny 72) (ZonkAny 73)
vcomp_
    atomicWriteIORef componentIds topLevelComponentId
    atomicWriteIORef globalQueue mempty
    when (not live) (atomicWriteIORef components mempty)
    abort <- domRef ! "abort"
    isnull <- isNull abort
    when (not 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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 [action]
forall a. Int -> IO [a]
drainQueueAt Int
_componentId IO [action] -> ([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
    [] -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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) <- IO VTree -> IO VTree
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
     ()
-> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentParentId (State
   (ComponentState
      (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
   ()
 -> IO ())
-> State
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
     ()
-> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Lens
  (ComponentState
     (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
  ComponentIds
forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
childrenLens
  (ComponentState
     (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
  ComponentIds
-> LensCore (Maybe ()) ComponentIds
-> LensCore
     (Maybe ())
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
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 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
-> Maybe ()
-> State
     (ComponentState
        (ZonkAny 62) (ZonkAny 63) (ZonkAny 64) (ZonkAny 65))
     ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Maybe ()
forall a. Maybe a
Nothing
  IORef
  (IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)))
-> (IntMap
      (ComponentState
         (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
    -> (IntMap
          (ComponentState
             (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)),
        ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef
  (IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap
    (ComponentState
       (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
  -> (IntMap
        (ComponentState
           (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)),
      ()))
 -> IO ())
-> (IntMap
      (ComponentState
         (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
    -> (IntMap
          (ComponentState
             (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69)),
        ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap
  (ComponentState
     (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
m -> (Int
-> IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
-> IntMap
     (ComponentState
        (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
_componentId IntMap
  (ComponentState
     (ZonkAny 66) (ZonkAny 67) (ZonkAny 68) (ZonkAny 69))
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
-> 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
-> Component parent props model action
-> IO DOMRef
-> IO (ComponentState parent props model action)
initialize Events
events_ Int
vcompId Hydrate
hydrate Bool
False props
newProps 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_
    flip (FFI.set "children") vnode_ vchildren
    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)
cs ->
    (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)
cs, ())
-----------------------------------------------------------------------------
-- | 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 9) (ZonkAny 10) (ZonkAny 11) action)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just compState :: ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action
compState@ComponentState {Bool
Int
[DOMRef]
[Binding (ZonkAny 9) (ZonkAny 11)]
ZonkAny 10
ZonkAny 11
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
[action]
-> ZonkAny 11
-> IntMap
     (ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action)
-> ZonkAny 10
-> (IntMap
      (ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action),
    ZonkAny 11, [Schedule action], ComponentIds)
ZonkAny 10 -> ZonkAny 10 -> IO ()
ZonkAny 11 -> IO ()
ZonkAny 11 -> ZonkAny 11 -> Bool
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_componentParentId :: Int
_componentProps :: ZonkAny 10
_prevComponentProps :: ZonkAny 10
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: ZonkAny 11
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 9) (ZonkAny 11)]
_componentMailbox :: Value -> Maybe action
_componentDraw :: ZonkAny 11 -> IO ()
_componentPropsPhase :: ZonkAny 10 -> ZonkAny 10 -> IO ()
_componentModelDirty :: ZonkAny 11 -> ZonkAny 11 -> Bool
_componentApplyActions :: [action]
-> ZonkAny 11
-> IntMap
     (ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action)
-> ZonkAny 10
-> (IntMap
      (ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action),
    ZonkAny 11, [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 9) (ZonkAny 10) (ZonkAny 11) action
-> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action
compState
          Just ThreadId
tid -> do
            status <- ThreadId -> IO ThreadStatus
threadStatus ThreadId
tid
            case status of
              ThreadStatus
ThreadFinished -> ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action
-> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action
compState
              ThreadStatus
ThreadDied -> ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) action
-> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState (ZonkAny 9) (ZonkAny 10) (ZonkAny 11) 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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
action -> IO ()
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 12) (ZonkAny 13) (ZonkAny 14) (ZonkAny 15))
Nothing -> do
        () -> 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)]
ZonkAny 13
ZonkAny 14
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[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)
ZonkAny 13 -> ZonkAny 13 -> IO ()
ZonkAny 14 -> IO ()
ZonkAny 14 -> ZonkAny 14 -> Bool
ZonkAny 15 -> IO ()
Value -> Maybe (ZonkAny 15)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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
..} -> 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 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{Bool
Int
[DOMRef]
[Binding (ZonkAny 16) (ZonkAny 18)]
ZonkAny 17
ZonkAny 18
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[ZonkAny 19]
-> ZonkAny 18
-> IntMap
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
-> ZonkAny 17
-> (IntMap
      (ComponentState
         (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)),
    ZonkAny 18, [Schedule (ZonkAny 19)], ComponentIds)
ZonkAny 17 -> ZonkAny 17 -> IO ()
ZonkAny 18 -> IO ()
ZonkAny 18 -> ZonkAny 18 -> Bool
ZonkAny 19 -> IO ()
Value -> Maybe (ZonkAny 19)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_componentParentId :: Int
_componentProps :: ZonkAny 17
_prevComponentProps :: ZonkAny 17
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 19 -> IO ()
_componentModel :: ZonkAny 18
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 16) (ZonkAny 18)]
_componentMailbox :: Value -> Maybe (ZonkAny 19)
_componentDraw :: ZonkAny 18 -> IO ()
_componentPropsPhase :: ZonkAny 17 -> ZonkAny 17 -> IO ()
_componentModelDirty :: ZonkAny 18 -> ZonkAny 18 -> Bool
_componentApplyActions :: [ZonkAny 19]
-> ZonkAny 18
-> IntMap
     (ComponentState
        (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19))
-> ZonkAny 17
-> (IntMap
      (ComponentState
         (ZonkAny 16) (ZonkAny 17) (ZonkAny 18) (ZonkAny 19)),
    ZonkAny 18, [Schedule (ZonkAny 19)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
      case Value -> Maybe (ZonkAny 19)
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
        Maybe (ZonkAny 19)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just ZonkAny 19
action ->
          ZonkAny 19 -> IO ()
_componentSink ZonkAny 19
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 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23))
-> Maybe
     (ComponentState
        (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23))
 -> Maybe
      (ComponentState
         (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO
  (Maybe
     (ComponentState
        (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)))
-> (Maybe
      (ComponentState
         (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23))
    -> 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 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)
cs -> Int -> IO ()
climb (ComponentState (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)
-> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentParentId ComponentState (ZonkAny 20) (ZonkAny 21) (ZonkAny 22) (ZonkAny 23)
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 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)
-> IO ()
forall parent props model action.
ComponentState parent props model action -> IO ()
walk (ComponentState (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)
 -> IO ())
-> IO
     (ComponentState
        (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35))
-> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IntMap
  (ComponentState
     (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35))
-> Int
-> ComponentState
     (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)
forall a. IntMap a -> Int -> a
IM.! Int
child) (IntMap
   (ComponentState
      (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35))
 -> ComponentState
      (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)))
-> IO
     (ComponentState
        (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef
  (IntMap
     (ComponentState
        (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState
        (ZonkAny 32) (ZonkAny 33) (ZonkAny 34) (ZonkAny 35)))
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]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
props -> props -> IO ()
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
Value -> Maybe action
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_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 :: [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 ())
-> IO (ComponentState parent props model action) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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)
 -> ComponentState parent props model action)
-> IO (IntMap (ComponentState parent props model action))
-> IO (ComponentState parent props model action)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 36) (ZonkAny 37) parent (ZonkAny 38))
-> Maybe
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentInfoParentId (IntMap
   (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38))
 -> Maybe
      (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
-> IO
     (Maybe
        (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO
  (IntMap
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef
  (IntMap
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
-> IO
     (IntMap
        (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
forall a. IORef a -> IO a
readIORef IORef
  (IntMap
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components) IO
  (Maybe
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)))
-> (Maybe
      (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38))
    -> 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 36) (ZonkAny 37) parent (ZonkAny 38))
Nothing -> Sink action
sink action
errorful
      Just ComponentState {parent
Bool
Int
[DOMRef]
[Binding (ZonkAny 36) parent]
ZonkAny 37
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
parent -> IO ()
parent -> parent -> Bool
[ZonkAny 38]
-> parent
-> IntMap
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38))
-> ZonkAny 37
-> (IntMap
      (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)),
    parent, [Schedule (ZonkAny 38)], ComponentIds)
ZonkAny 37 -> ZonkAny 37 -> IO ()
ZonkAny 38 -> IO ()
Value -> Maybe (ZonkAny 38)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_componentParentId :: Int
_componentProps :: ZonkAny 37
_prevComponentProps :: ZonkAny 37
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 38 -> IO ()
_componentModel :: parent
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 36) parent]
_componentMailbox :: Value -> Maybe (ZonkAny 38)
_componentDraw :: parent -> IO ()
_componentPropsPhase :: ZonkAny 37 -> ZonkAny 37 -> IO ()
_componentModelDirty :: parent -> parent -> Bool
_componentApplyActions :: [ZonkAny 38]
-> parent
-> IntMap
     (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38))
-> ZonkAny 37
-> (IntMap
      (ComponentState (ZonkAny 36) (ZonkAny 37) parent (ZonkAny 38)),
    parent, [Schedule (ZonkAny 38)], 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 model. Eq model => model -> model -> Bool
/= Int
vcompId) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Int
-> IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
-> Maybe
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap
   (ComponentState
      (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
 -> Maybe
      (ComponentState
         (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
-> IO
     (IntMap
        (ComponentState
           (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
-> IO
     (Maybe
        (ComponentState
           (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 IO
  (Maybe
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)))
-> (Maybe
      (ComponentState
         (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
    -> 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 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState{Bool
Int
[DOMRef]
[Binding (ZonkAny 43) (ZonkAny 45)]
ZonkAny 44
ZonkAny 45
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
DOMRef
[ZonkAny 46]
-> ZonkAny 45
-> IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
-> ZonkAny 44
-> (IntMap
      (ComponentState
         (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)),
    ZonkAny 45, [Schedule (ZonkAny 46)], ComponentIds)
ZonkAny 44 -> ZonkAny 44 -> IO ()
ZonkAny 45 -> IO ()
ZonkAny 45 -> ZonkAny 45 -> Bool
ZonkAny 46 -> IO ()
Value -> Maybe (ZonkAny 46)
_componentModel :: forall parent props model action.
ComponentState parent props model action -> model
_componentEvents :: forall parent props model action.
ComponentState parent props model action -> Events
_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
-> [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentDraw :: forall parent props model action.
ComponentState parent props model action -> model -> IO ()
_componentScripts :: forall parent props model action.
ComponentState parent props model action -> [DOMRef]
_componentIsDirty :: forall parent props model action.
ComponentState parent props model action -> Bool
_componentSink :: forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentVTree :: forall parent props model action.
ComponentState parent props model action -> IORef VTree
_componentDOMRef :: forall parent props model action.
ComponentState parent props model action -> DOMRef
_componentSubThreads :: forall parent props model action.
ComponentState parent props model action
-> IORef (Map MisoString ThreadId)
_componentProps :: forall parent props model action.
ComponentState parent props model action -> props
_componentParentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: forall parent props model action.
ComponentState parent props model action -> Int
_componentId :: Int
_componentParentId :: Int
_componentProps :: ZonkAny 44
_prevComponentProps :: ZonkAny 44
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: DOMRef
_componentVTree :: IORef VTree
_componentSink :: ZonkAny 46 -> IO ()
_componentModel :: ZonkAny 45
_componentIsDirty :: Bool
_componentScripts :: [DOMRef]
_componentEvents :: Events
_componentBindings :: [Binding (ZonkAny 43) (ZonkAny 45)]
_componentMailbox :: Value -> Maybe (ZonkAny 46)
_componentDraw :: ZonkAny 45 -> IO ()
_componentPropsPhase :: ZonkAny 44 -> ZonkAny 44 -> IO ()
_componentModelDirty :: ZonkAny 45 -> ZonkAny 45 -> Bool
_componentApplyActions :: [ZonkAny 46]
-> ZonkAny 45
-> IntMap
     (ComponentState
        (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46))
-> ZonkAny 44
-> (IntMap
      (ComponentState
         (ZonkAny 43) (ZonkAny 44) (ZonkAny 45) (ZonkAny 46)),
    ZonkAny 45, [Schedule (ZonkAny 46)], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
            case Value -> Maybe (ZonkAny 46)
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
              Maybe (ZonkAny 46)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just ZonkAny 46
action -> ZonkAny 46 -> IO ()
_componentSink ZonkAny 46
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 ())
-> IO (Maybe (IntMap DOMRef)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> Maybe (IntMap DOMRef))
-> IO WebSockets -> IO (Maybe (IntMap 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 ()
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 ())
-> IO (Maybe (IntMap DOMRef)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    Int -> WebSockets -> Maybe (IntMap DOMRef)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> Maybe (IntMap DOMRef))
-> IO WebSockets -> IO (Maybe (IntMap 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
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
-----------------------------------------------------------------------------
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
  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)
    cleanup live root
    void $ initialize events rootComponentId hydrate True () vcomp_ (pure root)
    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)
----------------------------------------------------------------------------
-- | Load miso's javascript.
--
-- You don't need to use this function if you're compiling w/ WASM and using `miso` or `startApp`.
-- It's already invoked for you. This is a no-op w/ the JS backend.
--
-- If you need access to `Miso.FFI` to call functions from `miso.js`, but you're not
-- using `startApp` or `miso`, you'll need to call this function (w/ WASM only).
--
#ifdef PRODUCTION
#define MISO_JS_PATH "js/miso.prod.js"
#else
#define MISO_JS_PATH "js/miso.js"
#endif
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
  $(evalFile MISO_JS_PATH)
#endif
  action
-----------------------------------------------------------------------------