{-# LANGUAGE AllowAmbiguousTypes    #-}
{-# 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.
-}


{-# OPTIONS_GHC -Wno-unused-imports #-}
module Shpadoinkle.Core (
  -- * Base Types
  Html(..), Prop(..), Props(..), fromProps, toProps
  -- ** Prop Constructors
  , dataProp, flagProp, textProp, listenerProp, bakedProp
  -- *** Listeners
  , listenRaw, listen, listenM, listenM_, listenC, listener
  -- ** Html Constructors
  , h, baked, text
  -- ** Hoists
  , hoistHtml, hoistProp
  -- ** Catamorphisms
  , cataH, cataProp
  -- ** Utilities
  , mapProps, 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.Applicative           (liftA2)
import qualified Control.Categorical.Functor   as F
import           Control.Category              ((.))
import           Control.PseudoInverseCategory (EndoIso (..),
                                                HasHaskFunctors (fmapA),
                                                PIArrow (piendo, piiso),
                                                PseudoInverseCategory (piinverse),
                                                ToHask (piapply))
import           Data.Kind                     (Type)
import           Data.Map                      as M (Map, foldl', insert,
                                                     mapEither, singleton,
                                                     toList, unionWithKey)
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.
-- This is Church encoded for performance reasons.
newtype Html m a = Html
  { Html m a
-> forall r.
   (Text -> [(Text, Prop m a)] -> [r] -> r)
   -> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
unHtml
      :: forall r. (Text -> [(Text, Prop m a)] -> [r] -> r)
      -> (JSM (RawNode, STM (Continuation m a)) -> r)
      -> (Text -> r)
      -> r
  }


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


instance Eq (Prop m a) where
  Prop m a
x == :: Prop m a -> Prop m a -> Bool
== Prop m a
y = case (Prop m a
x,Prop m a
y) of
    (PText Text
x', PText Text
y') -> Text
x' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
y'
    (PFlag Bool
x', PFlag Bool
y') -> Bool
x' Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y'
    (Prop m a, Prop m a)
_                    -> Bool
False


-- | Construct a listener from its name and a simple monadic event handler.
listenM :: Applicative 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.
Applicative m =>
m (a -> a) -> Continuation m a
impur


-- | Construct a listener from its name and a simple stateless monadic event handler.
listenM_ :: Applicative 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. Applicative m => m () -> Continuation m a
causes


newtype Props m a = Props { Props m a -> Map Text (Prop m a)
getProps :: Map Text (Prop m a) }


{-# SPECIALIZE toProps :: [(Text, Prop JSM a)] -> Props JSM a #-}
toProps :: Applicative m => [(Text, Prop m a)] -> Props m a
toProps :: [(Text, Prop m a)] -> Props m a
toProps = ((Text, Prop m a) -> Props m a) -> [(Text, Prop m a)] -> Props m a
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((Text, Prop m a) -> Props m a)
 -> [(Text, Prop m a)] -> Props m a)
-> ((Text, Prop m a) -> Props m a)
-> [(Text, Prop m a)]
-> Props m a
forall a b. (a -> b) -> a -> b
$ Map Text (Prop m a) -> Props m a
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props (Map Text (Prop m a) -> Props m a)
-> ((Text, Prop m a) -> Map Text (Prop m a))
-> (Text, Prop m a)
-> Props 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 -> Map Text (Prop m a))
-> (Text, Prop m a) -> Map Text (Prop m a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Prop m a -> Map Text (Prop m a)
forall k a. k -> a -> Map k a
singleton


fromProps :: Props m a -> [(Text, Prop m a)]
fromProps :: Props m a -> [(Text, Prop m a)]
fromProps = Map Text (Prop m a) -> [(Text, Prop m a)]
forall k a. Map k a -> [(k, a)]
M.toList (Map Text (Prop m a) -> [(Text, Prop m a)])
-> (Props m a -> Map Text (Prop m a))
-> Props 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
. Props m a -> Map Text (Prop m a)
forall (m :: * -> *) a. Props m a -> Map Text (Prop m a)
getProps


instance Applicative m => Semigroup (Props m a) where
  Props Map Text (Prop m a)
xs <> :: Props m a -> Props m a -> Props m a
<> Props Map Text (Prop m a)
ys = Map Text (Prop m a) -> Props m a
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props (Map Text (Prop m a) -> Props m a)
-> Map Text (Prop m a) -> Props m a
forall a b. (a -> b) -> a -> b
$ (Text -> Prop m a -> Prop m a -> Prop m a)
-> Map Text (Prop m a)
-> Map Text (Prop m a)
-> Map Text (Prop m a)
forall k a.
Ord k =>
(k -> a -> a -> a) -> Map k a -> Map k a -> Map k a
unionWithKey Text -> Prop m a -> Prop m a -> Prop m a
forall a (m :: * -> *) a.
(Eq a, IsString a, Applicative m) =>
a -> Prop m a -> Prop m a -> Prop m a
go Map Text (Prop m a)
xs Map Text (Prop m a)
ys
    where
      go :: a -> Prop m a -> Prop m a -> Prop m a
go a
k Prop m a
old Prop m a
new = case (Prop m a
old, Prop m a
new) of
        (PText Text
t, 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
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t')
        (PText Text
t, PText Text
t') | a
k a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
"style"     -> Text -> Prop m a
forall (m :: * -> *) a. Text -> Prop m a
PText (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, 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, Prop m a)
_                                      -> Prop m a
new


instance Applicative m => Monoid (Props m a) where
  mempty :: Props m a
mempty = Map Text (Prop m a) -> Props m a
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props Map Text (Prop m a)
forall a. Monoid a => a
mempty


-- | If you can provide a Natural Transformation from one Functor to another
-- then you may change the action of 'Html'.
hoistHtml :: Functor m => (m ~> n) -> Html m a -> Html n a
hoistHtml :: (m ~> n) -> Html m a -> Html n a
hoistHtml m ~> n
f (Html forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h') = (forall r.
 (Text -> [(Text, Prop n a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation n a)) -> r)
 -> (Text -> r)
 -> r)
-> Html n a
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop n a)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation n a)) -> r)
  -> (Text -> r)
  -> r)
 -> Html n a)
-> (forall r.
    (Text -> [(Text, Prop n a)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation n a)) -> r)
    -> (Text -> r)
    -> r)
-> Html n a
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop n a)] -> [r] -> r
n JSM (RawNode, STM (Continuation n a)) -> r
p Text -> r
t -> (Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h'
  (\Text
t' [(Text, Prop m a)]
ps [r]
cs -> Text -> [(Text, Prop n a)] -> [r] -> r
n 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) [r]
cs) (JSM (RawNode, STM (Continuation n a)) -> r
p (JSM (RawNode, STM (Continuation n a)) -> r)
-> (JSM (RawNode, STM (Continuation m a))
    -> JSM (RawNode, STM (Continuation n a)))
-> JSM (RawNode, STM (Continuation m a))
-> r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((RawNode, STM (Continuation m a))
 -> (RawNode, STM (Continuation n a)))
-> JSM (RawNode, STM (Continuation m a))
-> JSM (RawNode, STM (Continuation n a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((STM (Continuation m a) -> STM (Continuation n a))
-> (RawNode, STM (Continuation m a))
-> (RawNode, 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)))) Text -> r
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
text (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 Applicative 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 Applicative 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 (Html forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h') = (forall r.
 (Text -> [(Text, Prop m b)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m b)) -> r)
 -> (Text -> r)
 -> r)
-> Html m b
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop m b)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation m b)) -> r)
  -> (Text -> r)
  -> r)
 -> Html m b)
-> (forall r.
    (Text -> [(Text, Prop m b)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation m b)) -> r)
    -> (Text -> r)
    -> r)
-> Html m b
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop m b)] -> [r] -> r
n JSM (RawNode, STM (Continuation m b)) -> r
p Text -> r
t -> (Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h' (\Text
t' [(Text, Prop m a)]
ps [r]
cs -> Text -> [(Text, Prop m b)] -> [r] -> r
n Text
t' ((Prop m a -> Prop m b) -> (Text, Prop m a) -> (Text, Prop m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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) -> (Text, Prop m b))
-> [(Text, Prop m a)] -> [(Text, Prop m b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Prop m a)]
ps) [r]
cs)
         (JSM (RawNode, STM (Continuation m b)) -> r
p (JSM (RawNode, STM (Continuation m b)) -> r)
-> (JSM (RawNode, STM (Continuation m a))
    -> JSM (RawNode, STM (Continuation m b)))
-> JSM (RawNode, STM (Continuation m a))
-> r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((RawNode, STM (Continuation m a))
 -> (RawNode, STM (Continuation m b)))
-> JSM (RawNode, STM (Continuation m a))
-> JSM (RawNode, STM (Continuation m b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((STM (Continuation m a) -> STM (Continuation m b))
-> (RawNode, STM (Continuation m a))
-> (RawNode, 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)
-> Continuation m a -> Continuation 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 -> r
t
  {-# INLINE mapC #-}


-- | Props is a functor in the EndoIso category, where the objects are
--  types and the morphisms are EndoIsos.
instance Applicative m => F.Functor EndoIso EndoIso (Props m) where
  map :: EndoIso a b -> EndoIso (Props m a) (Props m b)
map EndoIso a b
f = (Map Text (Prop m b) -> Props m b)
-> (Props m b -> Map Text (Prop m b))
-> EndoIso (Map Text (Prop m b)) (Props m b)
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso Map Text (Prop m b) -> Props m b
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props Props m b -> Map Text (Prop m b)
forall (m :: * -> *) a. Props m a -> Map Text (Prop m a)
getProps EndoIso (Map Text (Prop m b)) (Props m b)
-> EndoIso (Props m a) (Map Text (Prop m b))
-> EndoIso (Props 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
. EndoIso (Prop m a) (Prop m b)
-> EndoIso (Map Text (Prop m a)) (Map Text (Prop m b))
forall (a :: * -> * -> *) (f :: * -> *) x y.
(HasHaskFunctors a, Functor f) =>
a x y -> a (f x) (f y)
fmapA (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 (Map Text (Prop m a)) (Map Text (Prop m b))
-> EndoIso (Props m a) (Map Text (Prop m a))
-> EndoIso (Props m a) (Map 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
. (Props m a -> Map Text (Prop m a))
-> (Map Text (Prop m a) -> Props m a)
-> EndoIso (Props m a) (Map Text (Prop m a))
forall (a :: * -> * -> *) b c.
PIArrow a =>
(b -> c) -> (c -> b) -> a b c
piiso Props m a -> Map Text (Prop m a)
forall (m :: * -> *) a. Props m a -> Map Text (Prop m a)
getProps Map Text (Prop m a) -> Props m a
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props
  {-# 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 Props where
  mapC :: (Continuation m a -> Continuation m b) -> Props m a -> Props m b
mapC Continuation m a -> Continuation m b
f = Map Text (Prop m b) -> Props m b
forall (m :: * -> *) a. Map Text (Prop m a) -> Props m a
Props (Map Text (Prop m b) -> Props m b)
-> (Props m a -> Map Text (Prop m b)) -> Props 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
. (Prop m a -> Prop m b)
-> Map Text (Prop m a) -> Map Text (Prop m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((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) (Map Text (Prop m a) -> Map Text (Prop m b))
-> (Props m a -> Map Text (Prop m a))
-> Props m a
-> Map 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
. Props m a -> Map Text (Prop m a)
forall (m :: * -> *) a. Props m a -> Map Text (Prop m a)
getProps
  {-# 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
t [(Text, Prop m a)]
ps [Html m a]
cs = (forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop m a)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation m a)) -> r)
  -> (Text -> r)
  -> r)
 -> Html m a)
-> (forall r.
    (Text -> [(Text, Prop m a)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation m a)) -> r)
    -> (Text -> r)
    -> r)
-> Html m a
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop m a)] -> [r] -> r
a JSM (RawNode, STM (Continuation m a)) -> r
b Text -> r
c -> Text -> [(Text, Prop m a)] -> [r] -> r
a Text
t [(Text, Prop m a)]
ps ((\(Html forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h') -> (Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h' Text -> [(Text, Prop m a)] -> [r] -> r
a JSM (RawNode, STM (Continuation m a)) -> r
b Text -> r
c) (Html m a -> r) -> [Html m a] -> [r]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Html m a]
cs)
{-# INLINE h #-}


-- | Construct a 'Potato' from a 'JSM' action producing a 'RawNode'.
baked :: JSM (RawNode, STM (Continuation m a)) -> Html m a
baked :: JSM (RawNode, STM (Continuation m a)) -> Html m a
baked JSM (RawNode, STM (Continuation m a))
jr = (forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop m a)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation m a)) -> r)
  -> (Text -> r)
  -> r)
 -> Html m a)
-> (forall r.
    (Text -> [(Text, Prop m a)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation m a)) -> r)
    -> (Text -> r)
    -> r)
-> Html m a
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop m a)] -> [r] -> r
_ JSM (RawNode, STM (Continuation m a)) -> r
p Text -> r
_ -> JSM (RawNode, STM (Continuation m a)) -> r
p JSM (RawNode, STM (Continuation m a))
jr
{-# INLINE baked #-}


-- | Construct a text node.
text :: Text -> Html m a
text :: Text -> Html m a
text Text
t = (forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop m a)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation m a)) -> r)
  -> (Text -> r)
  -> r)
 -> Html m a)
-> (forall r.
    (Text -> [(Text, Prop m a)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation m a)) -> r)
    -> (Text -> r)
    -> r)
-> Html m a
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop m a)] -> [r] -> r
_ JSM (RawNode, STM (Continuation m a)) -> r
_ Text -> r
f -> Text -> r
f Text
t
{-# INLINE text #-}


-- | Construct an HTML element out of heterogeneous alternatives.
eitherH :: Applicative 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.
(Applicative 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, STM (Continuation m a)) -> b)
      -> (Text -> b)
      -> Html m a -> b
cataH :: (Text -> [(Text, Prop m a)] -> [b] -> b)
-> (JSM (RawNode, STM (Continuation m a)) -> b)
-> (Text -> b)
-> Html m a
-> b
cataH Text -> [(Text, Prop m a)] -> [b] -> b
f JSM (RawNode, STM (Continuation m a)) -> b
g Text -> b
h' (Html forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h'') = (Text -> [(Text, Prop m a)] -> [b] -> b)
-> (JSM (RawNode, STM (Continuation m a)) -> b) -> (Text -> b) -> b
forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h'' Text -> [(Text, Prop m a)] -> [b] -> b
f JSM (RawNode, STM (Continuation m a)) -> b
g Text -> b
h'


-- | 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 (Html forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h') = (forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
forall (m :: * -> *) a.
(forall r.
 (Text -> [(Text, Prop m a)] -> [r] -> r)
 -> (JSM (RawNode, STM (Continuation m a)) -> r)
 -> (Text -> r)
 -> r)
-> Html m a
Html ((forall r.
  (Text -> [(Text, Prop m a)] -> [r] -> r)
  -> (JSM (RawNode, STM (Continuation m a)) -> r)
  -> (Text -> r)
  -> r)
 -> Html m a)
-> (forall r.
    (Text -> [(Text, Prop m a)] -> [r] -> r)
    -> (JSM (RawNode, STM (Continuation m a)) -> r)
    -> (Text -> r)
    -> r)
-> Html m a
forall a b. (a -> b) -> a -> b
$ \Text -> [(Text, Prop m a)] -> [r] -> r
n JSM (RawNode, STM (Continuation m a)) -> r
p Text -> r
t -> (Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
forall r.
(Text -> [(Text, Prop m a)] -> [r] -> r)
-> (JSM (RawNode, STM (Continuation m a)) -> r) -> (Text -> r) -> r
h' (\Text
t' [(Text, Prop m a)]
ps [r]
cs -> Text -> [(Text, Prop m a)] -> [r] -> r
n Text
t' ([(Text, Prop m a)] -> [(Text, Prop m a)]
f [(Text, Prop m a)]
ps) [r]
cs) JSM (RawNode, STM (Continuation m a)) -> r
p Text -> r
t
{-# INLINE mapProps #-}


-- | 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. Semigroup 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?
  -> 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)
-> TVar a
-> (a -> Html (b m) a)
-> b m RawNode
-> JSM ()
shpadoinkle m ~> JSM
toJSM TVar a -> b m ~> m
toM TVar a
model a -> Html (b m) a
view b m RawNode
stage = 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 <- b m RawNode -> JSM RawNode
b m ~> JSM
j b m RawNode
stage
  a
initial <- TVar a -> JSM a
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar a
model
  VNode b m
n <- RawNode -> Maybe (VNode b m) -> a -> JSM (VNode b m)
go RawNode
c Maybe (VNode b m)
forall a. Maybe a
Nothing a
initial
  () () -> JSM () -> JSM ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (VNode b m -> a -> JSM (VNode b m))
-> VNode b m -> TVar a -> JSM ()
forall a b (m :: * -> *).
(MonadJSM m, MonadUnliftIO m, Eq a) =>
(b -> a -> m b) -> b -> TVar a -> m ()
shouldUpdate (RawNode -> Maybe (VNode b m) -> a -> JSM (VNode b m)
go RawNode
c (Maybe (VNode b m) -> a -> JSM (VNode b m))
-> (VNode b m -> Maybe (VNode b m))
-> VNode b m
-> a
-> JSM (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
. VNode b m -> Maybe (VNode b m)
forall a. a -> Maybe a
Just) VNode b m
n TVar a
model

  where

  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 -> Maybe (VNode b m) -> a -> JSM (VNode b m)
  go :: RawNode -> Maybe (VNode b m) -> a -> JSM (VNode b m)
go RawNode
c Maybe (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
$ 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)
n (VNode b m -> b m (VNode b m))
-> b m (VNode b m) -> b m (VNode b m)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (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 (a -> Html (b m) a
view a
a)