{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# LANGUAGE BangPatterns           #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE InstanceSigs           #-}
{-# LANGUAGE LambdaCase             #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE PartialTypeSignatures  #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TupleSections          #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}


{-|
   Shpadoinkle is an abstract frontend programming model, with one-way data flow, and a single source of truth.
   This module provides a parsimonious implementation of Shpadoinkle with few implementation details.
-}


module Shpadoinkle.Core (
  -- * Base Types
  Html(..), Prop(..)
  -- ** Prop Constructors
  , dataProp, flagProp, textProp, listenerProp, bakedProp
  -- *** Listeners
  , listenRaw, listen, listenM, listenM_, listenC, listener
  -- ** Html Constructors
  , h, baked, text
  -- ** Html Lenses
  , props, children, name, textContent
  -- ** Hoists
  , hoistHtml, hoistProp
  -- ** Catamorphisms
  , cataH, cataProp
  -- ** Utilities
  , mapProps, mapChildren, injectProps, eitherH
  -- * JSVal Wrappers
  , RawNode(..), RawEvent(..)
  -- * Backend Interface
  , Backend (..)
  , type (~>)
  -- * The Shpadoinkle Primitive
  , shpadoinkle
  -- * Re-Exports
  , JSM, MonadJSM, askJSM, runJSM, MonadUnliftIO(..), UnliftIO(..), liftJSM
  , module UnliftIO.STM
  ) where


import           Control.Arrow                 (second)
import qualified Control.Categorical.Functor   as F
import           Control.Category              ((.))
import           Control.PseudoInverseCategory (EndoIso (..),
                                                HasHaskFunctors (fmapA),
                                                PIArrow (piendo, piiso, pisecond),
                                                PseudoInverseCategory (piinverse),
                                                ToHask (piapply))
import           Data.Functor.Identity         (Identity (Identity, runIdentity))
import           Data.Kind                     (Type)
import           Data.List                     (foldl')
import           Data.Map                      (alter, toList)
import           Data.String                   (IsString (..))
import           Data.Text                     (Text, pack)
import           GHCJS.DOM.Types               (JSM, MonadJSM, liftJSM)
import           Language.Javascript.JSaddle   (FromJSVal (..), JSVal,
                                                ToJSVal (..), askJSM, runJSM)
import           Prelude                       hiding ((.))
import           UnliftIO                      (MonadUnliftIO (..),
                                                UnliftIO (..))
import           UnliftIO.STM                  (STM, TVar, atomically,
                                                modifyTVar, newTVarIO, readTVar,
                                                readTVarIO, retrySTM, writeTVar)


import           Shpadoinkle.Continuation      (Continuation, Continuous (..),
                                                causes, eitherC, hoist, impur,
                                                pur, shouldUpdate)


-- | This is the core type in Backend.
-- Please note, this is NOT the Virtual DOM used by Backend.
-- This type backs a DSL that is then /interpreted/ into Virtual DOM
-- by the Backend of your choosing. HTML comments are not supported.
data Html :: (Type -> Type) -> Type -> Type where
  -- | A standard node in the DOM tree
  Node :: Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
  -- | If you can bake an element into a 'RawNode' then you can embed it as a baked potato.
  -- Backend does not provide any state management or abstraction to deal with
  -- custom embedded content; it's on you to decide how and when this 'RawNode' will
  -- be updated. For example, if you wanted to embed a Google map as a baked potato,
  -- and you are driving your Backend view with a 'TVar', you would need to build
  -- the 'RawNode' for this map /outside/ of your Backend view and pass it in
  -- as an argument. The 'RawNode' is a reference you control.
  Potato :: JSM RawNode -> Html m a
  -- | The humble text node
  TextNode :: Text -> Html m a


-- | Properties of a DOM node. Backend does not use attributes directly,
-- but rather is focused on the more capable properties that may be set on a DOM
-- node in JavaScript. If you wish to add attributes, you may do so
-- by setting its corresponding property.
data Prop :: (Type -> Type) -> Type -> Type where
  -- | A data property, these do NOT appear in static rendering
  PData :: JSVal -> Prop m a
  -- | A text property
  PText :: Text -> Prop m a
  -- | A boolean property
  PFlag :: Bool -> Prop m a
  -- | Bake a custom property
  -- The STM Monad will be called recursively.
  -- The semantics here is roughly an event stream of continuations.
  PPotato :: (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
  -- | Event listeners are provided with the 'RawNode' target, and the 'RawEvent', and may perform
  -- a monadic action such as a side effect. This is the one and only place where you may
  -- introduce a custom monadic action. The JSM to compute the Continuation must be
  -- synchronous and non-blocking; otherwise race conditions may result from a Pure
  -- Continuation which sets the state based on a previous state captured by the closure.
  -- Such Continuations must be executed synchronously during event propagation,
  -- and that may not be the case if the code to compute the Continuation of some
  -- listener is blocking.
  PListener :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a


-- | Ensure all prop keys are unique.
-- Collisions for Data, Text, Flags, and Potatoes are last write wins
-- Collisions for Listeners are Continuation Semigroup operations
nubProps :: Monad m => Html m a -> Html m a
nubProps :: Html m a -> Html m a
nubProps = ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
forall (m :: * -> *) a.
([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapPropsRecursive (([(Text, Prop m a)] -> [(Text, Prop m a)])
 -> Html m a -> Html m a)
-> ([(Text, Prop m a)] -> [(Text, Prop m a)])
-> Html m a
-> Html m a
forall a b. (a -> b) -> a -> b
$ Map Text (Prop m a) -> [(Text, Prop m a)]
forall k a. Map k a -> [(k, a)]
toList (Map Text (Prop m a) -> [(Text, Prop m a)])
-> ([(Text, Prop m a)] -> Map Text (Prop m a))
-> [(Text, Prop m a)]
-> [(Text, Prop m a)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Map Text (Prop m a) -> (Text, Prop m a) -> Map Text (Prop m a))
-> Map Text (Prop m a) -> [(Text, Prop m a)] -> Map Text (Prop m a)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Map Text (Prop m a) -> (Text, Prop m a) -> Map Text (Prop m a)
forall k (m :: * -> *) a.
(Ord k, IsString k, Monad m) =>
Map k (Prop m a) -> (k, Prop m a) -> Map k (Prop m a)
f Map Text (Prop m a)
forall a. Monoid a => a
mempty
  where
  f :: Map k (Prop m a) -> (k, Prop m a) -> Map k (Prop m a)
f Map k (Prop m a)
acc (k
t,Prop m a
p) = (Maybe (Prop m a) -> Maybe (Prop m a))
-> k -> Map k (Prop m a) -> Map k (Prop m a)
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
alter (Prop m a -> Maybe (Prop m a)
forall a. a -> Maybe a
Just (Prop m a -> Maybe (Prop m a))
-> (Maybe (Prop m a) -> Prop m a)
-> Maybe (Prop m a)
-> Maybe (Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. k -> Prop m a -> Maybe (Prop m a) -> Prop m a
forall a (m :: * -> *) a.
(Eq a, IsString a, Monad m) =>
a -> Prop m a -> Maybe (Prop m a) -> Prop m a
g k
t Prop m a
p) k
t Map k (Prop m a)
acc
  g :: a -> Prop m a -> Maybe (Prop m a) -> Prop m a
g a
k Prop m a
new Maybe (Prop m a)
old = case (Prop m a
new, Maybe (Prop m a)
old) of
    (PText Text
t, Just (PText Text
t')) | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"className" -> Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
PText (Text -> Prop m a) -> Text -> Prop m a
forall a b. (a -> b) -> a -> b
$ Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t'
    (PListener RawNode -> RawEvent -> JSM (Continuation m a)
l, Just (PListener RawNode -> RawEvent -> JSM (Continuation m a)
l')) -> (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener ((RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a)
-> (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall a b. (a -> b) -> a -> b
$
      \RawNode
raw RawEvent
evt -> Continuation m a -> Continuation m a -> Continuation m a
forall a. Monoid a => a -> a -> a
mappend (Continuation m a -> Continuation m a -> Continuation m a)
-> JSM (Continuation m a)
-> JSM (Continuation m a -> Continuation m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawNode -> RawEvent -> JSM (Continuation m a)
l RawNode
raw RawEvent
evt JSM (Continuation m a -> Continuation m a)
-> JSM (Continuation m a) -> JSM (Continuation m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RawNode -> RawEvent -> JSM (Continuation m a)
l' RawNode
raw RawEvent
evt
    (Prop m a, Maybe (Prop m a))
_ -> Prop m a
new


mapPropsRecursive :: ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapPropsRecursive :: ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapPropsRecursive [(Text, Prop m a)] -> [(Text, Prop m a)]
f = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t ([(Text, Prop m a)] -> [(Text, Prop m a)]
f [(Text, Prop m a)]
ps) (([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
forall (m :: * -> *) a.
([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapPropsRecursive [(Text, Prop m a)] -> [(Text, Prop m a)]
f (Html m a -> Html m a) -> [Html m a] -> [Html m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a]
cs)
  Html m a
x            -> Html m a
x


-- | Construct a listener from its name and a simple monadic event handler.
listenM :: Monad m => Text -> m (a -> a) -> (Text, Prop m a)
listenM :: Text -> m (a -> a) -> (Text, Prop m a)
listenM Text
k = Text -> Continuation m a -> (Text, Prop m a)
forall (m :: * -> *) a.
Text -> Continuation m a -> (Text, Prop m a)
listenC Text
k (Continuation m a -> (Text, Prop m a))
-> (m (a -> a) -> Continuation m a)
-> m (a -> a)
-> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m (a -> a) -> Continuation m a
forall (m :: * -> *) a. Monad m => m (a -> a) -> Continuation m a
impur


-- | Construct a listener from its name and a simple stateless monadic event handler.
listenM_ :: Monad m => Text -> m () -> (Text, Prop m a)
listenM_ :: Text -> m () -> (Text, Prop m a)
listenM_ Text
k = Text -> Continuation m a -> (Text, Prop m a)
forall (m :: * -> *) a.
Text -> Continuation m a -> (Text, Prop m a)
listenC Text
k (Continuation m a -> (Text, Prop m a))
-> (m () -> Continuation m a) -> m () -> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. m () -> Continuation m a
forall (m :: * -> *) a. Monad m => m () -> Continuation m a
causes


-- | Type alias for convenience (typing out the nested brackets is tiresome)
type Props' m a = [(Text, Prop m a)]


-- | If you can provide a Natural Transformation from one Functor to another
-- then you may change the action of 'Html'.
hoistHtml :: Functor m => Functor n => (m ~> n) -> Html m a -> Html n a
hoistHtml :: (m ~> n) -> Html m a -> Html n a
hoistHtml m ~> n
f = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> Text -> [(Text, Prop n a)] -> [Html n a] -> Html n a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t ((Prop m a -> Prop n a) -> (Text, Prop m a) -> (Text, Prop n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m ~> n) -> Prop m a -> Prop n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(m ~> n) -> Prop m a -> Prop n a
hoistProp m ~> n
f) ((Text, Prop m a) -> (Text, Prop n a))
-> [(Text, Prop m a)] -> [(Text, Prop n a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Prop m a)]
ps) ((m ~> n) -> Html m a -> Html n a
forall (m :: * -> *) (n :: * -> *) a.
(Functor m, Functor n) =>
(m ~> n) -> Html m a -> Html n a
hoistHtml m ~> n
f (Html m a -> Html n a) -> [Html m a] -> [Html n a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a]
cs)
  Potato JSM RawNode
p     -> JSM RawNode -> Html n a
forall (m :: * -> *) a. JSM RawNode -> Html m a
Potato JSM RawNode
p
  TextNode Text
t   -> Text -> Html n a
forall (m :: * -> *) a. Text -> Html m a
TextNode Text
t
{-# INLINE hoistHtml #-}


-- | If you can provide a Natural Transformation from one Functor to another
-- then you may change the action of 'Prop'.
hoistProp :: Functor m => (m ~> n) -> Prop m a -> Prop n a
hoistProp :: (m ~> n) -> Prop m a -> Prop n a
hoistProp m ~> n
f = \case
  PListener RawNode -> RawEvent -> JSM (Continuation m a)
g -> (RawNode -> RawEvent -> JSM (Continuation n a)) -> Prop n a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener ((RawNode -> RawEvent -> JSM (Continuation n a)) -> Prop n a)
-> (RawNode -> RawEvent -> JSM (Continuation n a)) -> Prop n a
forall a b. (a -> b) -> a -> b
$ \RawNode
x -> (Continuation m a -> Continuation n a)
-> JSM (Continuation m a) -> JSM (Continuation n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m ~> n) -> Continuation m a -> Continuation n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist m ~> n
f) (JSM (Continuation m a) -> JSM (Continuation n a))
-> (RawEvent -> JSM (Continuation m a))
-> RawEvent
-> JSM (Continuation n a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> RawEvent -> JSM (Continuation m a)
g RawNode
x
  PData JSVal
t     -> JSVal -> Prop n a
forall (m :: * -> *) a. JSVal -> Prop m a
PData JSVal
t
  PText Text
t     -> Text -> Prop n a
forall (m :: * -> *) a. Text -> Prop m a
PText Text
t
  PFlag Bool
t     -> Bool -> Prop n a
forall (m :: * -> *) a. Bool -> Prop m a
PFlag Bool
t
  PPotato RawNode -> JSM (STM (Continuation m a))
p   -> (RawNode -> JSM (STM (Continuation n a))) -> Prop n a
forall (m :: * -> *) a.
(RawNode -> JSM (STM (Continuation m a))) -> Prop m a
PPotato ((RawNode -> JSM (STM (Continuation n a))) -> Prop n a)
-> (RawNode -> JSM (STM (Continuation n a))) -> Prop n a
forall a b. (a -> b) -> a -> b
$ (STM (Continuation m a) -> STM (Continuation n a))
-> JSM (STM (Continuation m a)) -> JSM (STM (Continuation n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Continuation m a -> Continuation n a)
-> STM (Continuation m a) -> STM (Continuation n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((m ~> n) -> Continuation m a -> Continuation n a
forall (m :: * -> *) (n :: * -> *) a.
Functor m =>
(forall b. m b -> n b) -> Continuation m a -> Continuation n a
hoist m ~> n
f)) (JSM (STM (Continuation m a)) -> JSM (STM (Continuation n a)))
-> (RawNode -> JSM (STM (Continuation m a)))
-> RawNode
-> JSM (STM (Continuation n a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> JSM (STM (Continuation m a))
p
{-# INLINE hoistProp #-}


-- | Strings are overloaded as HTML text nodes:
-- @
--   "hiya" = TextNode "hiya"
-- @
instance IsString (Html m a) where
  fromString :: String -> Html m a
fromString = Text -> Html m a
forall (m :: * -> *) a. Text -> Html m a
TextNode (Text -> Html m a) -> (String -> Text) -> String -> Html m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
pack
  {-# INLINE fromString #-}


-- | Strings are overloaded as text props:
-- @
--   ("id", "foo") = ("id", PText "foo")
-- @
instance IsString (Prop m a) where
  fromString :: String -> Prop m a
fromString = Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
PText (Text -> Prop m a) -> (String -> Text) -> String -> Prop m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
pack
  {-# INLINE fromString #-}


-- | @Html m@ is a functor in the EndoIso category, where the objects are
--   types and the morphisms are EndoIsos.
instance Monad m => F.Functor EndoIso EndoIso (Html m) where
  map :: EndoIso a b -> EndoIso (Html m a) (Html m b)
map (EndoIso a -> a
f a -> b
g b -> a
i) = (Html m a -> Html m a)
-> (Html m a -> Html m b)
-> (Html m b -> Html m a)
-> EndoIso (Html m a) (Html m b)
forall a b. (a -> a) -> (a -> b) -> (b -> a) -> EndoIso a b
EndoIso ((Continuation m a -> Continuation m a) -> Html m a -> Html m a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC ((Continuation m a -> Continuation m a) -> Html m a -> Html m a)
-> (EndoIso (Continuation m a) (Continuation m a)
    -> Continuation m a -> Continuation m a)
-> EndoIso (Continuation m a) (Continuation m a)
-> Html m a
-> Html m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EndoIso (Continuation m a) (Continuation m a)
-> Continuation m a -> Continuation m a
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply (EndoIso (Continuation m a) (Continuation m a)
 -> Html m a -> Html m a)
-> EndoIso (Continuation m a) (Continuation m a)
-> Html m a
-> Html m a
forall a b. (a -> b) -> a -> b
$ EndoIso a a -> EndoIso (Continuation m a) (Continuation m a)
forall a b.
EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
map' ((a -> a) -> EndoIso a a
forall (a :: * -> * -> *) b. PIArrow a => (b -> b) -> a b b
piendo a -> a
f))
                                ((Continuation m a -> Continuation m b) -> Html m a -> Html m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC ((Continuation m a -> Continuation m b) -> Html m a -> Html m b)
-> (EndoIso (Continuation m a) (Continuation m b)
    -> Continuation m a -> Continuation m b)
-> EndoIso (Continuation m a) (Continuation m b)
-> Html m a
-> Html m b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EndoIso (Continuation m a) (Continuation m b)
-> Continuation m a -> Continuation m b
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply (EndoIso (Continuation m a) (Continuation m b)
 -> Html m a -> Html m b)
-> EndoIso (Continuation m a) (Continuation m b)
-> Html m a
-> Html m b
forall a b. (a -> b) -> a -> b
$ EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
forall a b.
EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
map' ((a -> b) -> (b -> a) -> EndoIso a b
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso a -> b
g b -> a
i))
                                ((Continuation m b -> Continuation m a) -> Html m b -> Html m a
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC ((Continuation m b -> Continuation m a) -> Html m b -> Html m a)
-> (EndoIso (Continuation m b) (Continuation m a)
    -> Continuation m b -> Continuation m a)
-> EndoIso (Continuation m b) (Continuation m a)
-> Html m b
-> Html m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EndoIso (Continuation m b) (Continuation m a)
-> Continuation m b -> Continuation m a
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply (EndoIso (Continuation m b) (Continuation m a)
 -> Html m b -> Html m a)
-> EndoIso (Continuation m b) (Continuation m a)
-> Html m b
-> Html m a
forall a b. (a -> b) -> a -> b
$ EndoIso b a -> EndoIso (Continuation m b) (Continuation m a)
forall a b.
EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
map' ((b -> a) -> (a -> b) -> EndoIso b a
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso b -> a
i a -> b
g))
    where map' :: EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
          map' :: EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
map' = EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
forall α β (s :: α -> α -> *) (t :: β -> β -> *) (f :: α -> β)
       (a :: α) (b :: α).
Functor s t f =>
s a b -> t (f a) (f b)
F.map
  {-# INLINE map #-}


-- | Prop is a functor in the EndoIso category, where the objects are types
--  and the morphisms are EndoIsos.
instance Monad m => F.Functor EndoIso EndoIso (Prop m) where
  map :: forall a b. EndoIso a b -> EndoIso (Prop m a) (Prop m b)
  map :: EndoIso a b -> EndoIso (Prop m a) (Prop m b)
map EndoIso a b
f = (Prop m a -> Prop m a)
-> (Prop m a -> Prop m b)
-> (Prop m b -> Prop m a)
-> EndoIso (Prop m a) (Prop m b)
forall a b. (a -> a) -> (a -> b) -> (b -> a) -> EndoIso a b
EndoIso Prop m a -> Prop m a
forall a. a -> a
id Prop m a -> Prop m b
mapFwd Prop m b -> Prop m a
mapBack
    where f' :: EndoIso (Continuation m a) (Continuation m b)
          f' :: EndoIso (Continuation m a) (Continuation m b)
f' = EndoIso a b -> EndoIso (Continuation m a) (Continuation m b)
forall α β (s :: α -> α -> *) (t :: β -> β -> *) (f :: α -> β)
       (a :: α) (b :: α).
Functor s t f =>
s a b -> t (f a) (f b)
F.map EndoIso a b
f

          mapFwd :: Prop m a -> Prop m b
          mapFwd :: Prop m a -> Prop m b
mapFwd (PData JSVal
t)     = JSVal -> Prop m b
forall (m :: * -> *) a. JSVal -> Prop m a
PData JSVal
t
          mapFwd (PText Text
t)     = Text -> Prop m b
forall (m :: * -> *) a. Text -> Prop m a
PText Text
t
          mapFwd (PFlag Bool
t)     = Bool -> Prop m b
forall (m :: * -> *) a. Bool -> Prop m a
PFlag Bool
t
          mapFwd (PListener RawNode -> RawEvent -> JSM (Continuation m a)
g) = (RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener ((RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b)
-> (RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b
forall a b. (a -> b) -> a -> b
$ \RawNode
r RawEvent
e -> EndoIso (Continuation m a) (Continuation m b)
-> Continuation m a -> Continuation m b
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply EndoIso (Continuation m a) (Continuation m b)
f' (Continuation m a -> Continuation m b)
-> JSM (Continuation m a) -> JSM (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawNode -> RawEvent -> JSM (Continuation m a)
g RawNode
r RawEvent
e
          mapFwd (PPotato RawNode -> JSM (STM (Continuation m a))
p)   = (RawNode -> JSM (STM (Continuation m b))) -> Prop m b
forall (m :: * -> *) a.
(RawNode -> JSM (STM (Continuation m a))) -> Prop m a
PPotato ((RawNode -> JSM (STM (Continuation m b))) -> Prop m b)
-> (RawNode -> JSM (STM (Continuation m b))) -> Prop m b
forall a b. (a -> b) -> a -> b
$ (STM (Continuation m a) -> STM (Continuation m b))
-> JSM (STM (Continuation m a)) -> JSM (STM (Continuation m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Continuation m a -> Continuation m b)
-> STM (Continuation m a) -> STM (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EndoIso (Continuation m a) (Continuation m b)
-> Continuation m a -> Continuation m b
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply EndoIso (Continuation m a) (Continuation m b)
f')) (JSM (STM (Continuation m a)) -> JSM (STM (Continuation m b)))
-> (RawNode -> JSM (STM (Continuation m a)))
-> RawNode
-> JSM (STM (Continuation m b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> JSM (STM (Continuation m a))
p


          mapBack :: Prop m b -> Prop m a
          mapBack :: Prop m b -> Prop m a
mapBack (PData JSVal
t)     = JSVal -> Prop m a
forall (m :: * -> *) a. JSVal -> Prop m a
PData JSVal
t
          mapBack (PText Text
t)     = Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
PText Text
t
          mapBack (PFlag Bool
t)     = Bool -> Prop m a
forall (m :: * -> *) a. Bool -> Prop m a
PFlag Bool
t
          mapBack (PListener RawNode -> RawEvent -> JSM (Continuation m b)
g) = (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener ((RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a)
-> (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall a b. (a -> b) -> a -> b
$ \RawNode
r RawEvent
e -> EndoIso (Continuation m b) (Continuation m a)
-> Continuation m b -> Continuation m a
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply (EndoIso (Continuation m a) (Continuation m b)
-> EndoIso (Continuation m b) (Continuation m a)
forall (a :: * -> * -> *) x y.
PseudoInverseCategory a =>
a x y -> a y x
piinverse EndoIso (Continuation m a) (Continuation m b)
f') (Continuation m b -> Continuation m a)
-> JSM (Continuation m b) -> JSM (Continuation m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RawNode -> RawEvent -> JSM (Continuation m b)
g RawNode
r RawEvent
e
          mapBack (PPotato RawNode -> JSM (STM (Continuation m b))
b)   = (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> JSM (STM (Continuation m a))) -> Prop m a
PPotato ((RawNode -> JSM (STM (Continuation m a))) -> Prop m a)
-> (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
forall a b. (a -> b) -> a -> b
$ (STM (Continuation m b) -> STM (Continuation m a))
-> JSM (STM (Continuation m b)) -> JSM (STM (Continuation m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Continuation m b -> Continuation m a)
-> STM (Continuation m b) -> STM (Continuation m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EndoIso (Continuation m b) (Continuation m a)
-> Continuation m b -> Continuation m a
forall (a :: * -> * -> *) x y. ToHask a => a x y -> x -> y
piapply (EndoIso (Continuation m a) (Continuation m b)
-> EndoIso (Continuation m b) (Continuation m a)
forall (a :: * -> * -> *) x y.
PseudoInverseCategory a =>
a x y -> a y x
piinverse EndoIso (Continuation m a) (Continuation m b)
f'))) (JSM (STM (Continuation m b)) -> JSM (STM (Continuation m a)))
-> (RawNode -> JSM (STM (Continuation m b)))
-> RawNode
-> JSM (STM (Continuation m a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> JSM (STM (Continuation m b))
b
  {-# INLINE map #-}


-- | Given a lens, you can change the type of an Html by using the lens
--   to convert the types of the Continuations inside it.
instance Continuous Html where
  mapC :: (Continuation m a -> Continuation m b) -> Html m a -> Html m b
mapC Continuation m a -> Continuation m b
f (Node Text
t [(Text, Prop m a)]
ps [Html m a]
es) = Text -> [(Text, Prop m b)] -> [Html m b] -> Html m b
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t (MapProps m b -> [(Text, Prop m b)]
forall (m :: * -> *) a. MapProps m a -> Props' m a
unMapProps (MapProps m b -> [(Text, Prop m b)])
-> (MapProps m a -> MapProps m b)
-> MapProps m a
-> [(Text, Prop m b)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Continuation m a -> Continuation m b)
-> MapProps m a -> MapProps m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m a -> Continuation m b
f (MapProps m a -> [(Text, Prop m b)])
-> MapProps m a -> [(Text, Prop m b)]
forall a b. (a -> b) -> a -> b
$ [(Text, Prop m a)] -> MapProps m a
forall (m :: * -> *) a. Props' m a -> MapProps m a
MapProps [(Text, Prop m a)]
ps) ((Continuation m a -> Continuation m b) -> Html m a -> Html m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m a -> Continuation m b
f (Html m a -> Html m b) -> [Html m a] -> [Html m b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a]
es)
  mapC Continuation m a -> Continuation m b
_ (Potato JSM RawNode
p) = JSM RawNode -> Html m b
forall (m :: * -> *) a. JSM RawNode -> Html m a
Potato JSM RawNode
p
  mapC Continuation m a -> Continuation m b
_ (TextNode Text
t) = Text -> Html m b
forall (m :: * -> *) a. Text -> Html m a
TextNode Text
t
  {-# INLINE mapC #-}


-- | Newtype to deal with the fact that we can't make the typeclass instances
--   for Endofunctor EndoIso and Continuous using the Props type alias
newtype MapProps m a = MapProps { MapProps m a -> Props' m a
unMapProps :: Props' m a }


-- | Props is a functor in the EndoIso category, where the objects are
--  types and the morphisms are EndoIsos.
instance Monad m => F.Functor EndoIso EndoIso (MapProps m) where
  map :: EndoIso a b -> EndoIso (MapProps m a) (MapProps m b)
map EndoIso a b
f = (Props' m b -> MapProps m b)
-> (MapProps m b -> Props' m b)
-> EndoIso (Props' m b) (MapProps m b)
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso Props' m b -> MapProps m b
forall (m :: * -> *) a. Props' m a -> MapProps m a
MapProps MapProps m b -> Props' m b
forall (m :: * -> *) a. MapProps m a -> Props' m a
unMapProps EndoIso (Props' m b) (MapProps m b)
-> EndoIso (MapProps m a) (Props' m b)
-> EndoIso (MapProps m a) (MapProps m b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. EndoIso (Text, Prop m a) (Text, Prop m b)
-> EndoIso [(Text, Prop m a)] (Props' m b)
forall (a :: * -> * -> *) (f :: * -> *) x y.
(HasHaskFunctors a, Functor f) =>
a x y -> a (f x) (f y)
fmapA (EndoIso (Prop m a) (Prop m b)
-> EndoIso (Text, Prop m a) (Text, Prop m b)
forall (a :: * -> * -> *) b c d.
PIArrow a =>
a b c -> a (d, b) (d, c)
pisecond (EndoIso a b -> EndoIso (Prop m a) (Prop m b)
forall α β (s :: α -> α -> *) (t :: β -> β -> *) (f :: α -> β)
       (a :: α) (b :: α).
Functor s t f =>
s a b -> t (f a) (f b)
F.map EndoIso a b
f)) EndoIso [(Text, Prop m a)] (Props' m b)
-> EndoIso (MapProps m a) [(Text, Prop m a)]
-> EndoIso (MapProps m a) (Props' m b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (MapProps m a -> [(Text, Prop m a)])
-> ([(Text, Prop m a)] -> MapProps m a)
-> EndoIso (MapProps m a) [(Text, Prop m a)]
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso MapProps m a -> [(Text, Prop m a)]
forall (m :: * -> *) a. MapProps m a -> Props' m a
unMapProps [(Text, Prop m a)] -> MapProps m a
forall (m :: * -> *) a. Props' m a -> MapProps m a
MapProps
  {-# INLINE map #-}


-- | Given a lens, you can change the type of a Props by using the lens
--   to convert the types of the Continuations inside.
instance Continuous MapProps where
  mapC :: (Continuation m a -> Continuation m b)
-> MapProps m a -> MapProps m b
mapC Continuation m a -> Continuation m b
f = Props' m b -> MapProps m b
forall (m :: * -> *) a. Props' m a -> MapProps m a
MapProps (Props' m b -> MapProps m b)
-> (MapProps m a -> Props' m b) -> MapProps m a -> MapProps m b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Text, Prop m a) -> (Text, Prop m b))
-> [(Text, Prop m a)] -> Props' m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Prop m a -> Prop m b) -> (Text, Prop m a) -> (Text, Prop m b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Continuation m a -> Continuation m b) -> Prop m a -> Prop m b
forall (f :: (* -> *) -> * -> *) (m :: * -> *) a b.
Continuous f =>
(Continuation m a -> Continuation m b) -> f m a -> f m b
mapC Continuation m a -> Continuation m b
f)) ([(Text, Prop m a)] -> Props' m b)
-> (MapProps m a -> [(Text, Prop m a)])
-> MapProps m a
-> Props' m b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MapProps m a -> [(Text, Prop m a)]
forall (m :: * -> *) a. MapProps m a -> Props' m a
unMapProps
  {-# INLINE mapC #-}


-- | Given a lens, you can change the type of a Prop by using the
--   lens to convert the types of the Continuations which it contains
--   if it is a listener.
instance Continuous Prop where
  mapC :: (Continuation m a -> Continuation m b) -> Prop m a -> Prop m b
mapC Continuation m a -> Continuation m b
_ (PData JSVal
t)     = JSVal -> Prop m b
forall (m :: * -> *) a. JSVal -> Prop m a
PData JSVal
t
  mapC Continuation m a -> Continuation m b
_ (PText Text
t)     = Text -> Prop m b
forall (m :: * -> *) a. Text -> Prop m a
PText Text
t
  mapC Continuation m a -> Continuation m b
_ (PFlag Bool
b)     = Bool -> Prop m b
forall (m :: * -> *) a. Bool -> Prop m a
PFlag Bool
b
  mapC Continuation m a -> Continuation m b
f (PListener RawNode -> RawEvent -> JSM (Continuation m a)
g) = (RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener ((RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b)
-> (RawNode -> RawEvent -> JSM (Continuation m b)) -> Prop m b
forall a b. (a -> b) -> a -> b
$ \RawNode
r -> (Continuation m a -> Continuation m b)
-> JSM (Continuation m a) -> JSM (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Continuation m a -> Continuation m b
f (JSM (Continuation m a) -> JSM (Continuation m b))
-> (RawEvent -> JSM (Continuation m a))
-> RawEvent
-> JSM (Continuation m b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> RawEvent -> JSM (Continuation m a)
g RawNode
r
  mapC Continuation m a -> Continuation m b
f (PPotato RawNode -> JSM (STM (Continuation m a))
b)   = (RawNode -> JSM (STM (Continuation m b))) -> Prop m b
forall (m :: * -> *) a.
(RawNode -> JSM (STM (Continuation m a))) -> Prop m a
PPotato ((RawNode -> JSM (STM (Continuation m b))) -> Prop m b)
-> (RawNode -> JSM (STM (Continuation m b))) -> Prop m b
forall a b. (a -> b) -> a -> b
$ (STM (Continuation m a) -> STM (Continuation m b))
-> JSM (STM (Continuation m a)) -> JSM (STM (Continuation m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Continuation m a -> Continuation m b)
-> STM (Continuation m a) -> STM (Continuation m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Continuation m a -> Continuation m b
f) (JSM (STM (Continuation m a)) -> JSM (STM (Continuation m b)))
-> (RawNode -> JSM (STM (Continuation m a)))
-> RawNode
-> JSM (STM (Continuation m b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> JSM (STM (Continuation m a))
b
  {-# INLINE mapC #-}


-- | Create a data property.
dataProp :: JSVal -> Prop m a
dataProp :: JSVal -> Prop m a
dataProp = JSVal -> Prop m a
forall (m :: * -> *) a. JSVal -> Prop m a
PData
{-# INLINE dataProp #-}


-- | Create a text property.
textProp :: Text -> Prop m a
textProp :: Text -> Prop m a
textProp = Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
PText
{-# INLINE textProp #-}


flagProp :: Bool -> Prop m a
flagProp :: Bool -> Prop m a
flagProp = Bool -> Prop m a
forall (m :: * -> *) a. Bool -> Prop m a
PFlag
{-# INLINE flagProp #-}


-- | Create an event listener property.
listenerProp :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
listenerProp :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
listenerProp = (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
PListener
{-# INLINE listenerProp #-}


-- | Create a delicious proptato.
bakedProp :: (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
bakedProp :: (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
bakedProp = (RawNode -> JSM (STM (Continuation m a))) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> JSM (STM (Continuation m a))) -> Prop m a
PPotato
{-# INLINE bakedProp #-}


-- | Transform a p-algebra into a p-catamorphism. This is like polymorphic pattern matching.
cataProp
  :: (JSVal -> b)
  -> (Text -> b)
  -> (Bool -> b)
  -> ((RawNode -> RawEvent -> JSM (Continuation m a)) -> b)
  -> ((RawNode -> JSM (STM (Continuation m a))) -> b)
  -> Prop m a
  -> b
cataProp :: (JSVal -> b)
-> (Text -> b)
-> (Bool -> b)
-> ((RawNode -> RawEvent -> JSM (Continuation m a)) -> b)
-> ((RawNode -> JSM (STM (Continuation m a))) -> b)
-> Prop m a
-> b
cataProp JSVal -> b
d Text -> b
t Bool -> b
f (RawNode -> RawEvent -> JSM (Continuation m a)) -> b
l (RawNode -> JSM (STM (Continuation m a))) -> b
p = \case
  PData     JSVal
x -> JSVal -> b
d JSVal
x
  PText     Text
x -> Text -> b
t Text
x
  PFlag     Bool
x -> Bool -> b
f Bool
x
  PListener RawNode -> RawEvent -> JSM (Continuation m a)
x -> (RawNode -> RawEvent -> JSM (Continuation m a)) -> b
l RawNode -> RawEvent -> JSM (Continuation m a)
x
  PPotato   RawNode -> JSM (STM (Continuation m a))
x -> (RawNode -> JSM (STM (Continuation m a))) -> b
p RawNode -> JSM (STM (Continuation m a))
x


-- | Construct an HTML element JSX-style.
h :: Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
h :: Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
h = Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node
{-# INLINE h #-}


-- | Construct a 'Potato' from a 'JSM' action producing a 'RawNode'.
baked :: JSM RawNode -> Html m a
baked :: JSM RawNode -> Html m a
baked = JSM RawNode -> Html m a
forall (m :: * -> *) a. JSM RawNode -> Html m a
Potato
{-# INLINE baked #-}


-- | Construct a text node.
text :: Text -> Html m a
text :: Text -> Html m a
text = Text -> Html m a
forall (m :: * -> *) a. Text -> Html m a
TextNode
{-# INLINE text #-}


-- | Lens to props
props :: Applicative f => ([(Text, Prop m a)] -> f [(Text, Prop m a)]) -> Html m a -> f (Html m a)
props :: ([(Text, Prop m a)] -> f [(Text, Prop m a)])
-> Html m a -> f (Html m a)
props [(Text, Prop m a)] -> f [(Text, Prop m a)]
inj = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> (\[(Text, Prop m a)]
ps' -> Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t [(Text, Prop m a)]
ps' [Html m a]
cs) ([(Text, Prop m a)] -> Html m a)
-> f [(Text, Prop m a)] -> f (Html m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Prop m a)] -> f [(Text, Prop m a)]
inj [(Text, Prop m a)]
ps
  Html m a
t            -> Html m a -> f (Html m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html m a
t
{-# INLINE props #-}


-- | Lens to children
children :: Applicative f => ([Html m a] -> f [Html m a]) -> Html m a -> f (Html m a)
children :: ([Html m a] -> f [Html m a]) -> Html m a -> f (Html m a)
children [Html m a] -> f [Html m a]
inj = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t [(Text, Prop m a)]
ps ([Html m a] -> Html m a) -> f [Html m a] -> f (Html m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a] -> f [Html m a]
inj [Html m a]
cs
  Html m a
t            -> Html m a -> f (Html m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html m a
t
{-# INLINE children #-}


-- | Lens to tag name
name :: Applicative f => (Text -> f Text) -> Html m a -> f (Html m a)
name :: (Text -> f Text) -> Html m a -> f (Html m a)
name Text -> f Text
inj = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> (\Text
t' -> Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
forall (m :: * -> *) a.
Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
Node Text
t' [(Text, Prop m a)]
ps [Html m a]
cs) (Text -> Html m a) -> f Text -> f (Html m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
inj Text
t
  Html m a
t            -> Html m a -> f (Html m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html m a
t
{-# INLINE name #-}


-- | Lens to content of 'TextNode's
textContent :: Applicative f => (Text -> f Text) -> Html m a -> f (Html m a)
textContent :: (Text -> f Text) -> Html m a -> f (Html m a)
textContent Text -> f Text
inj = \case
  TextNode Text
t -> Text -> Html m a
forall (m :: * -> *) a. Text -> Html m a
TextNode (Text -> Html m a) -> f Text -> f (Html m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
inj Text
t
  Html m a
n          -> Html m a -> f (Html m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html m a
n
{-# INLINE textContent #-}


-- | Construct an HTML element out of heterogeneous alternatives.
eitherH :: Monad m => (a -> Html m a) -> (b -> Html m b) -> Either a b -> Html m (Either a b)
eitherH :: (a -> Html m a)
-> (b -> Html m b) -> Either a b -> Html m (Either a b)
eitherH = (a -> Html m a)
-> (b -> Html m b) -> Either a b -> Html m (Either a b)
forall (m :: * -> *) (f :: (* -> *) -> * -> *) a b.
(Monad m, Continuous f) =>
(a -> f m a) -> (b -> f m b) -> Either a b -> f m (Either a b)
eitherC
{-# INLINE eitherH #-}


-- | Fold an HTML element, i.e. transform an h-algebra into an h-catamorphism.
cataH :: (Text -> [(Text, Prop m a)] -> [b] -> b)
      -> (JSM RawNode -> b)
      -> (Text -> b)
      -> Html m a -> b
cataH :: (Text -> [(Text, Prop m a)] -> [b] -> b)
-> (JSM RawNode -> b) -> (Text -> b) -> Html m a -> b
cataH Text -> [(Text, Prop m a)] -> [b] -> b
f JSM RawNode -> b
g Text -> b
h' = \case
  Node Text
t [(Text, Prop m a)]
ps [Html m a]
cs -> Text -> [(Text, Prop m a)] -> [b] -> b
f Text
t [(Text, Prop m a)]
ps ((Text -> [(Text, Prop m a)] -> [b] -> b)
-> (JSM RawNode -> b) -> (Text -> b) -> Html m a -> b
forall (m :: * -> *) a b.
(Text -> [(Text, Prop m a)] -> [b] -> b)
-> (JSM RawNode -> b) -> (Text -> b) -> Html m a -> b
cataH Text -> [(Text, Prop m a)] -> [b] -> b
f JSM RawNode -> b
g Text -> b
h' (Html m a -> b) -> [Html m a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a]
cs)
  Potato JSM RawNode
p     -> JSM RawNode -> b
g JSM RawNode
p
  TextNode Text
t   -> Text -> b
h' Text
t


-- | Natural Transformation
type m ~> n = forall a. m a -> n a


-- | A DOM node reference.
-- Useful for building baked potatoes and binding a Backend view to the page
newtype RawNode  = RawNode  { RawNode -> JSVal
unRawNode  :: JSVal }
instance ToJSVal   RawNode where toJSVal :: RawNode -> JSM JSVal
toJSVal   = JSVal -> JSM JSVal
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> JSM JSVal) -> (RawNode -> JSVal) -> RawNode -> JSM JSVal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> JSVal
unRawNode
instance FromJSVal RawNode where fromJSVal :: JSVal -> JSM (Maybe RawNode)
fromJSVal = Maybe RawNode -> JSM (Maybe RawNode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RawNode -> JSM (Maybe RawNode))
-> (JSVal -> Maybe RawNode) -> JSVal -> JSM (Maybe RawNode)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawNode -> Maybe RawNode
forall a. a -> Maybe a
Just (RawNode -> Maybe RawNode)
-> (JSVal -> RawNode) -> JSVal -> Maybe RawNode
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSVal -> RawNode
RawNode


-- | A raw event object reference
newtype RawEvent = RawEvent { RawEvent -> JSVal
unRawEvent :: JSVal }
instance ToJSVal   RawEvent where toJSVal :: RawEvent -> JSM JSVal
toJSVal   = JSVal -> JSM JSVal
forall (m :: * -> *) a. Monad m => a -> m a
return (JSVal -> JSM JSVal)
-> (RawEvent -> JSVal) -> RawEvent -> JSM JSVal
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawEvent -> JSVal
unRawEvent
instance FromJSVal RawEvent where fromJSVal :: JSVal -> JSM (Maybe RawEvent)
fromJSVal = Maybe RawEvent -> JSM (Maybe RawEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RawEvent -> JSM (Maybe RawEvent))
-> (JSVal -> Maybe RawEvent) -> JSVal -> JSM (Maybe RawEvent)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. RawEvent -> Maybe RawEvent
forall a. a -> Maybe a
Just (RawEvent -> Maybe RawEvent)
-> (JSVal -> RawEvent) -> JSVal -> Maybe RawEvent
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSVal -> RawEvent
RawEvent


-- | Strings are overloaded as the class property:
-- @
--   "active" = ("className", PText "active")
-- @
instance {-# OVERLAPPING #-} IsString [(Text, Prop m a)] where
  fromString :: String -> [(Text, Prop m a)]
fromString = (Text, Prop m a) -> [(Text, Prop m a)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Text, Prop m a) -> [(Text, Prop m a)])
-> (String -> (Text, Prop m a)) -> String -> [(Text, Prop m a)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Text
"className", ) (Prop m a -> (Text, Prop m a))
-> (String -> Prop m a) -> String -> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
textProp (Text -> Prop m a) -> (String -> Text) -> String -> Prop m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
pack
  {-# INLINE fromString #-}


-- | Construct a simple listener property that will perform an action.
listener :: Continuation m a -> Prop m a
listener :: Continuation m a -> Prop m a
listener = (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
listenerProp ((RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a)
-> (Continuation m a
    -> RawNode -> RawEvent -> JSM (Continuation m a))
-> Continuation m a
-> Prop m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (RawEvent -> JSM (Continuation m a))
-> RawNode -> RawEvent -> JSM (Continuation m a)
forall a b. a -> b -> a
const ((RawEvent -> JSM (Continuation m a))
 -> RawNode -> RawEvent -> JSM (Continuation m a))
-> (Continuation m a -> RawEvent -> JSM (Continuation m a))
-> Continuation m a
-> RawNode
-> RawEvent
-> JSM (Continuation m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSM (Continuation m a) -> RawEvent -> JSM (Continuation m a)
forall a b. a -> b -> a
const (JSM (Continuation m a) -> RawEvent -> JSM (Continuation m a))
-> (Continuation m a -> JSM (Continuation m a))
-> Continuation m a
-> RawEvent
-> JSM (Continuation m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Continuation m a -> JSM (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE listener #-}


-- | Construct a listener from its name and an event handler.
listenRaw :: Text -> (RawNode -> RawEvent -> JSM (Continuation m a)) -> (Text, Prop m a)
listenRaw :: Text
-> (RawNode -> RawEvent -> JSM (Continuation m a))
-> (Text, Prop m a)
listenRaw Text
k = (,) Text
k (Prop m a -> (Text, Prop m a))
-> ((RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a)
-> (RawNode -> RawEvent -> JSM (Continuation m a))
-> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
forall (m :: * -> *) a.
(RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
listenerProp
{-# INLINE listenRaw #-}


-- | Construct a listener from its name and an event handler.
listenC :: Text -> Continuation m a -> (Text, Prop m a)
listenC :: Text -> Continuation m a -> (Text, Prop m a)
listenC Text
k = Text
-> (RawNode -> RawEvent -> JSM (Continuation m a))
-> (Text, Prop m a)
forall (m :: * -> *) a.
Text
-> (RawNode -> RawEvent -> JSM (Continuation m a))
-> (Text, Prop m a)
listenRaw Text
k ((RawNode -> RawEvent -> JSM (Continuation m a))
 -> (Text, Prop m a))
-> (Continuation m a
    -> RawNode -> RawEvent -> JSM (Continuation m a))
-> Continuation m a
-> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (RawEvent -> JSM (Continuation m a))
-> RawNode -> RawEvent -> JSM (Continuation m a)
forall a b. a -> b -> a
const ((RawEvent -> JSM (Continuation m a))
 -> RawNode -> RawEvent -> JSM (Continuation m a))
-> (Continuation m a -> RawEvent -> JSM (Continuation m a))
-> Continuation m a
-> RawNode
-> RawEvent
-> JSM (Continuation m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSM (Continuation m a) -> RawEvent -> JSM (Continuation m a)
forall a b. a -> b -> a
const (JSM (Continuation m a) -> RawEvent -> JSM (Continuation m a))
-> (Continuation m a -> JSM (Continuation m a))
-> Continuation m a
-> RawEvent
-> JSM (Continuation m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Continuation m a -> JSM (Continuation m a)
forall (m :: * -> *) a. Monad m => a -> m a
return
{-# INLINE listenC #-}


-- | Construct a listener from its 'Text' name and an output value.
listen :: Text -> (a -> a) -> (Text, Prop m a)
listen :: Text -> (a -> a) -> (Text, Prop m a)
listen Text
k = Text -> Continuation m a -> (Text, Prop m a)
forall (m :: * -> *) a.
Text -> Continuation m a -> (Text, Prop m a)
listenC Text
k (Continuation m a -> (Text, Prop m a))
-> ((a -> a) -> Continuation m a) -> (a -> a) -> (Text, Prop m a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> a) -> Continuation m a
forall a (m :: * -> *). (a -> a) -> Continuation m a
pur
{-# INLINE listen #-}


-- | Transform the properties of some Node. This has no effect on 'TextNode's or 'Potato'es.
mapProps :: ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapProps :: ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapProps [(Text, Prop m a)] -> [(Text, Prop m a)]
f = Identity (Html m a) -> Html m a
forall a. Identity a -> a
runIdentity (Identity (Html m a) -> Html m a)
-> (Html m a -> Identity (Html m a)) -> Html m a -> Html m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([(Text, Prop m a)] -> Identity [(Text, Prop m a)])
-> Html m a -> Identity (Html m a)
forall (f :: * -> *) (m :: * -> *) a.
Applicative f =>
([(Text, Prop m a)] -> f [(Text, Prop m a)])
-> Html m a -> f (Html m a)
props ([(Text, Prop m a)] -> Identity [(Text, Prop m a)]
forall a. a -> Identity a
Identity ([(Text, Prop m a)] -> Identity [(Text, Prop m a)])
-> ([(Text, Prop m a)] -> [(Text, Prop m a)])
-> [(Text, Prop m a)]
-> Identity [(Text, Prop m a)]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(Text, Prop m a)] -> [(Text, Prop m a)]
f)
{-# INLINE mapProps #-}


-- | Transform the children of some Node. This has no effect on 'TextNode's or 'Potato'es.
mapChildren :: ([Html m a] -> [Html m a]) -> Html m a -> Html m a
mapChildren :: ([Html m a] -> [Html m a]) -> Html m a -> Html m a
mapChildren [Html m a] -> [Html m a]
f = Identity (Html m a) -> Html m a
forall a. Identity a -> a
runIdentity (Identity (Html m a) -> Html m a)
-> (Html m a -> Identity (Html m a)) -> Html m a -> Html m a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ([Html m a] -> Identity [Html m a])
-> Html m a -> Identity (Html m a)
forall (f :: * -> *) (m :: * -> *) a.
Applicative f =>
([Html m a] -> f [Html m a]) -> Html m a -> f (Html m a)
children ([Html m a] -> Identity [Html m a]
forall a. a -> Identity a
Identity ([Html m a] -> Identity [Html m a])
-> ([Html m a] -> [Html m a]) -> [Html m a] -> Identity [Html m a]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Html m a] -> [Html m a]
f)
{-# INLINE mapChildren #-}


-- | Inject props into an existing 'Node'.
injectProps :: [(Text, Prop m a)] -> Html m a -> Html m a
injectProps :: [(Text, Prop m a)] -> Html m a -> Html m a
injectProps [(Text, Prop m a)]
ps = ([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
forall (m :: * -> *) a.
([(Text, Prop m a)] -> [(Text, Prop m a)]) -> Html m a -> Html m a
mapProps ([(Text, Prop m a)] -> [(Text, Prop m a)] -> [(Text, Prop m a)]
forall a. [a] -> [a] -> [a]
++ [(Text, Prop m a)]
ps)
{-# INLINE injectProps #-}


-- | The Backend class describes a backend that can render 'Html'.
-- Backends are generally Monad Transformers @b@ over some Monad @m@.
--
-- prop> patch raw Nothing >=> patch raw Nothing = patch raw Nothing
class Backend b m a | b m -> a where
  -- | VNode type family allows backends to have their own Virtual DOM.
  -- As such we can change out the rendering of our Backend view
  -- with new backends without updating our view logic.
  type VNode b m
  -- | A backend must be able to interpret 'Html' into its own internal Virtual DOM.
  interpret
    :: (m ~> JSM)
    -- ^ Natural transformation for some @m@ to 'JSM'
    -- (this is how a Backend gets access to 'JSM' to perform the rendering side effects)
    -> Html (b m) a
    -- ^ 'Html' to interpret
    -> b m (VNode b m)
    -- ^ Effect producing the Virtual DOM representation

  -- | A Backend must be able to patch the 'RawNode' containing the view, with a
  -- new view if the Virtual DOM changed.
  patch
    :: RawNode
    -- ^ The container for rendering the Backend view
    -> Maybe (VNode b m)
    -- ^ Perhaps there is a previous Virtual DOM to diff against. The value will be 'Nothing' on the first run.
    -> VNode b m
    -- ^ New Virtual DOM to render
    -> b m (VNode b m)
    -- ^ Effect producing an updated Virtual DOM. This is not needed by all backends.
    -- Some JavaScript-based backends need to do this for the next tick. Regardless, whatever
    -- 'VNode' the effect produces will be passed as the previous Virtual DOM on the next render.

  -- | A Backend may perform some imperative setup steps.
  setup :: JSM () -> JSM ()


-- | The core view instantiation function
-- combines a backend, a territory, and a model
-- and renders the Backend view to the page.
shpadoinkle
  :: forall b m a
   . Backend b m a => Monad (b m) => Eq a
  => (m ~> JSM)
  -- ^ How to get to JSM?
  -> (TVar a -> b m ~> m)
  -- ^ What backend are we running?
  -> a
  -- ^ What is the initial state?
  -> TVar a
  -- ^ How can we know when to update?
  -> (a -> Html (b m) a)
  -- ^ How should the HTML look?
  -> b m RawNode
  -- ^ Where do we render?
  -> JSM ()
shpadoinkle :: (m ~> JSM)
-> (TVar a -> b m ~> m)
-> a
-> TVar a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
shpadoinkle m ~> JSM
toJSM TVar a -> b m ~> m
toM a
initial TVar a
model a -> Html (b m) a
view b m RawNode
stage = do
  let
    j :: b m ~> JSM
    j :: b m a -> JSM a
j = m a -> JSM a
m ~> JSM
toJSM (m a -> JSM a) -> (b m a -> m a) -> b m a -> JSM a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TVar a -> b m ~> m
toM TVar a
model

    go :: RawNode -> VNode b m -> a -> JSM (VNode b m)
    go :: RawNode -> VNode b m -> a -> JSM (VNode b m)
go RawNode
c VNode b m
n a
a = b m (VNode b m) -> JSM (VNode b m)
b m ~> JSM
j (b m (VNode b m) -> JSM (VNode b m))
-> b m (VNode b m) -> JSM (VNode b m)
forall a b. (a -> b) -> a -> b
$ do
      !VNode b m
m  <- (m ~> JSM) -> Html (b m) a -> b m (VNode b m)
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
Backend b m a =>
(m ~> JSM) -> Html (b m) a -> b m (VNode b m)
interpret m ~> JSM
toJSM (Html (b m) a -> b m (VNode b m))
-> (Html (b m) a -> Html (b m) a)
-> Html (b m) a
-> b m (VNode b m)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Html (b m) a -> Html (b m) a
forall (m :: * -> *) a. Monad m => Html m a -> Html m a
nubProps (Html (b m) a -> b m (VNode b m))
-> Html (b m) a -> b m (VNode b m)
forall a b. (a -> b) -> a -> b
$ a -> Html (b m) a
view a
a
      RawNode -> Maybe (VNode b m) -> VNode b m -> b m (VNode b m)
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
Backend b m a =>
RawNode -> Maybe (VNode b m) -> VNode b m -> b m (VNode b m)
patch RawNode
c (VNode b m -> Maybe (VNode b m)
forall a. a -> Maybe a
Just VNode b m
n) VNode b m
m

  Backend b m a => JSM () -> JSM ()
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
Backend b m a =>
JSM () -> JSM ()
setup @b @m @a (JSM () -> JSM ()) -> JSM () -> JSM ()
forall a b. (a -> b) -> a -> b
$ do
    (RawNode
c,VNode b m
n) <- b m (RawNode, VNode b m) -> JSM (RawNode, VNode b m)
b m ~> JSM
j (b m (RawNode, VNode b m) -> JSM (RawNode, VNode b m))
-> b m (RawNode, VNode b m) -> JSM (RawNode, VNode b m)
forall a b. (a -> b) -> a -> b
$ do
      RawNode
c <- b m RawNode
stage
      VNode b m
n <- (m ~> JSM) -> Html (b m) a -> b m (VNode b m)
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
Backend b m a =>
(m ~> JSM) -> Html (b m) a -> b m (VNode b m)
interpret m ~> JSM
toJSM (Html (b m) a -> b m (VNode b m))
-> (Html (b m) a -> Html (b m) a)
-> Html (b m) a
-> b m (VNode b m)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Html (b m) a -> Html (b m) a
forall (m :: * -> *) a. Monad m => Html m a -> Html m a
nubProps (Html (b m) a -> b m (VNode b m))
-> Html (b m) a -> b m (VNode b m)
forall a b. (a -> b) -> a -> b
$ a -> Html (b m) a
view a
initial
      VNode b m
_ <- RawNode -> Maybe (VNode b m) -> VNode b m -> b m (VNode b m)
forall (b :: (* -> *) -> * -> *) (m :: * -> *) a.
Backend b m a =>
RawNode -> Maybe (VNode b m) -> VNode b m -> b m (VNode b m)
patch RawNode
c Maybe (VNode b m)
forall a. Maybe a
Nothing VNode b m
n
      (RawNode, VNode b m) -> b m (RawNode, VNode b m)
forall (m :: * -> *) a. Monad m => a -> m a
return (RawNode
c,VNode b m
n)
    ()
_ <- (VNode b m -> a -> JSM (VNode b m))
-> VNode b m -> TVar a -> JSM ()
forall (m :: * -> *) a b.
(MonadUnliftIO m, Eq a) =>
(b -> a -> m b) -> b -> TVar a -> m ()
shouldUpdate (RawNode -> VNode b m -> a -> JSM (VNode b m)
go RawNode
c) VNode b m
n TVar a
model
    () -> JSM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()