module React.Flux.Lifecycle (
defineLifecycleView
, lifecycleConfig
, LifecycleViewConfig(..)
, LPropsAndState(..)
, LDOM(..)
, LSetStateFn
) where
import Data.Typeable (Typeable)
import React.Flux.Internal
import React.Flux.Views
import React.Flux.DOM (div_)
import Control.DeepSeq (NFData)
#ifdef __GHCJS__
import Control.Monad.Writer
import System.IO.Unsafe (unsafePerformIO)
import React.Flux.Export
import GHCJS.Foreign (jsNull)
import GHCJS.Foreign.Callback
import GHCJS.Types (JSVal, jsval)
#endif
type HTMLElement = JSVal
data LPropsAndState props state = LPropsAndState
{ lGetProps :: IO props
, lGetState :: IO state
}
data LDOM = LDOM
{ lThis :: IO HTMLElement
, lRef :: JSString -> IO HTMLElement
}
type LSetStateFn state = state -> IO ()
data LifecycleViewConfig props state = LifecycleViewConfig
{ lRender :: state -> props -> ReactElementM (StatefulViewEventHandler state) ()
, lComponentWillMount :: Maybe (LPropsAndState props state -> LSetStateFn state -> IO ())
, lComponentDidMount :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> IO ())
, lComponentWillReceiveProps :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> props -> IO ())
, lComponentWillUpdate :: Maybe (LPropsAndState props state -> LDOM -> props -> state -> IO ())
, lComponentDidUpdate :: Maybe (LPropsAndState props state -> LDOM -> LSetStateFn state -> props -> state -> IO ())
, lComponentWillUnmount :: Maybe (LPropsAndState props state -> LDOM -> IO ())
}
lifecycleConfig :: LifecycleViewConfig props state
lifecycleConfig = LifecycleViewConfig
{ lRender = \_ _ -> div_ mempty
, lComponentWillMount = Nothing
, lComponentDidMount = Nothing
, lComponentWillReceiveProps = Nothing
, lComponentWillUpdate = Nothing
, lComponentDidUpdate = Nothing
, lComponentWillUnmount = Nothing
}
defineLifecycleView :: (Typeable props, Typeable state, NFData state)
=> String -> state -> LifecycleViewConfig props state -> ReactView props
#ifdef __GHCJS__
defineLifecycleView name initialState cfg = unsafePerformIO $ do
initialRef <- export initialState
let render state props = return $ lRender cfg state props
renderCb <- mkRenderCallback (js_ReactGetState >=> parseExport) runStateViewHandler render
let dom this = LDOM { lThis = js_ReactFindDOMNode this
, lRef = \r -> js_ReactGetRef this r
}
setStateFn this s = export s >>= js_ReactUpdateAndReleaseState this
willMountCb <- mkLCallback1 (lComponentWillMount cfg) $ \f this ->
f (setStateFn this)
didMountCb <- mkLCallback1 (lComponentDidMount cfg) $ \f this ->
f (dom this) (setStateFn this)
willRecvPropsCb <- mkLCallback2 (lComponentWillReceiveProps cfg) $ \f this newPropsE -> do
newProps <- parseExport $ Export newPropsE
f (dom this) (setStateFn this) newProps
willUpdateCb <- mkLCallback2 (lComponentWillUpdate cfg) $ \f this argRef -> do
let arg = ReactThis argRef
nextProps <- js_ReactGetProps arg >>= parseExport
nextState <- js_ReactGetState arg >>= parseExport
f (dom this) nextProps nextState
didUpdateCb <- mkLCallback2 (lComponentDidUpdate cfg) $ \f this argRef -> do
let arg = ReactThis argRef
oldProps <- js_ReactGetProps arg >>= parseExport
oldState <- js_ReactGetState arg >>= parseExport
f (dom this) (setStateFn this) oldProps oldState
willUnmountCb <- mkLCallback1 (lComponentWillUnmount cfg) $ \f this ->
f (dom this)
ReactView <$> js_makeLifecycleView (toJSString name) initialRef
renderCb willMountCb didMountCb willRecvPropsCb willUpdateCb didUpdateCb willUnmountCb
mkLCallback1 :: (Typeable props, Typeable state)
=> Maybe (LPropsAndState props state -> f)
-> (f -> ReactThis state props -> IO ())
-> IO JSVal
mkLCallback1 Nothing _ = return jsNull
mkLCallback1 (Just f) c = do
cb <- syncCallback1 ThrowWouldBlock $ \thisRef -> do
let this = ReactThis thisRef
ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport
, lGetState = js_ReactGetState this >>= parseExport
}
c (f ps) this
return $ jsval cb
mkLCallback2 :: (Typeable props, Typeable state)
=> Maybe (LPropsAndState props state -> f)
-> (f -> ReactThis state props -> JSVal -> IO ())
-> IO JSVal
mkLCallback2 Nothing _ = return jsNull
mkLCallback2 (Just f) c = do
cb <- syncCallback2 ThrowWouldBlock $ \thisRef argRef -> do
let this = ReactThis thisRef
ps = LPropsAndState { lGetProps = js_ReactGetProps this >>= parseExport
, lGetState = js_ReactGetState this >>= parseExport
}
c (f ps) this argRef
return $ jsval cb
#else
defineLifecycleView _ _ _ = ReactView $ ReactViewRef ()
#endif