module Glazier.React.Maker where
import Control.Monad.Free.Class
import Control.Monad.Free.Church
import Control.Monad.Free.TH
import Control.Monad.Trans.Maybe
import qualified GHCJS.Foreign.Callback as J
import qualified GHCJS.Types as J
import qualified Glazier as G
import qualified Glazier.React.Component as R
import qualified Glazier.React.Markup as R
import qualified Glazier.React.Model as R
data Maker act nxt where
MkHandler
:: (J.JSVal -> MaybeT IO [act])
-> (J.Callback (J.JSVal -> IO ()) -> nxt)
-> Maker act nxt
MkEmptyFrame
:: (R.Frame mdl pln -> nxt)
-> Maker act nxt
MkRenderer
:: R.Frame mdl pln
-> (J.JSVal -> G.WindowT (R.Scene mdl pln) R.ReactMl ())
-> (J.Callback (J.JSVal -> IO J.JSVal) -> nxt)
-> Maker act nxt
PutFrame
:: R.Frame mdl pln
-> R.Scene mdl pln
-> nxt
-> Maker act nxt
GetComponent
:: (R.ReactComponent -> nxt)
-> Maker act nxt
MkKey
:: (J.JSString -> nxt)
-> Maker act nxt
instance Functor (Maker act) where
fmap f (MkHandler handler g) = MkHandler handler (f . g)
fmap f (MkEmptyFrame g) = MkEmptyFrame (f . g)
fmap f (MkRenderer frm render g) = MkRenderer frm render (f . g)
fmap f (PutFrame frm scn x) = PutFrame frm scn (f x)
fmap f (GetComponent g) = GetComponent (f . g)
fmap f (MkKey g) = MkKey (f . g)
makeFree ''Maker
withAction :: (act -> act') -> Maker act a -> Maker act' a
withAction f (MkHandler handler g) = MkHandler (\v -> fmap f <$> handler v) g
withAction _ (MkEmptyFrame g) = MkEmptyFrame g
withAction _ (MkRenderer frm render g) = MkRenderer frm render g
withAction _ (PutFrame frm scn x) = PutFrame frm scn x
withAction _ (GetComponent g) = GetComponent g
withAction _ (MkKey g) = MkKey g
hoistWithAction :: (act -> act') -> F (Maker act) a -> F (Maker act') a
hoistWithAction f = hoistF (withAction f)