module Glazier.React.Markup
( ReactMarkup(..)
, BranchParam(..)
, LeafParam(..)
, fromMarkup
, ReactMlT(..)
, ReactMl
, fromElement
, toElements
, markedWindow
, markedElements
, markedElement
, txt
, lf
, bh
) where
import Control.Applicative
import Control.Lens
import qualified Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.Morph
import Control.Monad.Reader
import Control.Monad.State.Strict
import qualified Data.DList as D
import Data.Semigroup
import qualified GHCJS.Types as J
import qualified Glazier as G
import qualified Glazier.React.Element as R
import qualified JavaScript.Extras as JE
data BranchParam = BranchParam
JE.JSVar
[JE.Property]
(D.DList ReactMarkup)
data LeafParam = LeafParam
JE.JSVar
[JE.Property]
data ReactMarkup
= ElementMarkup R.ReactElement
| TextMarkup J.JSString
| BranchMarkup BranchParam
| LeafMarkup LeafParam
fromMarkup :: ReactMarkup -> IO (R.ReactElement)
fromMarkup (BranchMarkup (BranchParam n p xs)) = do
xs' <- sequenceA $ fromMarkup <$> (D.toList xs)
R.mkBranchElement n p xs'
fromMarkup (LeafMarkup (LeafParam n p)) = R.mkLeafElement n p
fromMarkup (TextMarkup str) = pure $ R.textElement str
fromMarkup (ElementMarkup e) = pure e
newtype ReactMlT m a = ReactMlT
{ runReactMlT :: StateT (D.DList ReactMarkup) m a
} deriving ( MonadState (D.DList ReactMarkup)
, Monad
, Applicative
, Functor
, Fail.MonadFail
, Alternative
, MonadPlus
, MonadFix
, MonadIO
, MFunctor
)
type ReactMl = ReactMlT Identity
instance (Semigroup a, Monad m) => Semigroup (ReactMlT m a) where
(<>) = liftA2 (<>)
instance (Monoid a, Monad m) => Monoid (ReactMlT m a) where
mempty = pure mempty
mappend = liftA2 mappend
fromElement :: Applicative m => R.ReactElement -> ReactMlT m ()
fromElement e = ReactMlT . StateT $ \xs -> pure ((), xs `D.snoc` ElementMarkup e)
toElements :: MonadIO io => ReactMlT io () -> io [R.ReactElement]
toElements m = do
xs <- execStateT (runReactMlT m) mempty
liftIO $ sequenceA $ fromMarkup <$> (D.toList xs)
markedWindow :: MonadIO io => G.WindowT s (ReactMlT io) () -> G.WindowT s io [R.ReactElement]
markedWindow = G.belowWindowT (toElements .)
markedElements :: MonadIO io => G.WindowT s (ReactMlT io) () -> s -> io [R.ReactElement]
markedElements w s = view G._WindowT' (markedWindow w) s
markedElement :: MonadIO io => G.WindowT s (ReactMlT io) () -> s -> io R.ReactElement
markedElement w s = markedElements w s >>= liftIO . R.mkCombinedElements
txt :: Applicative m => J.JSString -> ReactMlT m ()
txt n = ReactMlT . StateT $ \xs -> pure ((), xs `D.snoc` TextMarkup n)
lf :: Applicative m => JE.JSVar -> [JE.Property] -> ReactMlT m ()
lf n props = ReactMlT . StateT $ \xs -> pure ((), xs `D.snoc` LeafMarkup (LeafParam n props))
bh :: Functor m => JE.JSVar -> [JE.Property] -> ReactMlT m a -> ReactMlT m a
bh n props (ReactMlT (StateT childs)) = ReactMlT . StateT $ \xs -> do
(a, childs') <- childs mempty
pure (a, xs `D.snoc` BranchMarkup (BranchParam n props childs'))