Scene.hs

{-# 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

----------------------------------------------------------------------------------

-- | Interactivity for a particular DOM element.
data Elemental = Elemental
    { elementalRef :: Maybe EventTarget
    -- (name of event, context of event)
    , reactListeners :: M.Map J.JSString
        ( J.Callback (J.JSVal -> IO ())
        , IORef (J.JSVal -> IO (), IO ())
        )
    } deriving (G.Generic)

makeLenses_ ''Elemental

----------------------------------------------------------------------------------

data ShimCallbacks = ShimCallbacks
    -- render function of the ReactComponent
    { shimRender :: J.Callback (IO J.JSVal)
    -- Run the mountedListener in the plan
    , shimMounted :: J.Callback (IO ())
    -- Run the renderedListener in the plan
    , shimRendered :: J.Callback (IO ())
    -- updates the componenRef
    , shimRef :: J.Callback (J.JSVal -> IO ())
    } deriving (G.Generic)

makeLenses_ ''ShimCallbacks

----------------------------------------------------------------------------------

-- | Interactivity data for a react component
data Plan = Plan
    -- a react "ref" to the javascript instance of ReactComponent
    -- so that react "componentRef.setState()" can be called.
    { planId :: ReactId
    , componentRef :: Maybe ComponentRef
    , shimCallbacks :: ShimCallbacks
    -- called after state was just updated
    , tickedListener :: IO ()
    -- called after every rendering
    , renderedListener :: IO ()
    -- called after first rendering only
    , mountedListener :: IO ()
    -- do on next rerender. This gets reset after every rerender.
    , nextRenderedListener :: IO ()
    -- interactivity data for child DOM elements
    , elementals :: M.Map ReactId Elemental
    -- interactivity for explicit eventTarget.addEventListener() callbacks
    , domlListeners :: M.Map ReactId
        ( J.Callback (J.JSVal -> IO ())
        , IORef (J.JSVal -> IO (), IO ())
        )
    -- cleanup to call eventTarget.removeEventListener()
    , finalCleanup :: IO ()

    -- set to True if tickedListener has been processed
    , tickedNotified :: Bool
    -- set to True is rerender is required
    , 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 "}"
        )

----------------------------------------------------------------------------------

-- | A 'Scene' contains interactivity data for all widgets as well as the model data.
data Scene s = Scene
    -- commands could be in a writer monad, but then you can't get
    -- a MonadWriter with ContT, but you can have a MonadState with ContT.
    { 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