{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Glazier.React.Window where
import Control.Lens
import Control.Monad.Reader
import Control.Monad.State.Strict
import Control.Monad.Trans.RWS.Strict
import qualified Data.DList as DL
import qualified Data.Map.Strict as M
import qualified GHCJS.Foreign.Callback as J
import qualified GHCJS.Types as J
import Glazier.React.Component
import Glazier.React.Markup
import Glazier.React.ReactId
import Glazier.React.ReadIORef
import Glazier.React.Scene
import Glazier.React.Subject
import qualified JavaScript.Extras as JE
#if MIN_VERSION_base(4,9,0) && !MIN_VERSION_base(4,10,0)
import Data.Semigroup
#endif
type Window s = RWST (Scene s) () (DL.DList ReactMarkup) ReadIORef
getListeners :: MonadReader (Scene s) m => ReactId -> m [JE.Property]
getListeners ri = do
ls <- view (_plan._elementals.ix ri._reactListeners.to M.toList)
pure $ (\(n, (cb, _)) -> (n, JE.toJSR cb)) <$> ls
lf' :: (MonadReader (Scene s) m, MonadState (DL.DList ReactMarkup) m)
=> ReactId
-> JE.JSRep
-> DL.DList JE.Property
-> m ()
lf' ri n props = do
ls <- getListeners ri
lf n (props <> DL.fromList ls)
bh' :: (MonadReader (Scene s) m, MonadState (DL.DList ReactMarkup) m)
=> ReactId
-> JE.JSRep
-> DL.DList JE.Property
-> m r
-> m r
bh' ri n props childs = do
ls <- getListeners ri
bh n (props <> DL.fromList ls) childs
bindListenerContext :: JE.JSRep -> J.Callback (J.JSVal -> J.JSVal -> IO ()) -> JE.JSRep
bindListenerContext = js_bindListenerContext
displaySubject :: (MonadTrans t, MonadState (DL.DList ReactMarkup) (t ReadIORef)) => Subject s -> t ReadIORef ()
displaySubject sbj = do
scn <- lift (doReadIORef (sceneRef sbj))
let scb = scn ^. _plan._shimCallbacks
renderCb = shimRender scb
mountedCb = shimMounted scb
renderedCb = shimRendered scb
refCb = shimRef scb
ri = scn ^. _plan._planId
lf (JE.toJSR shimComponent)
[ ("render", JE.toJSR renderCb)
, ("mounted", JE.toJSR mountedCb)
, ("rendered", JE.toJSR renderedCb)
, ("ref", JE.toJSR refCb)
, ("key", JE.toJSR ri)
]
#ifdef __GHCJS__
foreign import javascript unsafe
"$r = function(j) { $2($1, j) };"
js_bindListenerContext :: JE.JSRep -> J.Callback (J.JSVal -> J.JSVal -> IO ()) -> JE.JSRep
#else
js_bindListenerContext :: JE.JSRep -> J.Callback (J.JSVal -> J.JSVal -> IO ()) -> JE.JSRep
js_bindListenerContext _ _ = JE.JSRep J.nullRef
#endif