{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
module Glazier.React.Scene where
import Control.Lens
import Control.Lens.Misc
import Data.IORef
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified GHC.Generics as G
import qualified GHCJS.Foreign.Callback as J
import qualified GHCJS.Types as J
import Glazier.React.Component
import Glazier.React.EventTarget
import Glazier.React.ReactId
data Elemental = Elemental
{ elementalRef :: Maybe EventTarget
, reactListeners :: M.Map J.JSString
( J.Callback (J.JSVal -> IO ())
, IORef (J.JSVal -> IO (), IO ())
)
} deriving (G.Generic)
makeLenses_ ''Elemental
data ShimCallbacks = ShimCallbacks
{ shimRender :: J.Callback (IO J.JSVal)
, shimMounted :: J.Callback (IO ())
, shimRendered :: J.Callback (IO ())
, shimRef :: J.Callback (J.JSVal -> IO ())
} deriving (G.Generic)
makeLenses_ ''ShimCallbacks
data Plan = Plan
{ planId :: ReactId
, componentRef :: Maybe ComponentRef
, shimCallbacks :: ShimCallbacks
, tickedListener :: IO ()
, renderedListener :: IO ()
, mountedListener :: IO ()
, nextRenderedListener :: IO ()
, elementals :: M.Map ReactId Elemental
, domlListeners :: M.Map ReactId
( J.Callback (J.JSVal -> IO ())
, IORef (J.JSVal -> IO (), IO ())
)
, finalCleanup :: IO ()
, tickedNotified :: Bool
, rerenderRequired :: Bool
} deriving (G.Generic)
makeLenses_ ''Plan
instance Show Plan where
showsPrec d pln = showParen
(d >= 11)
( showString "Plan {" . showString "componentRef ? " . shows (isJust $ componentRef pln)
. showString ", " . showString "elementalIds = " . showList (M.keys $ elementals pln)
. showString ", " . showString "planIds = " . showList (M.keys $ elementals pln)
. showString "}"
)
data Scene s = Scene
{ plan :: Plan
, model :: s
} deriving (G.Generic, Show, Functor)
_model :: Lens (Scene s) (Scene s') s s'
_model = lens model (\s a -> s { model = a})
_plan :: Lens' (Scene s) Plan
_plan = lens plan (\s a -> s { plan = a})
editSceneModel :: (Functor f) => LensLike' f s a -> LensLike' f (Scene s) (Scene a)
editSceneModel l safa s = (\s' -> s & _model .~ s' ) <$> l afa' (s ^. _model)
where
afa' a = (view _model) <$> safa (s & _model .~ a)
magnifiedScene ::
( Magnify m n (Scene a) (Scene b)
, Functor (Magnified m r)
)
=> LensLike' (Magnified m r) b a -> m r -> n r
magnifiedScene l = magnify (editSceneModel l)
zoomedScene ::
( Zoom m n (Scene a) (Scene b)
, Functor (Zoomed m r)
)
=> LensLike' (Zoomed m r) b a -> m r -> n r
zoomedScene l = zoom (editSceneModel l)
elementTarget :: ReactId -> Traversal' (Scene s) EventTarget
elementTarget ri = _plan._elementals.ix ri._elementalRef._Just