-----------------------------------------------------------------------------
{-# 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
  -- ** 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
  , resetComponentState
  , 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)
#if __GLASGOW_HASKELL__ > 865
import           GHC.Conc (labelThread)
#endif
import           GHC.Conc (ThreadStatus(ThreadDied, ThreadFinished), threadStatus)
import           Prelude hiding ((.))
import           System.IO.Unsafe (unsafePerformIO)
import           System.Mem.StableName (makeStableName)
#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 JSVal
-> 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
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
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 JSVal
getComponentMountPoint = do
  Int
_componentId <- IO Int
freshComponentId
  let _componentProps :: props
_componentProps = props
initialProps
  let
    _componentSink :: action -> IO ()
_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

  model
initializedModel <-
    case (Hydrate
hydrate, Maybe (IO model)
hydrateModel) of
      (Hydrate
Hydrate, Just IO model
m) -> IO model
m
      (Hydrate
Draw, Maybe (IO model)
_) -> do
        Int
-> IntMap (ComponentState Any Any model Any)
-> Maybe (ComponentState Any Any model Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentId (IntMap (ComponentState Any Any model Any)
 -> Maybe (ComponentState Any Any model Any))
-> IO (IntMap (ComponentState Any Any model Any))
-> IO (Maybe (ComponentState Any Any model Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any model Any))
-> IO (IntMap (ComponentState Any Any model Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any model Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any model Any))
-> (Maybe (ComponentState Any Any model Any) -> 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 Any Any model Any)
Nothing ->
            model -> IO model
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure model
model
          Just ComponentState Any Any model Any
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 Any Any model Any
cs ComponentState Any Any model Any
-> Lens (ComponentState Any Any model Any) model -> model
forall record field. record -> Lens record field -> field
^. Lens (ComponentState Any Any model Any) 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
  [JSVal]
_componentScripts <- [JSVal] -> [JSVal] -> [JSVal]
forall a. [a] -> [a] -> [a]
(++) ([JSVal] -> [JSVal] -> [JSVal])
-> IO [JSVal] -> IO ([JSVal] -> [JSVal])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [JS] -> IO [JSVal]
renderScripts [JS]
scripts IO ([JSVal] -> [JSVal]) -> IO [JSVal] -> IO [JSVal]
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [CSS] -> IO [JSVal]
renderStyles [CSS]
styles
  JSVal
_componentDOMRef <- IO JSVal
getComponentMountPoint
  Bool
_componentIsDirty <- Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  IORef VTree
_componentVTree <- IO (IORef VTree) -> IO (IORef VTree)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef VTree) -> IO (IORef VTree))
-> IO (IORef VTree) -> IO (IORef VTree)
forall a b. (a -> b) -> a -> b
$ VTree -> IO (IORef VTree)
forall a. a -> IO (IORef a)
newIORef (Object -> VTree
VTree (JSVal -> Object
Object JSVal
jsNull))
  IORef (Map MisoString ThreadId)
_componentSubThreads <- IO (IORef (Map MisoString ThreadId))
-> IO (IORef (Map MisoString ThreadId))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Map MisoString ThreadId -> IO (IORef (Map MisoString ThreadId))
forall a. a -> IO (IORef a)
newIORef Map MisoString ThreadId
forall k a. Map k a
M.empty)

  MVar Double
frame <- IO (MVar Double)
forall a. IO (MVar a)
newEmptyMVar :: IO (MVar Double)
  Seq Any
_componentMailbox <- Seq Any -> IO (Seq Any)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Seq Any
forall a. Seq a
S.empty

  JSVal
rAFCallback <-
    (JSVal -> IO ()) -> IO JSVal
asyncCallback1 ((JSVal -> IO ()) -> IO JSVal) -> (JSVal -> IO ()) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
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
=<< JSVal -> IO Double
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
jsval

  let _componentDraw :: model -> IO ()
_componentDraw = \model
newModel -> do
        props
props <- (ComponentState Any props Any Any
-> Lens (ComponentState Any props Any Any) props -> props
forall record field. record -> Lens record field -> field
^. Lens (ComponentState Any props Any Any) props
forall parent props model action.
Lens (ComponentState parent props model action) props
componentProps) (ComponentState Any props Any Any -> props)
-> (IntMap (ComponentState Any props Any Any)
    -> ComponentState Any props Any Any)
-> IntMap (ComponentState Any props Any Any)
-> 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 Any props Any Any)
-> Int -> ComponentState Any props Any Any
forall a. IntMap a -> Int -> a
IM.! Int
_componentId) (IntMap (ComponentState Any props Any Any) -> props)
-> IO (IntMap (ComponentState Any props Any Any)) -> IO props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any props Any Any))
-> IO (IntMap (ComponentState Any props Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any props Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
        VTree
newVTree <-
          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
_componentParentId Int
_componentId Hydrate
Draw
            Sink action
forall {action}. action -> IO ()
_componentSink LogLevel
logLevel (props -> model -> View model action
view props
props model
newModel)
        VTree
oldVTree <- 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)
        Int
_frame <- JSVal -> IO Int
requestAnimationFrame JSVal
rAFCallback
        Double
_timestamp :: Double <- MVar Double -> IO Double
forall a. MVar a -> IO a
takeMVar MVar Double
frame
        Maybe VTree -> Maybe VTree -> JSVal -> IO ()
Diff.diff (VTree -> Maybe VTree
forall a. a -> Maybe a
Just VTree
oldVTree) (VTree -> Maybe VTree
forall a. a -> Maybe a
Just VTree
newVTree) JSVal
_componentDOMRef
        VTree -> VTree -> IO ()
forall val. ToJSVal val => val -> val -> IO ()
FFI.updateRef VTree
oldVTree VTree
newVTree
        IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef VTree -> VTree -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef VTree
_componentVTree VTree
newVTree)
        IO ()
FFI.flush

  let _componentApplyActions :: [action]
-> model
-> IntMap (ComponentState p props model a)
-> props
-> (IntMap (ComponentState p props model a), model,
    [Schedule action], ComponentIds)
_componentApplyActions = \([action]
actions :: [action]) model
model_ IntMap (ComponentState p props model a)
comps props
props -> do 
        let info :: ComponentInfo parent props
info = Int -> Int -> JSVal -> props -> ComponentInfo parent props
forall parent props.
Int -> Int -> JSVal -> props -> ComponentInfo parent props
ComponentInfo Int
_componentId Int
_componentParentId JSVal
_componentDOMRef props
props
        ((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 parent props model action
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
        , props
Bool
Int
[JSVal]
IORef (Map MisoString ThreadId)
IORef VTree
JSVal
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 :: [JSVal]
_componentDOMRef :: JSVal
_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 :: [JSVal]
_componentIsDirty :: Bool
_componentSink :: Sink action
_componentVTree :: IORef VTree
_componentDOMRef :: JSVal
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentProps :: props
_componentParentId :: Int
_componentId :: Int
..
        }

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isRoot (JSVal -> IORef VTree -> Events -> Bool -> IO ()
delegator JSVal
_componentDOMRef IORef VTree
_componentVTree Events
events (LogLevel
logLevel LogLevel -> [LogLevel] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [LogLevel
DebugEvents, LogLevel
DebugAll]))
  ComponentState parent props model action -> IO ()
forall (m :: * -> *) parent props model action.
MonadIO m =>
ComponentState parent props model action -> m ()
registerComponent ComponentState parent props model action
vcomponent

  -- Inherit bindings state (if applicable)
  model
_componentModel <- Int -> model -> [Binding parent model] -> IO model
forall child parent.
Int -> child -> [Binding parent child] -> IO child
inheritParentBindings Int
_componentParentId model
initializedModel [Binding parent model]
bindings
  Int -> State (ComponentState Any Any model Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentId (Lens (ComponentState Any Any model Any) model
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState Any Any model Any) model
-> model -> State (ComponentState Any Any model Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= model
_componentModel)

  [Sub action] -> IORef (Map MisoString ThreadId) -> Sub action
forall action.
[Sub action] -> IORef (Map MisoString ThreadId) -> Sub action
initSubs [Sub action]
subs IORef (Map MisoString ThreadId)
_componentSubThreads Sink action
forall {action}. action -> IO ()
_componentSink
  model
-> Events
-> Hydrate
-> Bool
-> Component parent props model action
-> ComponentState parent props model action
-> IO ()
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 model
_componentModel Events
events Hydrate
hydrate Bool
isRoot Component parent props model action
comp ComponentState parent props model action
vcomponent
  Maybe action -> Sub action
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe action
mount Sink action
forall {action}. action -> IO ()
_componentSink
  Int -> Object -> IO ()
FFI.mountComponent Int
_componentId (Object -> IO ()) -> IO Object -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> IO Object
forall a. ToObject a => a -> IO Object
toObject JSVal
jsNull
  ComponentState parent props model action
-> IO (ComponentState parent props model action)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentState parent props model action
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 {parent
Bool
Int
[JSVal]
[Binding Any parent]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
parent -> IO ()
parent -> parent -> Bool
[Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], ComponentIds)
Any -> IO ()
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: parent
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any parent]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: parent -> IO ()
_componentModelDirty :: parent -> parent -> Bool
_componentApplyActions :: [Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} <- (IntMap (ComponentState Any Any parent Any)
-> Int -> ComponentState Any Any parent Any
forall a. IntMap a -> Int -> a
IM.! Int
compParentId) (IntMap (ComponentState Any Any parent Any)
 -> ComponentState Any Any parent Any)
-> IO (IntMap (ComponentState Any Any parent Any))
-> IO (ComponentState Any Any parent Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any parent Any))
-> IO (IntMap (ComponentState Any Any parent Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any parent Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
              child -> IO child
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (field -> child -> child
setChildField (parent -> field
getParentField parent
_componentModel) child
m)
            Bidirectional Precedence
Parent parent -> field
getParentField field -> parent -> parent
_ child -> field
_ field -> child -> child
setChildField -> do
              ComponentState {parent
Bool
Int
[JSVal]
[Binding Any parent]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
parent -> IO ()
parent -> parent -> Bool
[Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], ComponentIds)
Any -> IO ()
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: parent
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any parent]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: parent -> IO ()
_componentModelDirty :: parent -> parent -> Bool
_componentApplyActions :: [Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} <- (IntMap (ComponentState Any Any parent Any)
-> Int -> ComponentState Any Any parent Any
forall a. IntMap a -> Int -> a
IM.! Int
compParentId) (IntMap (ComponentState Any Any parent Any)
 -> ComponentState Any Any parent Any)
-> IO (IntMap (ComponentState Any Any parent Any))
-> IO (ComponentState Any Any parent Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any parent Any))
-> IO (IntMap (ComponentState Any Any parent Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any parent Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
              child -> IO child
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (field -> child -> child
setChildField (parent -> field
getParentField parent
_componentModel) child
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 Any Any parent Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
compParentId (State (ComponentState Any Any parent Any) () -> IO ())
-> State (ComponentState Any Any parent Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
         Lens (ComponentState Any Any parent Any) parent
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState Any Any parent Any) parent
-> (parent -> parent)
-> State (ComponentState Any Any parent Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> parent -> parent
setParentField (child -> field
getChildField child
childState)
         Lens (ComponentState Any Any parent Any) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens (ComponentState Any Any parent Any) Bool
-> Bool -> State (ComponentState Any Any parent Any) ()
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 Any Any parent Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
compParentId (State (ComponentState Any Any parent Any) () -> IO ())
-> State (ComponentState Any Any parent Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
         Lens (ComponentState Any Any parent Any) parent
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState Any Any parent Any) parent
-> (parent -> parent)
-> State (ComponentState Any Any parent Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= field -> parent -> parent
setParentField (child -> field
getChildField child
childState)
         Lens (ComponentState Any Any parent Any) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens (ComponentState Any Any parent Any) Bool
-> Bool -> State (ComponentState Any Any parent Any) ()
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
threadId <- IO () -> IO ThreadId
forkIO (Sub action
sub_ Sink action
_componentSink)
    MisoString
subKey <- IO MisoString -> IO MisoString
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO MisoString
freshSubId
    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 (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
-> 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
  StableName model
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
  StableName model
updatedName <- model
n 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
n
  Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StableName model
currentName StableName model -> StableName model -> Bool
forall model. Eq model => model -> model -> Bool
/= StableName model
updatedName Bool -> Bool -> Bool
&& model
c model -> model -> Bool
forall model. Eq model => model -> model -> Bool
/= model
n)
-----------------------------------------------------------------------------
-- | Checks if the Component is mounted before executing actions
isMounted :: ComponentId -> IO Bool
isMounted :: Int -> IO Bool
isMounted Int
vcompId = Maybe (ComponentState Any Any Any Any) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ComponentState Any Any Any Any) -> Bool)
-> (IntMap (ComponentState Any Any Any Any)
    -> Maybe (ComponentState Any Any Any Any))
-> IntMap (ComponentState Any Any Any Any)
-> 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 Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any) -> Bool)
-> IO (IntMap (ComponentState Any Any Any Any)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
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, [Any]))
forall action. IO (Maybe (Int, [action]))
getBatch IO (Maybe (Int, [Any])) -> (Maybe (Int, [Any]) -> 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, [Any])
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.
            IntMap (ComponentState Any Any Any Any)
vcomps <- IO (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components)
            Maybe (ComponentState Any Any Any Any)
-> (ComponentState Any Any Any Any -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Int
-> IntMap (ComponentState Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup (Int -> Int
forall a. Num a => a -> a
negate Int
vcompId) IntMap (ComponentState Any Any Any Any)
vcomps) ((ComponentState Any Any Any Any -> IO ()) -> IO ())
-> (ComponentState Any Any Any Any -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ComponentState {Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
              Any -> IO ()
_componentDraw Any
_componentModel
                             
      Just (Int
vcompId, [Any]
actions) -> do
        Bool
mounted <- Int -> IO Bool
isMounted Int
vcompId
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mounted (Int -> [Any] -> IO ()
forall action. Int -> [action] -> IO ()
run Int
vcompId [Any]
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
      (Any
updatedModel, [Schedule action]
schedules, ComponentIds
dirtySet, ComponentState{Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
action -> IO ()
[action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
Any -> IO ()
Any -> Any -> 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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe action
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..}) <- do
        IORef (IntMap (ComponentState Any Any Any action))
-> (IntMap (ComponentState Any Any Any action)
    -> (IntMap (ComponentState Any Any Any action),
        (Any, [Schedule action], ComponentIds,
         ComponentState Any Any Any action)))
-> IO
     (Any, [Schedule action], ComponentIds,
      ComponentState Any Any Any action)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState Any Any Any action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap (ComponentState Any Any Any action)
  -> (IntMap (ComponentState Any Any Any action),
      (Any, [Schedule action], ComponentIds,
       ComponentState Any Any Any action)))
 -> IO
      (Any, [Schedule action], ComponentIds,
       ComponentState Any Any Any action))
-> (IntMap (ComponentState Any Any Any action)
    -> (IntMap (ComponentState Any Any Any action),
        (Any, [Schedule action], ComponentIds,
         ComponentState Any Any Any action)))
-> IO
     (Any, [Schedule action], ComponentIds,
      ComponentState Any Any Any action)
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState Any Any Any action)
vcomps -> do
          let cs :: ComponentState Any Any Any action
cs@ComponentState {Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
action -> IO ()
[action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
Any -> IO ()
Any -> Any -> 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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe action
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} = IntMap (ComponentState Any Any Any action)
vcomps IntMap (ComponentState Any Any Any action)
-> Int -> ComponentState Any Any Any action
forall a. IntMap a -> Int -> a
IM.! Int
vcompId
          case [action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
_componentApplyActions [action]
events Any
_componentModel IntMap (ComponentState Any Any Any action)
vcomps Any
_componentProps of
            (IntMap (ComponentState Any Any Any action)
x, Any
updatedModel, [Schedule action]
schedules, ComponentIds
dirtySet) ->
              (IntMap (ComponentState Any Any Any action)
x, (Any
updatedModel, [Schedule action]
schedules, ComponentIds
dirtySet, ComponentState Any Any Any action
cs))
      [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
        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 Any -> Any -> Bool
_componentModelDirty Any
_componentModel Any
updatedModel
        then do
          Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentId (State (ComponentState Any Any Any Any) () -> IO ())
-> State (ComponentState Any Any Any Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Lens (ComponentState Any Any Any Any) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens (ComponentState Any Any Any Any) Bool
-> Bool -> State (ComponentState Any Any Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Bool
True
            Lens (ComponentState Any Any Any Any) Any
forall parent props model action.
Lens (ComponentState parent props model action) model
componentModel Lens (ComponentState Any Any Any Any) Any
-> Any -> State (ComponentState Any Any Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Any
updatedModel
          ComponentIds -> IO ComponentIds
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentIds
dirtySet
        else
          ComponentIds -> IO ComponentIds
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ComponentIds
forall a. Monoid a => a
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 Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any)
 -> Maybe (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (Maybe (ComponentState Any Any Any Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components) IO (Maybe (ComponentState Any Any Any Any))
-> (Maybe (ComponentState Any Any Any Any) -> 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 Any Any Any Any -> IO ())
-> Maybe (ComponentState Any Any Any Any) -> 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
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    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
        Any -> IO ()
_componentDraw Any
_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
=<< JSVal -> IO Object
forall a. ToObject a => a -> IO Object
toObject JSVal
jsNull
      Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentId (Lens (ComponentState Any Any Any Any) Bool
forall parent props model action.
Lens (ComponentState parent props model action) Bool
isDirty Lens (ComponentState Any Any Any Any) Bool
-> Bool -> State (ComponentState Any Any Any Any) ()
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
$ do
  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 ->
    case Int
-> IntMap (ComponentState parent props model action)
-> Maybe (ComponentState parent props model action)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId IntMap (ComponentState parent props model action)
vcomps of
      Maybe (ComponentState parent props model action)
Nothing ->
        (IntMap (ComponentState parent props model action)
vcomps, ())
      Just ComponentState parent props model action
comp ->
        (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 Int
vcompId (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 ComponentState parent props model action
comp) 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
      Bool
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
      Bool -> Synch p props m a () -> Synch p props m a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
seen) (Synch p props m a () -> Synch p props m a ())
-> Synch p props m a () -> Synch p props m a ()
forall a b. (a -> b) -> a -> b
$ do
        ComponentState p props m a -> Int -> Synch p props m a ()
forall p props m a.
ComponentState p props m a -> Int -> Synch p props m a ()
propagateParent ComponentState p props m a
cs (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
parentId)
        ComponentState p props m a -> ComponentIds -> Synch p props m a ()
forall p props m a.
ComponentState p props m a -> ComponentIds -> Synch p props m a ()
propagateChildren ComponentState p props m a
cs (ComponentState p props m a
cs ComponentState p props m a
-> Lens (ComponentState p props m a) ComponentIds -> ComponentIds
forall record field. record -> Lens record field -> field
^. Lens (ComponentState p props m a) ComponentIds
forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
children)
        Int -> Synch p props m a ()
forall p props m a. Int -> Synch p props m a ()
markVisited (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)
        Synch p props m a ()
forall p props m a. Synch p props m a ()
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 -> Synch p props m a ()) -> Synch p props m a ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (ComponentIds -> [Int]
IS.toList ComponentIds
childComponents) ((Int -> Synch p props m a ()) -> Synch p props m a ())
-> (Int -> Synch p props m a ()) -> Synch p props m a ()
forall a b. (a -> b) -> a -> b
$ \Int
childId -> do
    ComponentState m props m a
childState <- (IntMap Any -> Any)
-> IntMap (ComponentState p props m a)
-> ComponentState m props m a
forall a b. a -> b
unsafeCoerce (IntMap Any -> Int -> Any
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
    ComponentState p props m a
updatedChild <- ComponentState m props m a -> ComponentState p props m a
forall a b. a -> b
unsafeCoerce (ComponentState m props m a -> ComponentState p props m a)
-> StateT (DFS p props m a) Identity (ComponentState m props m 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 m props m a
 -> Binding m m
 -> StateT (DFS p props m a) Identity (ComponentState m props m a))
-> ComponentState m props m a
-> [Binding m m]
-> StateT (DFS p props m a) Identity (ComponentState m props m a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ComponentState m props m a
-> Binding m m
-> StateT (DFS p props m a) Identity (ComponentState m props m a)
forall child.
ComponentState m props child a
-> Binding m child
-> Synch p props m a (ComponentState m props child a)
process ComponentState m props m a
childState (ComponentState m props m a
childState ComponentState m props m a
-> Lens (ComponentState m props m a) [Binding m m] -> [Binding m m]
forall record field. record -> Lens record field -> field
^. Lens (ComponentState m props m a) [Binding m m]
forall p props m a. Lens (ComponentState p props m a) [Binding p m]
componentBindings)
    let isChildDirty :: Bool
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)
    Bool -> Synch p props m a () -> Synch p props m a ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isChildDirty (Synch p props m a () -> Synch p props m a ())
-> Synch p props m a () -> Synch p props m a ()
forall a b. (a -> b) -> a -> b
$ do
      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))
stateLens (DFS p props m a) (IntMap (ComponentState p props m a))
-> LensCore
     (Maybe (ComponentState p props m a))
     (IntMap (ComponentState p props m a))
-> LensCore (Maybe (ComponentState p props m a)) (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 (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))
childId LensCore (Maybe (ComponentState p props m a)) (DFS p props m a)
-> ComponentState p props m a -> Synch p props m a ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
?= ComponentState p props m a
updatedChild { _componentIsDirty = True }
      Int -> Synch p props m a ()
forall p props m a. Int -> Synch p props m a ()
visit Int
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
      ComponentState p props m a
updatedParent <- ComponentState Any props p a -> ComponentState p props m a
forall a b. a -> b
unsafeCoerce (ComponentState Any props p a -> ComponentState p props m a)
-> StateT (DFS p props m a) Identity (ComponentState Any 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 Any props p a
 -> Binding p m
 -> StateT
      (DFS p props m a) Identity (ComponentState Any props p a))
-> ComponentState Any props p a
-> [Binding p m]
-> StateT (DFS p props m a) Identity (ComponentState Any props p a)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ComponentState Any props p a
-> Binding p m
-> StateT (DFS p props m a) Identity (ComponentState Any 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 Any 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 :: Bool
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)
      Bool
-> StateT (DFS p props m a) Identity ()
-> StateT (DFS p props m a) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isParentDirty (StateT (DFS p props m a) Identity ()
 -> StateT (DFS p props m a) Identity ())
-> StateT (DFS p props m a) Identity ()
-> StateT (DFS p props m a) Identity ()
forall a b. (a -> b) -> a -> b
$ do
        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))
stateLens (DFS p props m a) (IntMap (ComponentState p props m a))
-> LensCore
     (Maybe (ComponentState p props m a))
     (IntMap (ComponentState p props m a))
-> LensCore (Maybe (ComponentState p props m a)) (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 (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))
parentId_ LensCore (Maybe (ComponentState p props m a)) (DFS p props m a)
-> ComponentState p props m a
-> StateT (DFS p props m a) Identity ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record (Maybe field) -> field -> m ()
?= ComponentState p props m a
updatedParent { _componentIsDirty = True }
        Int -> StateT (DFS p props m a) Identity ()
forall p props m a. Int -> Synch p props m a ()
visit Int
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
LogLevel
props -> m -> View m a
a -> Effect p props m a
Value -> Maybe a
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
..} ComponentState {m
props
Bool
Int
[JSVal]
[Binding p m]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
m -> IO ()
m -> m -> Bool
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: a -> IO ()
_componentModel :: m
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding p m]
_componentMailbox :: Value -> Maybe a
_componentDraw :: m -> 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
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
hydrate of
    Hydrate
Draw -> do
      Maybe VTree -> Maybe VTree -> JSVal -> IO ()
Diff.diff Maybe VTree
forall a. Maybe a
Nothing (VTree -> Maybe VTree
forall a. a -> Maybe a
Just VTree
vtree) JSVal
_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
          Bool
hydrated <- LogLevel -> JSVal -> VTree -> IO Bool
Hydrate.hydrate LogLevel
logLevel JSVal
_componentDOMRef VTree
vtree
          if Bool
hydrated
            then do
              IORef VTree -> VTree -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef VTree
_componentVTree VTree
vtree
            else do
              VTree
newTree <-
                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
Draw
                  a -> IO ()
_componentSink LogLevel
logLevel (props -> m -> View m a
view props
_componentProps m
initializedModel)
              Maybe VTree -> Maybe VTree -> JSVal -> IO ()
Diff.diff Maybe VTree
forall a. Maybe a
Nothing (VTree -> Maybe VTree
forall a. a -> Maybe a
Just VTree
newTree) JSVal
_componentDOMRef
              IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef VTree -> VTree -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef VTree
_componentVTree VTree
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 Any) -> (Queue Any -> (Queue Any, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Queue Any)
forall action. IORef (Queue action)
globalQueue ((Queue Any -> (Queue Any, ())) -> IO ())
-> (Queue Any -> (Queue Any, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Queue Any
q ->
     (Queue Any
q Queue Any -> (Queue Any -> Queue Any) -> Queue Any
forall a b. a -> (a -> b) -> b
& Lens (Queue Any) (Seq Int)
forall action. Lens (Queue action) (Seq Int)
queueSchedule Lens (Queue Any) (Seq Int)
-> (Seq Int -> Seq Int) -> Queue Any -> Queue Any
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
leftover) ->
      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 }
-----------------------------------------------------------------------------
-- | 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
-> 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 -> JSVal
_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 -> [JSVal]
_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 -> 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 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 {props
Int
JSVal
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink ->
    Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentInfoId (State (ComponentState Any Any Any Any) () -> IO ())
-> State (ComponentState Any Any Any Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Lens
  (ComponentState Any Any Any Any) (Map MisoString (Value -> IO ()))
forall parent props model action.
Lens
  (ComponentState parent props model action)
  (Map MisoString (Value -> IO ()))
componentTopics Lens
  (ComponentState Any Any Any Any) (Map MisoString (Value -> IO ()))
-> (Map MisoString (Value -> IO ())
    -> Map MisoString (Value -> IO ()))
-> State (ComponentState Any Any Any Any) ()
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentInfoId (State (ComponentState Any Any Any Any) () -> IO ())
-> State (ComponentState Any Any Any Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (Lens
  (ComponentState Any Any Any Any) (Map MisoString (Value -> IO ()))
forall parent props model action.
Lens
  (ComponentState parent props model action)
  (Map MisoString (Value -> IO ()))
componentTopics Lens
  (ComponentState Any Any Any Any) (Map MisoString (Value -> IO ()))
-> (Map MisoString (Value -> IO ())
    -> Map MisoString (Value -> IO ()))
-> State (ComponentState Any Any Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= MisoString
-> Map MisoString (Value -> IO ())
-> Map MisoString (Value -> IO ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete MisoString
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 () 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 () 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 Any Any Any Any -> IO ())
-> [ComponentState Any Any Any Any] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ComponentState Any Any Any Any -> IO ()
forall (m :: * -> *) parent props model action.
MonadIO m =>
ComponentState parent props model action -> m ()
go ([ComponentState Any Any Any Any] -> IO ())
-> IO [ComponentState Any Any Any Any] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IntMap (ComponentState Any Any Any Any)
-> [ComponentState Any Any Any Any]
forall a. IntMap a -> [a]
IM.elems (IntMap (ComponentState Any Any Any Any)
 -> [ComponentState Any Any Any Any])
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO [ComponentState Any Any Any Any]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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
  Int
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)
  MisoString -> IO MisoString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MisoString
"miso-sub-id-" MisoString -> MisoString -> MisoString
forall a. Semigroup a => a -> a -> a
<> Int -> MisoString
forall str. ToMisoString str => str -> MisoString
ms Int
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)
-----------------------------------------------------------------------------
-- | 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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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
       IntMap (ComponentState parent props model action)
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 [action]
-> model
-> IntMap (ComponentState parent props model action)
-> props
-> (IntMap (ComponentState parent props model action), model,
    [Schedule action], ComponentIds)
_componentApplyActions [action]
actions model
_componentModel IntMap (ComponentState parent props model action)
vcomps props
_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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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
  JSVal
head_ <- IO JSVal
FFI.getHead
  [JSVal] -> (JSVal -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [JSVal]
_componentScripts (JSVal -> JSVal -> IO ()
FFI.removeChild JSVal
head_)
-----------------------------------------------------------------------------
-- | 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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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 JSVal
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)
  (Function -> IO ()) -> Maybe Function -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Function -> IO ()
freeFunction (Maybe Function -> IO ()) -> IO (Maybe Function) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> IO (Maybe Function)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Function)) -> IO JSVal -> IO (Maybe Function)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
comp JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"mount" :: MisoString)
  (Function -> IO ()) -> Maybe Function -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Function -> IO ()
freeFunction (Maybe Function -> IO ()) -> IO (Maybe Function) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> IO (Maybe Function)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Function)) -> IO JSVal -> IO (Maybe Function)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
comp JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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
  IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((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
  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
    Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
_componentParentId (State (ComponentState Any Any Any Any) () -> IO ())
-> State (ComponentState Any Any Any Any) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      Lens (ComponentState Any Any Any Any) ComponentIds
forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
childrenLens (ComponentState Any Any Any Any) ComponentIds
-> LensCore (Maybe ()) ComponentIds
-> LensCore (Maybe ()) (ComponentState Any Any Any Any)
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 Any Any Any Any)
-> Maybe () -> State (ComponentState Any Any Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= Maybe ()
forall a. Maybe a
Nothing
    IORef (IntMap (ComponentState Any Any Any Any))
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any), ()))
-> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap (ComponentState Any Any Any Any)
  -> (IntMap (ComponentState Any Any Any Any), ()))
 -> IO ())
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any), ()))
-> IO ()
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState Any Any Any Any)
m -> (Int
-> IntMap (ComponentState Any Any Any Any)
-> IntMap (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
_componentId IntMap (ComponentState Any Any Any Any)
m, ())
  Int -> IO ()
FFI.unmountComponent Int
_componentId
-----------------------------------------------------------------------------
resetComponentState :: IO () -> IO ()
resetComponentState :: IO () -> IO ()
resetComponentState IO ()
clear = do
  IntMap (ComponentState Any Any Any Any)
cs <- IORef (IntMap (ComponentState Any Any Any Any))
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any),
        IntMap (ComponentState Any Any Any Any)))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components ((IntMap (ComponentState Any Any Any Any)
  -> (IntMap (ComponentState Any Any Any Any),
      IntMap (ComponentState Any Any Any Any)))
 -> IO (IntMap (ComponentState Any Any Any Any)))
-> (IntMap (ComponentState Any Any Any Any)
    -> (IntMap (ComponentState Any Any Any Any),
        IntMap (ComponentState Any Any Any Any)))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a b. (a -> b) -> a -> b
$ \IntMap (ComponentState Any Any Any Any)
vcomps -> (IntMap (ComponentState Any Any Any Any)
forall a. Monoid a => a
mempty, IntMap (ComponentState Any Any Any Any)
vcomps)
  IORef (Queue Any) -> Queue Any -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef (Queue Any)
forall action. IORef (Queue action)
globalQueue Queue Any
forall a. Monoid a => a
mempty
  IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Int
componentIds Int
topLevelComponentId
  IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef Int
subIds Int
0
  IntMap (ComponentState Any Any Any Any)
-> (ComponentState Any Any Any Any -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ IntMap (ComponentState Any Any Any Any)
cs ComponentState Any Any Any Any -> IO ()
forall parent props model action.
ComponentState parent props model action -> IO ()
unmountComponent
  IO ()
clear
-----------------------------------------------------------------------------
-- | 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
    Object
vcomp_ <- IO Object
create

    JSVal
mountCallback <- do
      (JSVal -> IO JSVal) -> IO JSVal
syncCallback1' ((JSVal -> IO JSVal) -> IO JSVal)
-> (JSVal -> IO JSVal) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
parent_ -> do
        ComponentState {model
props
Bool
Int
[JSVal]
[Binding model model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
model -> IO ()
model -> model -> Bool
action -> IO ()
[action]
-> model
-> IntMap (ComponentState model props model action)
-> props
-> (IntMap (ComponentState model 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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding model model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> IO ()
_componentModelDirty :: model -> model -> Bool
_componentApplyActions :: [action]
-> model
-> IntMap (ComponentState model props model action)
-> props
-> (IntMap (ComponentState model props model action), model,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} <- Events
-> Int
-> Hydrate
-> Bool
-> props
-> Component model props model action
-> IO JSVal
-> 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 JSVal
-> IO (ComponentState parent props model action)
initialize Events
events_ Int
vcompId Hydrate
hydrate Bool
False props
newProps Component model props model action
app (JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
parent_)
        Int -> State (ComponentState Any Any Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
vcompId (Lens (ComponentState Any Any Any Any) ComponentIds
forall parent props model action.
Lens (ComponentState parent props model action) ComponentIds
children Lens (ComponentState Any Any Any Any) ComponentIds
-> (ComponentIds -> ComponentIds)
-> State (ComponentState Any Any Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> (field -> field) -> m ()
%= Int -> ComponentIds -> ComponentIds
IS.insert Int
_componentId)
        JSVal
vtree <- VTree -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (VTree -> IO JSVal) -> IO VTree -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef VTree -> IO VTree
forall a. IORef a -> IO a
readIORef IORef VTree
_componentVTree
        MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"parent" Object
vcomp_ (JSVal -> Object
Object JSVal
vtree)
        Object
obj <- IO Object
create
        MisoString -> Int -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
setProp MisoString
"componentId" Int
_componentId Object
obj
        MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
setProp MisoString
"componentTree" JSVal
vtree Object
obj
        Object -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Object
obj

    JSVal
unmountCallback <- JSVal -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      (JSVal -> IO ()) -> IO JSVal
FFI.syncCallback1 ((JSVal -> IO ()) -> IO JSVal) -> (JSVal -> IO ()) -> IO JSVal
forall a b. (a -> b) -> a -> b
$ \JSVal
vcompId_ -> do
        Int
componentId_ <- JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
vcompId_
        Int
-> IntMap (ComponentState Any Any Any action)
-> Maybe (ComponentState Any Any Any action)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
componentId_ (IntMap (ComponentState Any Any Any action)
 -> Maybe (ComponentState Any Any Any action))
-> IO (IntMap (ComponentState Any Any Any action))
-> IO (Maybe (ComponentState Any Any Any action))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any action))
-> IO (IntMap (ComponentState Any Any Any action))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any Any action))
-> (Maybe (ComponentState Any Any Any 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
          Maybe (ComponentState Any Any Any action)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState Any Any Any 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 Any Any Any action -> action -> IO ()
forall parent props model action.
ComponentState parent props model action -> action -> IO ()
_componentSink ComponentState Any Any Any action
componentState)
            ComponentState Any Any Any action -> IO ()
forall parent props model action.
ComponentState parent props model action -> IO ()
unmountComponent ComponentState Any Any Any 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.
    JSVal
diffPropsCallback <- JSVal -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (JSVal -> IO JSVal) -> IO JSVal -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
      IO () -> IO JSVal
syncCallback (IO () -> IO JSVal) -> IO () -> IO JSVal
forall a b. (a -> b) -> a -> b
$ do
        Int
componentId_ <- JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked (JSVal -> IO Int) -> IO JSVal -> IO Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object
vcomp_ Object -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"componentId" :: MisoString)
        props
currentProps <- ComponentState Any props Any Any -> props
forall parent props model action.
ComponentState parent props model action -> props
_componentProps (ComponentState Any props Any Any -> props)
-> (IntMap (ComponentState Any props Any Any)
    -> ComponentState Any props Any Any)
-> IntMap (ComponentState Any props Any Any)
-> 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 Any props Any Any)
-> Int -> ComponentState Any props Any Any
forall a. IntMap a -> Int -> a
IM.! Int
componentId_) (IntMap (ComponentState Any props Any Any) -> props)
-> IO (IntMap (ComponentState Any props Any Any)) -> IO props
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any props Any Any))
-> IO (IntMap (ComponentState Any props Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any props Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (props
currentProps props -> props -> Bool
forall model. Eq model => model -> model -> Bool
/= props
newProps) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          Int -> State (ComponentState Any props Any Any) () -> IO ()
forall parent props model action a.
Int -> State (ComponentState parent props model action) a -> IO ()
modifyComponent Int
componentId_ (Lens (ComponentState Any props Any Any) props
forall parent props model action.
Lens (ComponentState parent props model action) props
componentProps Lens (ComponentState Any props Any Any) props
-> props -> State (ComponentState Any props Any Any) ()
forall record (m :: * -> *) field.
MonadState record m =>
Lens record field -> field -> m ()
.= props
newProps)
          Int -> IO ()
enqueueSchedule Int
componentId_

    MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"diffProps" JSVal
diffPropsCallback Object
vcomp_
    MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"child" JSVal
jsNull Object
vcomp_
    Maybe Key -> (Key -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Key
maybeKey (\Key
key -> MisoString -> Key -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" Key
key Object
vcomp_)
    MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"mount" JSVal
mountCallback Object
vcomp_
    MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"unmount" JSVal
unmountCallback Object
vcomp_
    MisoString -> Bool -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"eventPropagation" (Component model props model action -> Bool
forall parent props model action.
Component parent props model action -> Bool
eventPropagation Component model props model action
app) Object
vcomp_
    MisoString -> VTreeType -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"type" VTreeType
VCompType Object
vcomp_
    VTree -> IO VTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> VTree
VTree Object
vcomp_)
  VNode Namespace
ns MisoString
tag [Attribute action]
attrs [View model action]
kids -> do
    Object
vnode_ <- MisoString -> Namespace -> MisoString -> IO Object
createNode MisoString
"vnode" Namespace
ns MisoString
tag
    Object
-> [Attribute action] -> Sink action -> LogLevel -> Events -> IO ()
forall action.
Object
-> [Attribute action] -> Sink action -> LogLevel -> Events -> IO ()
setAttrs Object
vnode_ [Attribute action]
attrs Sink action
snk LogLevel
logLevel_ Events
events_
    JSVal
vchildren <- [Object] -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal ([Object] -> IO JSVal) -> IO [Object] -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object -> IO [Object]
forall {v}. ToJSVal v => v -> IO [Object]
procreate Object
vnode_
    (JSVal -> Object -> IO ()) -> Object -> JSVal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"children") Object
vnode_ JSVal
vchildren
    (JSVal -> Object -> IO ()) -> Object -> JSVal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"type") Object
vnode_ (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VTreeType -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal VTreeType
VNodeType
    VTree -> IO VTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> VTree
VTree Object
vnode_)
      where
        procreate :: v -> IO [Object]
procreate v
parentVTree = do
          [Object]
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]
ordered = [Object] -> [Object]
forall a. [a] -> [a]
reverse [Object]
kidsViews
          [Object] -> IO ()
forall {b}. (ToObject b, ToJSVal b) => [b] -> IO ()
setNextSibling [Object]
ordered
          [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Object]
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 Object
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
                MisoString -> v -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"parent" v
p Object
child
                [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object
child Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
acc)
  VText Maybe Key
key MisoString
t -> do
    Object
vtree <- IO Object
create
    (JSVal -> Object -> IO ()) -> Object -> JSVal -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"type") Object
vtree (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< VTreeType -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal VTreeType
VTextType
    Maybe Key -> (Key -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Key
key ((Key -> IO ()) -> IO ()) -> (Key -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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
    MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"ns" (MisoString
"text" :: MisoString) Object
vtree
    MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"text" MisoString
t Object
vtree
    VTree -> IO VTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> VTree
VTree Object
vtree)
  VFrag Maybe Key
maybeKey [View model action]
kids -> do
    Object
frag <- IO Object
create
    MisoString -> VTreeType -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"type" VTreeType
VFragType Object
frag
    Maybe Key -> (Key -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Key
maybeKey ((Key -> IO ()) -> IO ()) -> (Key -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Key MisoString
k) -> MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" MisoString
k Object
frag
    JSVal
vchildren <- [Object] -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal ([Object] -> IO JSVal) -> IO [Object] -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object -> IO [Object]
forall {v}. ToJSVal v => v -> IO [Object]
procreateFragChildren Object
frag
    MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"children" JSVal
vchildren Object
frag
    VTree -> IO VTree
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object -> VTree
VTree Object
frag)
      where
        procreateFragChildren :: p -> IO [Object]
procreateFragChildren p
parentVTree = do
          [Object]
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]
ordered = [Object] -> [Object]
forall a. [a] -> [a]
reverse [Object]
kidsViews
          (Object -> Object -> IO ()) -> [Object] -> [Object] -> IO ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ ((Object -> MisoString -> Object -> IO ())
-> MisoString -> Object -> Object -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Object -> MisoString -> Object -> IO ()
forall o v.
(ToObject o, ToJSVal v) =>
o -> MisoString -> v -> IO ()
setField MisoString
"nextSibling") [Object]
ordered (Int -> [Object] -> [Object]
forall a. Int -> [a] -> [a]
drop Int
1 [Object]
ordered)
          [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Object]
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 Object
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
                MisoString -> p -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"parent" p
parentVTree Object
child
                [Object] -> IO [Object]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object
child Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
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
  Object
vnode_ <- IO Object
create
  Object
cssObj <- IO Object
create
  Object
propsObj <- IO Object
create
  Object
eventsObj <- IO Object
create
  Object
captures <- IO Object
create
  Object
bubbles <- IO Object
create
  MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"css" Object
cssObj Object
vnode_
  MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"type" MisoString
typ Object
vnode_
  MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"props" Object
propsObj Object
vnode_
  MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"events" Object
eventsObj Object
vnode_
  MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"captures" Object
captures Object
eventsObj
  MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"bubbles" Object
bubbles Object
eventsObj
  MisoString -> Namespace -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"ns" Namespace
ns Object
vnode_
  MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"tag" MisoString
tag Object
vnode_
  Object -> IO Object
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
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 JSVal
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
      JSVal
value <- Value -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Value
v
      MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"key" JSVal
value Object
vnode_
    ClassList [MisoString]
classes ->
      JSVal -> [MisoString] -> IO ()
FFI.populateClass JSVal
jval [MisoString]
classes
    Property MisoString
k Value
v -> do
      JSVal
value <- Value -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Value
v
      JSVal
o <- MisoString -> Object -> IO JSVal
forall o. ToObject o => MisoString -> o -> IO JSVal
getProp MisoString
"props" Object
vnode_
      MisoString -> JSVal -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
k JSVal
value (JSVal -> Object
Object JSVal
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
      JSVal
cssObj <- MisoString -> Object -> IO JSVal
forall o. ToObject o => MisoString -> o -> IO JSVal
getProp MisoString
"css" Object
vnode_
      [(MisoString, MisoString)]
-> ((MisoString, MisoString) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map MisoString MisoString -> [(MisoString, MisoString)]
forall k a. Map k a -> [(k, a)]
M.toList Map MisoString MisoString
styles) (((MisoString, MisoString) -> IO ()) -> IO ())
-> ((MisoString, MisoString) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(MisoString
k,MisoString
v) -> do
        MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
k MisoString
v (JSVal -> Object
Object JSVal
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 [JSVal]
renderStyles [CSS]
styles =
  [CSS] -> (CSS -> IO JSVal) -> IO [JSVal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [CSS]
styles ((CSS -> IO JSVal) -> IO [JSVal])
-> (CSS -> IO JSVal) -> IO [JSVal]
forall a b. (a -> b) -> a -> b
$ \case
    Href MisoString
url Bool
cacheBust -> MisoString -> Bool -> IO JSVal
FFI.addStyleSheet MisoString
url Bool
cacheBust
    Style MisoString
css -> MisoString -> IO JSVal
FFI.addStyle MisoString
css
    Sheet StyleSheet
sheet -> MisoString -> IO JSVal
FFI.addStyle (StyleSheet -> MisoString
renderStyleSheet StyleSheet
sheet)
-----------------------------------------------------------------------------
-- | Renders scripts
--
-- Meant for development purposes
-- Appends JS to <head>
--
renderScripts :: [JS] -> IO [DOMRef]
renderScripts :: [JS] -> IO [JSVal]
renderScripts [JS]
scripts =
  [JS] -> (JS -> IO JSVal) -> IO [JSVal]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [JS]
scripts ((JS -> IO JSVal) -> IO [JSVal]) -> (JS -> IO JSVal) -> IO [JSVal]
forall a b. (a -> b) -> a -> b
$ \case
    Src MisoString
src Bool
cacheBust ->
      MisoString -> Bool -> IO JSVal
FFI.addSrc MisoString
src Bool
cacheBust
    Script MisoString
script ->
      Bool -> MisoString -> IO JSVal
FFI.addScript Bool
False MisoString
script
    Module MisoString
src ->
      Bool -> MisoString -> IO JSVal
FFI.addScript Bool
True MisoString
src
    ImportMap [(MisoString, MisoString)]
importMap -> do
      Object
o <- IO Object
create
      Object
imports <- IO Object
create
      [(MisoString, MisoString)]
-> ((MisoString, MisoString) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(MisoString, MisoString)]
importMap (((MisoString, MisoString) -> IO ()) -> IO ())
-> ((MisoString, MisoString) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(MisoString
k,MisoString
v) ->
        MisoString -> MisoString -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
k MisoString
v Object
imports
      MisoString -> Object -> Object -> IO ()
forall v. ToJSVal v => MisoString -> v -> Object -> IO ()
FFI.set MisoString
"imports" Object
imports Object
o
      MisoString -> IO JSVal
FFI.addScriptImportMap
        (MisoString -> IO JSVal) -> IO MisoString -> IO JSVal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal -> IO MisoString
jsonStringify
        (JSVal -> IO MisoString) -> IO JSVal -> IO MisoString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Object -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal Object
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    Int
-> IntMap (ComponentState Any Any Any action)
-> Maybe (ComponentState Any Any Any action)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentInfoId (IntMap (ComponentState Any Any Any action)
 -> Maybe (ComponentState Any Any Any action))
-> IO (IntMap (ComponentState Any Any Any action))
-> IO (Maybe (ComponentState Any Any Any action))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IntMap (ComponentState Any Any Any action))
-> IO (IntMap (ComponentState Any Any Any action))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (IntMap (ComponentState Any Any Any action))
-> IO (IntMap (ComponentState Any Any Any action))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any action))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components) IO (Maybe (ComponentState Any Any Any action))
-> (Maybe (ComponentState Any Any Any 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
      Maybe (ComponentState Any Any Any action)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just compState :: ComponentState Any Any Any action
compState@ComponentState {Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
action -> IO ()
[action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
Any -> IO ()
Any -> Any -> 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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe action
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [action]
-> Any
-> IntMap (ComponentState Any Any Any action)
-> Any
-> (IntMap (ComponentState Any Any Any action), Any,
    [Schedule action], ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        Maybe ThreadId
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 Maybe ThreadId
mtid of
          Maybe ThreadId
Nothing ->
            ComponentState Any Any Any action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState Any Any Any action
compState
          Just ThreadId
tid -> do
            ThreadStatus
status <- ThreadId -> IO ThreadStatus
threadStatus ThreadId
tid
            case ThreadStatus
status of
              ThreadStatus
ThreadFinished -> ComponentState Any Any Any action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState Any Any Any action
compState
              ThreadStatus
ThreadDied -> ComponentState Any Any Any action -> IO ()
forall {parent} {props} {model}.
ComponentState parent props model action -> IO ()
startThread ComponentState Any Any Any 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
[JSVal]
[Binding parent model]
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
action -> 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
_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 -> [JSVal]
_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 -> JSVal
_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
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: action -> IO ()
_componentModel :: model
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding parent model]
_componentMailbox :: Value -> Maybe action
_componentDraw :: model -> 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
tid <- IO () -> IO ThreadId
forkIO (Sub action
sub action -> IO ()
_componentSink)
      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
-> 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
  Int
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 () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    Int
-> IntMap (ComponentState Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any)
 -> Maybe (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (Maybe (ComponentState Any Any Any Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any Any Any))
-> (Maybe (ComponentState Any Any Any Any) -> 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 Any Any Any Any)
Nothing -> do
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just ComponentState {Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} -> do
        Maybe ThreadId
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)
        Maybe ThreadId -> (ThreadId -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe ThreadId
mtid ((ThreadId -> IO ()) -> IO ()) -> (ThreadId -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any)
 -> Maybe (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (Maybe (ComponentState Any Any Any Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any Any Any))
-> (Maybe (ComponentState Any Any Any Any) -> 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 Any Any Any Any)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just ComponentState{Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
      case Value -> Maybe Any
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
        Maybe Any
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Any
action ->
          Any -> IO ()
_componentSink Any
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (Int -> message -> IO ()
forall message. ToJSON message => Int -> message -> IO ()
mail Int
_componentInfoParentId message
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (Int -> IO ()
climb Int
_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 Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any)
 -> Maybe (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (Maybe (ComponentState Any Any Any Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any Any Any))
-> (Maybe (ComponentState Any Any Any Any) -> 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 Any Any Any Any)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState Any Any Any Any
cs -> Int -> IO ()
climb (ComponentState Any Any Any Any -> Int
forall parent props model action.
ComponentState parent props model action -> Int
_componentParentId ComponentState Any Any Any Any
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    ComponentState {Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} <- (IntMap (ComponentState Any Any Any Any)
-> Int -> ComponentState Any Any Any Any
forall a. IntMap a -> Int -> a
IM.! Int
_componentInfoId) (IntMap (ComponentState Any Any Any Any)
 -> ComponentState Any Any Any Any)
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (ComponentState Any Any Any Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
    [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 -> message -> IO ()) -> message -> Int -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> message -> IO ()
forall message. ToJSON message => Int -> message -> IO ()
mail message
msg)
----------------------------------------------------------------------------
-- | 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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    Int
-> IntMap (ComponentState Any Any parent Any)
-> Maybe (ComponentState Any Any parent Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
_componentInfoParentId (IntMap (ComponentState Any Any parent Any)
 -> Maybe (ComponentState Any Any parent Any))
-> IO (IntMap (ComponentState Any Any parent Any))
-> IO (Maybe (ComponentState Any Any parent Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (IntMap (ComponentState Any Any parent Any))
-> IO (IntMap (ComponentState Any Any parent Any))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef (IntMap (ComponentState Any Any parent Any))
-> IO (IntMap (ComponentState Any Any parent Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any parent Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components) IO (Maybe (ComponentState Any Any parent Any))
-> (Maybe (ComponentState Any Any parent Any) -> 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 Any Any parent Any)
Nothing -> Sink action
sink action
errorful
      Just ComponentState {parent
Bool
Int
[JSVal]
[Binding Any parent]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
parent -> IO ()
parent -> parent -> Bool
[Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], ComponentIds)
Any -> IO ()
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: parent
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any parent]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: parent -> IO ()
_componentModelDirty :: parent -> parent -> Bool
_componentApplyActions :: [Any]
-> parent
-> IntMap (ComponentState Any Any parent Any)
-> Any
-> (IntMap (ComponentState Any Any parent Any), parent,
    [Schedule Any], 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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    [Int]
vcompIds <- IntMap (ComponentState Any Any Any Any) -> [Int]
forall a. IntMap a -> [Int]
IM.keys (IntMap (ComponentState Any Any Any Any) -> [Int])
-> IO (IntMap (ComponentState Any Any Any Any)) -> IO [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components
    [Int] -> (Int -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int]
vcompIds ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \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 Any Any Any Any)
-> Maybe (ComponentState Any Any Any Any)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (IntMap (ComponentState Any Any Any Any)
 -> Maybe (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
-> IO (Maybe (ComponentState Any Any Any Any))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (IntMap (ComponentState Any Any Any Any))
-> IO (IntMap (ComponentState Any Any Any Any))
forall a. IORef a -> IO a
readIORef IORef (IntMap (ComponentState Any Any Any Any))
forall parent props model action.
IORef (IntMap (ComponentState parent props model action))
components IO (Maybe (ComponentState Any Any Any Any))
-> (Maybe (ComponentState Any Any Any Any) -> 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 Any Any Any Any)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          Just ComponentState{Bool
Int
[JSVal]
[Binding Any Any]
Any
IORef (Map MisoString ThreadId)
IORef VTree
Events
Map MisoString (Value -> IO ())
ComponentIds
JSVal
[Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
Any -> IO ()
Any -> Any -> Bool
Value -> Maybe Any
_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
_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 -> [JSVal]
_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 -> JSVal
_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 :: Any
_componentSubThreads :: IORef (Map MisoString ThreadId)
_componentDOMRef :: JSVal
_componentVTree :: IORef VTree
_componentSink :: Any -> IO ()
_componentModel :: Any
_componentIsDirty :: Bool
_componentScripts :: [JSVal]
_componentEvents :: Events
_componentBindings :: [Binding Any Any]
_componentMailbox :: Value -> Maybe Any
_componentDraw :: Any -> IO ()
_componentModelDirty :: Any -> Any -> Bool
_componentApplyActions :: [Any]
-> Any
-> IntMap (ComponentState Any Any Any Any)
-> Any
-> (IntMap (ComponentState Any Any Any Any), Any, [Schedule Any],
    ComponentIds)
_componentTopics :: Map MisoString (Value -> IO ())
_componentChildren :: ComponentIds
..} ->
            case Value -> Maybe Any
_componentMailbox (message -> Value
forall a. ToJSON a => a -> Value
toJSON message
msg) of
              Maybe Any
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Just Any
action -> Any -> IO ()
_componentSink Any
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 JSVal)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
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 ()) -> (JSVal -> IO Closed) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO Closed
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
      ((JSVal -> IO ()) -> Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked))
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
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 ()) -> (JSVal -> IO Closed) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO Closed
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (JSVal -> action) -> JSVal -> 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) -> (JSVal -> Blob) -> JSVal -> 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
. JSVal -> Blob
Blob))
      Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
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 ()) -> (JSVal -> IO Closed) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO Closed
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (JSVal -> action) -> JSVal -> 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)
-> (JSVal -> ArrayBuffer) -> JSVal -> 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
. JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
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 ()) -> (JSVal -> IO Closed) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO Closed
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\JSVal
bytes -> do
          Value
value :: Value <- JSVal -> IO Value
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
bytes
          case Value -> Result json
forall a. FromJSON a => Value -> Result a
fromJSON Value
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 (JSVal -> IO ())
forall a. Maybe a
Nothing
      Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
forall action parent props model.
(WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
websocketCore ((WebSocket -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (WebSocket -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \WebSocket
webSocketId Sink action
sink ->
    MisoString
-> IO ()
-> (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
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 ()) -> (JSVal -> IO Closed) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO Closed
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked)
      ((JSVal -> IO ()) -> Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked))
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (\JSVal
bytes -> do
          Value
value :: Value <- JSVal -> IO Value
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
bytes
          case Value -> Result json
forall a. FromJSON a => Value -> Result a
fromJSON Value
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)))
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (JSVal -> action) -> JSVal -> 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)
-> (JSVal -> Payload json) -> JSVal -> 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) -> (JSVal -> Blob) -> JSVal -> 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
. JSVal -> Blob
Blob))
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Sink action
sink Sink action -> (JSVal -> action) -> JSVal -> 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)
-> (JSVal -> Payload json) -> JSVal -> 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)
-> (JSVal -> ArrayBuffer) -> JSVal -> 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
. JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
websocketCore WebSocket -> Sink action -> IO JSVal
core = do
  ComponentInfo {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    WebSocket
webSocketId <- IO WebSocket
freshWebSocket
    JSVal
socket <- WebSocket -> Sink action -> IO JSVal
core WebSocket
webSocketId Sink action
sink
    Int -> WebSocket -> JSVal -> IO ()
insertWebSocket Int
_componentInfoId WebSocket
webSocketId JSVal
socket
  where
    insertWebSocket :: ComponentId -> WebSocket -> Socket -> IO ()
    insertWebSocket :: Int -> WebSocket -> JSVal -> IO ()
insertWebSocket Int
componentId_ (WebSocket Int
socketId) JSVal
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 JSVal -> IntMap JSVal -> IntMap JSVal)
-> WebSockets -> WebSockets -> WebSockets
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith IntMap JSVal -> IntMap JSVal -> IntMap JSVal
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 JSVal -> WebSockets
forall a. Int -> a -> IntMap a
IM.singleton Int
componentId_
            (IntMap JSVal -> WebSockets) -> IntMap JSVal -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> JSVal -> IntMap JSVal
forall a. Int -> a -> IntMap a
IM.singleton Int
socketId JSVal
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 JSVal
getWebSocket Int
vcompId (WebSocket Int
websocketId) =
  Int -> IntMap JSVal -> Maybe JSVal
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
websocketId (IntMap JSVal -> Maybe JSVal)
-> (WebSockets -> Maybe (IntMap JSVal))
-> WebSockets
-> Maybe JSVal
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> WebSockets -> Maybe (IntMap JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId
-----------------------------------------------------------------------------
finalizeWebSockets :: ComponentId -> IO ()
finalizeWebSockets :: Int -> IO ()
finalizeWebSockets Int
vcompId = do
  (IntMap JSVal -> IO ()) -> Maybe (IntMap JSVal) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((JSVal -> IO ()) -> [JSVal] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ JSVal -> IO ()
FFI.websocketClose ([JSVal] -> IO ())
-> (IntMap JSVal -> [JSVal]) -> IntMap JSVal -> 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 JSVal -> [JSVal]
forall a. IntMap a -> [a]
IM.elems) (Maybe (IntMap JSVal) -> IO ())
-> IO (Maybe (IntMap JSVal)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    Int -> WebSockets -> Maybe (IntMap JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> Maybe (IntMap JSVal))
-> IO WebSockets -> IO (Maybe (IntMap JSVal))
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    Maybe JSVal
result <-
      IORef WebSockets
-> (WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
websocketConnections ((WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal))
-> (WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ \WebSockets
imap ->
        Int -> WebSocket -> WebSockets -> WebSockets
dropWebSocket Int
_componentInfoId WebSocket
socketId WebSockets
imap WebSockets -> Maybe JSVal -> (WebSockets, Maybe JSVal)
forall k v. k -> v -> (k, v)
=:
          Int -> WebSocket -> WebSockets -> Maybe JSVal
getWebSocket Int
_componentInfoId WebSocket
socketId WebSockets
imap
    case Maybe JSVal
result of
      Maybe JSVal
Nothing ->
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just JSVal
socket ->
        JSVal -> IO ()
FFI.websocketClose JSVal
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 JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId WebSockets
websockets of
        Maybe (IntMap JSVal)
Nothing ->
          WebSockets
websockets
        Just IntMap JSVal
componentSockets ->
          Int -> IntMap JSVal -> WebSockets -> WebSockets
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
vcompId (Int -> IntMap JSVal -> IntMap JSVal
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
websocketId IntMap JSVal
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    Int -> WebSocket -> WebSockets -> Maybe JSVal
getWebSocket Int
_componentInfoId WebSocket
socketId (WebSockets -> Maybe JSVal) -> IO WebSockets -> IO (Maybe JSVal)
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 JSVal) -> (Maybe JSVal -> 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 JSVal
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just JSVal
socket ->
        case Payload value
msg of
          JSON value
json_ ->
            JSVal -> JSVal -> IO ()
FFI.websocketSend JSVal
socket (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal (value -> MisoString
forall a. ToJSON a => a -> MisoString
encode value
json_)
          BUFFER ArrayBuffer
arrayBuffer_ -> do
            JSVal -> JSVal -> IO ()
FFI.websocketSend JSVal
socket (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ArrayBuffer -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal ArrayBuffer
arrayBuffer_
          TEXT MisoString
txt ->
            JSVal -> JSVal -> IO ()
FFI.websocketSend JSVal
socket (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MisoString -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
toJSVal MisoString
txt
          BLOB Blob
blob_ ->
            JSVal -> JSVal -> IO ()
FFI.websocketSend JSVal
socket (JSVal -> IO ()) -> IO JSVal -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Blob -> IO JSVal
forall a. ToJSVal a => a -> IO JSVal
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
     Int -> WebSocket -> WebSockets -> Maybe JSVal
getWebSocket Int
_componentInfoId WebSocket
socketId (WebSockets -> Maybe JSVal) -> IO WebSockets -> IO (Maybe JSVal)
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 JSVal) -> (Maybe JSVal -> 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 JSVal
socket -> do
        JSVal
x <- JSVal
socket JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"socketState" :: MisoString)
        SocketState
socketstate <- Int -> SocketState
forall a. Enum a => Int -> a
toEnum (Int -> SocketState) -> IO Int -> IO SocketState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> JSVal -> IO Int
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
x
        Sink action
sink (SocketState -> action
callback SocketState
socketstate)
      Maybe JSVal
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 :: JSVal -> IO (Maybe Closed)
fromJSVal JSVal
o = do
    Maybe CloseCode
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 JSVal -> IO (Maybe Int)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Int)) -> IO JSVal -> IO (Maybe Int)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
o JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"code" :: MisoString)
    Maybe Bool
wasClean_ <- JSVal -> IO (Maybe Bool)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe Bool)) -> IO JSVal -> IO (Maybe Bool)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
o JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"wasClean" :: MisoString)
    Maybe MisoString
reason_ <- JSVal -> IO (Maybe MisoString)
forall a. FromJSVal a => JSVal -> IO (Maybe a)
fromJSVal (JSVal -> IO (Maybe MisoString))
-> IO JSVal -> IO (Maybe MisoString)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSVal
o JSVal -> MisoString -> IO JSVal
forall o. ToObject o => o -> MisoString -> IO JSVal
! (MisoString
"reason" :: MisoString)
    Maybe Closed -> IO (Maybe Closed)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CloseCode -> Bool -> MisoString -> Closed
Closed (CloseCode -> Bool -> MisoString -> Closed)
-> Maybe CloseCode -> Maybe (Bool -> MisoString -> Closed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CloseCode
closed_ Maybe (Bool -> MisoString -> Closed)
-> Maybe Bool -> Maybe (MisoString -> Closed)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Bool
wasClean_ Maybe (MisoString -> Closed) -> Maybe MisoString -> Maybe Closed
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe MisoString
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 JSVal
(WebSocket -> IO JSVal) -> ToJSVal WebSocket
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: WebSocket -> IO JSVal
toJSVal :: WebSocket -> IO JSVal
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 JSVal
(EventSource -> IO JSVal) -> ToJSVal EventSource
forall a. (a -> IO JSVal) -> ToJSVal a
$ctoJSVal :: EventSource -> IO JSVal
toJSVal :: EventSource -> IO JSVal
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 JSVal)
-> Effect parent props model action
forall action parent props model.
(EventSource -> Sink action -> IO JSVal)
-> Effect parent props model action
eventSourceCore ((EventSource -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (EventSource -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \EventSource
eventSourceId Sink action
sink -> do
    MisoString
-> IO ()
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
FFI.eventSourceConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ EventSource -> action
onOpen EventSource
eventSourceId)
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((JSVal -> IO ()) -> Maybe (JSVal -> IO ()))
-> (JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a b. (a -> b) -> a -> b
$ \JSVal
e -> do
          MisoString
txt <- JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
e
          Sink action
sink (MisoString -> action
onMessage MisoString
txt))
      Maybe (JSVal -> 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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
forall action parent props model.
(EventSource -> Sink action -> IO JSVal)
-> Effect parent props model action
eventSourceCore ((EventSource -> Sink action -> IO JSVal)
 -> Effect parent props model action)
-> (EventSource -> Sink action -> IO JSVal)
-> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \EventSource
eventSourceId Sink action
sink -> do
    MisoString
-> IO ()
-> Maybe (JSVal -> IO ())
-> Maybe (JSVal -> IO ())
-> (JSVal -> IO ())
-> Bool
-> IO JSVal
FFI.eventSourceConnect MisoString
url
      (Sink action
sink Sink action -> Sink action
forall a b. (a -> b) -> a -> b
$ EventSource -> action
onOpen EventSource
eventSourceId)
      Maybe (JSVal -> IO ())
forall a. Maybe a
Nothing
      ((JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((JSVal -> IO ()) -> Maybe (JSVal -> IO ()))
-> (JSVal -> IO ()) -> Maybe (JSVal -> IO ())
forall a b. (a -> b) -> a -> b
$ \JSVal
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
<$> JSVal -> IO Value
forall a. FromJSVal a => JSVal -> IO a
fromJSValUnchecked JSVal
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 ()) -> (JSVal -> IO MisoString) -> JSVal -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< JSVal -> IO MisoString
forall a. FromJSVal a => JSVal -> 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 JSVal)
-> Effect parent props model action
eventSourceCore EventSource -> Sink action -> IO JSVal
core = do
  ComponentInfo {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  (Sink action -> IO ()) -> Effect parent props model action
forall action parent props model.
(Sink action -> IO ()) -> Effect parent props model action
withSink ((Sink action -> IO ()) -> Effect parent props model action)
-> (Sink action -> IO ()) -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ \Sink action
sink -> do
    EventSource
eventSourceId <- IO EventSource
freshEventSource
    JSVal
socket <- EventSource -> Sink action -> IO JSVal
core EventSource
eventSourceId Sink action
sink
    Int -> EventSource -> JSVal -> IO ()
insertEventSource Int
_componentInfoId EventSource
eventSourceId JSVal
socket
  where
    insertEventSource :: ComponentId -> EventSource -> Socket -> IO ()
    insertEventSource :: Int -> EventSource -> JSVal -> IO ()
insertEventSource Int
componentId_ (EventSource Int
socketId) JSVal
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 JSVal -> IntMap JSVal -> IntMap JSVal)
-> WebSockets -> WebSockets -> WebSockets
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith IntMap JSVal -> IntMap JSVal -> IntMap JSVal
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 JSVal -> WebSockets
forall a. Int -> a -> IntMap a
IM.singleton Int
componentId_
            (IntMap JSVal -> WebSockets) -> IntMap JSVal -> WebSockets
forall a b. (a -> b) -> a -> b
$ Int -> JSVal -> IntMap JSVal
forall a. Int -> a -> IntMap a
IM.singleton Int
socketId JSVal
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 {props
Int
JSVal
_componentInfoProps :: forall parent props. ComponentInfo parent props -> props
_componentInfoDOMRef :: forall parent props. ComponentInfo parent props -> JSVal
_componentInfoParentId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: forall parent props. ComponentInfo parent props -> Int
_componentInfoId :: Int
_componentInfoParentId :: Int
_componentInfoDOMRef :: JSVal
_componentInfoProps :: props
..} <- RWST
  (ComponentInfo parent props)
  [Schedule action]
  model
  Identity
  (ComponentInfo parent props)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO () -> Effect parent props model action
forall parent props model action.
IO () -> Effect parent props model action
io_ (IO () -> Effect parent props model action)
-> IO () -> Effect parent props model action
forall a b. (a -> b) -> a -> b
$ do
    Maybe JSVal
result <-
      IORef WebSockets
-> (WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef WebSockets
eventSourceConnections ((WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal))
-> (WebSockets -> (WebSockets, Maybe JSVal)) -> IO (Maybe JSVal)
forall a b. (a -> b) -> a -> b
$ \WebSockets
imap ->
        Int -> EventSource -> WebSockets -> WebSockets
dropEventSource Int
_componentInfoId EventSource
socketId WebSockets
imap WebSockets -> Maybe JSVal -> (WebSockets, Maybe JSVal)
forall k v. k -> v -> (k, v)
=:
          Int -> EventSource -> WebSockets -> Maybe JSVal
getEventSource Int
_componentInfoId EventSource
socketId WebSockets
imap
    case Maybe JSVal
result of
      Maybe JSVal
Nothing ->
        () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just JSVal
socket ->
        JSVal -> IO ()
FFI.eventSourceClose JSVal
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 JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId WebSockets
eventSources of
        Maybe (IntMap JSVal)
Nothing ->
          WebSockets
eventSources
        Just IntMap JSVal
componentSockets ->
          Int -> IntMap JSVal -> WebSockets -> WebSockets
forall a. Int -> a -> IntMap a -> IntMap a
IM.insert Int
vcompId (Int -> IntMap JSVal -> IntMap JSVal
forall a. Int -> IntMap a -> IntMap a
IM.delete Int
eventSourceId IntMap JSVal
componentSockets) WebSockets
eventSources

    getEventSource :: ComponentId -> EventSource -> EventSources -> Maybe Socket
    getEventSource :: Int -> EventSource -> WebSockets -> Maybe JSVal
getEventSource Int
vcompId (EventSource Int
eventSourceId) =
      Int -> IntMap JSVal -> Maybe JSVal
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
eventSourceId (IntMap JSVal -> Maybe JSVal)
-> (WebSockets -> Maybe (IntMap JSVal))
-> WebSockets
-> Maybe JSVal
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Int -> WebSockets -> Maybe (IntMap JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId
-----------------------------------------------------------------------------
finalizeEventSources :: ComponentId -> IO ()
finalizeEventSources :: Int -> IO ()
finalizeEventSources Int
vcompId = do
  (IntMap JSVal -> IO ()) -> Maybe (IntMap JSVal) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((JSVal -> IO ()) -> [JSVal] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ JSVal -> IO ()
FFI.eventSourceClose ([JSVal] -> IO ())
-> (IntMap JSVal -> [JSVal]) -> IntMap JSVal -> 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 JSVal -> [JSVal]
forall a. IntMap a -> [a]
IM.elems) (Maybe (IntMap JSVal) -> IO ())
-> IO (Maybe (IntMap JSVal)) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
    Int -> WebSockets -> Maybe (IntMap JSVal)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
vcompId (WebSockets -> Maybe (IntMap JSVal))
-> IO WebSockets -> IO (Maybe (IntMap JSVal))
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
  -> Component parent () model action
  -> IO ()
initComponent :: forall parent model action.
(Eq parent, Eq model) =>
Events -> Hydrate -> Component parent () model action -> IO ()
initComponent Events
events Hydrate
hydrate vcomp_ :: Component parent () model action
vcomp_@Component {model
Bool
[Binding parent model]
[JS]
[CSS]
[Sub action]
Maybe action
Maybe (IO model)
Maybe MisoString
LogLevel
action -> Effect parent () model action
() -> model -> View model action
Value -> Maybe 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
..} = IO () -> IO ()
forall a. IO a -> IO a
withJS (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
  JSVal
root <- MisoString -> IO JSVal
Diff.mountElement (Maybe MisoString -> MisoString
getMountPoint Maybe MisoString
mountPoint)
  IO (ComponentState parent () model action) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (ComponentState parent () model action) -> IO ())
-> IO (ComponentState parent () model action) -> IO ()
forall a b. (a -> b) -> a -> b
$ Events
-> Int
-> Hydrate
-> Bool
-> ()
-> Component parent () model action
-> IO JSVal
-> IO (ComponentState parent () model action)
forall parent model props action.
(Eq parent, Eq model, Eq props) =>
Events
-> Int
-> Hydrate
-> Bool
-> props
-> Component parent props model action
-> IO JSVal
-> IO (ComponentState parent props model action)
initialize Events
events Int
rootComponentId Hydrate
hydrate Bool
True () Component parent () model action
vcomp_ (JSVal -> IO JSVal
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JSVal
root)
#if __GLASGOW_HASKELL__ > 865
  (ThreadId -> String -> IO ()) -> String -> ThreadId -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ThreadId -> String -> IO ()
labelThread String
"scheduler" (ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO () -> IO ThreadId
forkIO IO ()
scheduler
#else
  void (forkIO scheduler)
#endif
----------------------------------------------------------------------------
-- | 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
  IO a
action
-----------------------------------------------------------------------------