From 10d2c1fa21abc7da94e8dc2127516533534ab2d6 Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 09:19:11 -0700
Subject: [PATCH 1/9] dep

---
 core/Shpadoinkle/Core.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/core/Shpadoinkle/Core.hs b/core/Shpadoinkle/Core.hs
index d4c17070..292330c0 100644
--- a/core/Shpadoinkle/Core.hs
+++ b/core/Shpadoinkle/Core.hs
@@ -44,6 +44,7 @@ module Shpadoinkle.Core (
   -- * Backend Interface
   , Backend (..)
   , type (~>)
+  , Dependency(..)
   -- * The Shpadoinkle Primitive
   , shpadoinkle
   -- * Re-Exports
@@ -59,7 +60,7 @@ import           Control.PseudoInverseCategory (EndoIso (..),
                                                 PIArrow (piendo, piiso),
                                                 PseudoInverseCategory (piinverse),
                                                 ToHask (piapply))
-import           Data.Kind                     (Type)
+import           Data.Kind                     (Constraint, Type)
 import           Data.Map                      as M (Map, singleton, toList,
                                                      unionWithKey)
 import           Data.String                   (IsString (..))
@@ -88,6 +89,7 @@ import           Shpadoinkle.Continuation      (Continuation, Continuous (..),
 newtype Html m a = Html
   { unHtml
       :: forall r. (Text -> Props m a -> [r] -> r)
+      -> (Dependency -> r -> r)
       -> (JSM RawNode -> r)
       -> (Text -> r)
       -> r
@@ -318,19 +320,25 @@ cataProp d t f l p = \case
 
 -- | Construct an HTML element JSX-style.
 h :: Applicative m => Text -> [(Text, Prop m a)] -> [Html m a] -> Html m a
-h t ps cs = Html $ \a b c -> a t (toProps ps) ((\(Html h') -> h' a b c) <$> cs)
+h t ps cs = Html $ \a d b c -> a t (toProps ps) ((\(Html h') -> h' a d b c) <$> cs)
 {-# INLINE h #-}
 
 
+-- | Memoed
+depending :: forall b m a c. Requirments b m => (a -> Html m c) -> (a -> Html m c)
+depending f x = Html $ \a d b c -> d (Dependency @b @m x)
+              $ case f x of Html h' -> h' a d b c
+
+
 -- | Construct a 'Potato' from a 'JSM' action producing a 'RawNode'.
 baked :: JSM RawNode -> Html m a
-baked jr = Html $ \_ p _ -> p jr
+baked jr = Html $ \_ _ p _ -> p jr
 {-# INLINE baked #-}
 
 
 -- | Construct a text node.
 text :: Text -> Html m a
-text t = Html $ \_ _ f -> f t
+text t = Html $ \_ _ _ f -> f t
 {-# INLINE text #-}
 
 
@@ -342,10 +350,11 @@ eitherH = eitherC
 
 -- | Fold an HTML element, i.e. transform an h-algebra into an h-catamorphism.
 cataH :: (Text -> [(Text, Prop m a)] -> [b] -> b)
+      -> (Dependency -> b -> b)
       -> (JSM RawNode -> b)
       -> (Text -> b)
       -> Html m a -> b
-cataH f g h' (Html h'') = h'' (\t ps cs -> f t (fromProps ps) cs) g h'
+cataH f d g h' (Html h'') = h'' (\t ps cs -> f t (fromProps ps) cs) d g h'
 
 
 -- | Natural Transformation
@@ -410,15 +419,19 @@ injectProps ps = mapProps (<> toProps ps)
 {-# INLINE injectProps #-}
 
 
+data Dependency = forall b m a. Requirments b m => Dependency a
+
+
 -- | 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
+  type Requirments b m :: Constraint
   -- | 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
+  type VNode b m :: Type
   -- | A backend must be able to interpret 'Html' into its own internal Virtual DOM.
   interpret
     :: (m ~> JSM)
-- 
GitLab


From c8bb1970bec87f8d366dfddddc7533a9bb2681ec Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 14:06:14 -0700
Subject: [PATCH 2/9] hmmm

---
 .../pardiff/Shpadoinkle/Backend/ParDiff.hs    | 77 +++++++++++++------
 .../snabbdom/Shpadoinkle/Backend/Snabbdom.hs  |  4 +-
 backends/static/Shpadoinkle/Backend/Static.hs |  4 +-
 core/Shpadoinkle/Core.hs                      | 34 ++++----
 examples/TODOMVC.hs                           | 25 +++---
 examples/package.yaml                         |  1 +
 html/Shpadoinkle/Html/Memo.hs                 | 53 +++++++------
 7 files changed, 124 insertions(+), 74 deletions(-)

diff --git a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
index c61aa601..9f625333 100644
--- a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
+++ b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
@@ -45,6 +45,7 @@ module Shpadoinkle.Backend.ParDiff
 
 
 import           Control.Applicative         (Alternative)
+import           Control.Compactable         (traverseMaybe)
 import           Control.Monad               (forM_, void, when)
 import           Control.Monad.Base          (MonadBase (..), liftBaseDefault)
 import           Control.Monad.Catch         (MonadCatch, MonadThrow)
@@ -64,8 +65,9 @@ import           Data.Monoid                 ((<>))
 import           Data.Once                   (Once, newOnce, runOnce)
 import           Data.Text                   (Text, intercalate)
 import           Language.Javascript.JSaddle (FromJSVal (fromJSValUnchecked),
-                                              JSString, MakeObject (makeObject),
-                                              Object, ToJSString (toJSString),
+                                              JSString, JSVal,
+                                              MakeObject (makeObject), Object,
+                                              ToJSString (toJSString),
                                               ToJSVal (toJSVal), eval, fun,
                                               jsFalse, jsTrue, jsg, jsg2,
                                               liftJSM, unsafeSetProp,
@@ -77,9 +79,9 @@ import           UnliftIO.Concurrent         (forkIO)
 import           UnliftIO.STM                (STM, atomically)
 
 import           Shpadoinkle                 (Backend (..), Continuation,
-                                              Html (..), JSM, MonadJSM, NFData,
-                                              Prop (..), Props (..),
-                                              RawEvent (RawEvent),
+                                              Dependency (..), Html (..), JSM,
+                                              MonadJSM, NFData, Prop (..),
+                                              Props (..), RawEvent (RawEvent),
                                               RawNode (RawNode, unRawNode),
                                               fromProps, hoist, type (~>),
                                               writeUpdate)
@@ -139,9 +141,12 @@ data ParVNode :: Type -> Type where
   ParNode     :: Once JSM RawNode -> {-# UNPACK #-} !Text -> ParVProps a -> [ParVNode a] -> ParVNode a
   ParPotato   :: Once JSM RawNode -> ParVNode a
   ParTextNode :: Once JSM RawNode -> {-# UNPACK #-} !Text -> ParVNode a
+  ParDepend   :: !Dependency -> ParVNode a -> ParVNode a
+
 
 type ParVProps = Props JSM
 
+
 type ParVProp = Prop JSM
 
 
@@ -184,11 +189,12 @@ setListener i m o k = do
   unsafeSetProp ("on" <> k) f o
 
 
-getRaw :: ParVNode a -> Once JSM RawNode
+getRaw :: ParVNode a -> Maybe (Once JSM RawNode)
 getRaw = \case
-  ParNode mk _ _ _ -> mk
-  ParPotato mk     -> mk
-  ParTextNode mk _ -> mk
+  ParNode mk _ _ _ -> Just mk
+  ParPotato mk     -> Just mk
+  ParTextNode mk _ -> Just mk
+  ParDepend _ _    -> Nothing
 
 
 makeProp :: Monad m => (m ~> JSM) -> TVar a -> Prop (ParDiffT a m) a -> ParVProp a
@@ -294,14 +300,20 @@ patchChildren
   => NFData a
   => RawNode -> [ParVNode a] -> [ParVNode a] -> ParDiffT a m [ParVNode a]
 patchChildren (RawNode p) [] new = liftJSM $ do
-  forM_ new $ \newChild -> do
-    RawNode cRaw <- runOnce (getRaw newChild)
-    p # "appendChild" $ cRaw
+  forM_ new $ \newChild ->
+      case getRaw newChild of
+        Nothing -> pure ()
+        Just ronce -> do
+          RawNode cRaw <- runOnce ronce
+          _ <- p # "appendChild" $ cRaw
+          pure ()
   pure new
 patchChildren _ old [] = liftJSM $ do
   doc <- jsg "document"
   tmp <- doc # "createElement" $ "div"
-  old' <- traverse (fmap unRawNode . runOnce . getRaw) old
+  old' :: [JSVal] <- traverseMaybe (\x -> case getRaw x of
+     Just once -> Just . unRawNode <$> runOnce once
+     Nothing   -> pure Nothing) old
   void (tmp # "replaceChildren" $ old')
   void (tmp # "remove" $ ())
   pure []
@@ -343,13 +355,22 @@ patch' parent old new = do
         cs'' <- patchChildren raw' cs cs'
         return $ ParNode raw name ps' cs''
 
+    (ParDepend dep html, ParDepend dep' _)
+      | dep == dep' -> pure $ ParDepend dep html
+
+    (ParDepend _ html, ParDepend _ html') ->
+      patch' parent html html'
+
     -- node definitely has changed
     _ -> liftJSM $ do
         let RawNode p = parent
-        RawNode r <- runOnce $ getRaw old
-        RawNode c <- runOnce $ getRaw new
-        _ <- p # "replaceChild" $ (c, r)
-        return new
+        case (,) <$> getRaw old <*> getRaw new of
+          Nothing -> return new
+          Just (mold, mnew) -> do
+            RawNode r <- runOnce mold
+            RawNode c <- runOnce mnew
+            _ <- p # "replaceChild" $ (c, r)
+            return new
 
 
 interpret'
@@ -357,7 +378,7 @@ interpret'
    . MonadJSM m
   => NFData a
   => (m ~> JSM) -> Html (ParDiffT a m) a -> ParDiffT a m (ParVNode a)
-interpret' toJSM (Html h') = h' mkNode mkPotato mkText
+interpret' toJSM (Html h') = h' mkNode mkDep mkPotato mkText
   where
     mkNode :: Text -> Props (ParDiffT a m) a -> [ParDiffT a m (ParVNode a)] -> ParDiffT a m (ParVNode a)
     mkNode name ps cs = do
@@ -367,15 +388,21 @@ interpret' toJSM (Html h') = h' mkNode mkPotato mkText
         doc <- jsg "document"
         raw' <- doc # "createElement" $ name
         props toJSM i ps (RawNode raw')
-        forM_ cs' $ \c -> do
-          RawNode cRaw <- runOnce (getRaw c)
-          raw' # "appendChild" $ cRaw
+        forM_ cs' $ \c -> case getRaw c of
+          Nothing -> pure ()
+          Just monce -> do
+            RawNode cRaw <- runOnce monce
+            _ <- raw' # "appendChild" $ cRaw
+            pure ()
         return (RawNode raw')
 
       let p = Props (makeProp toJSM i <$> getProps ps)
 
       return $ ParNode raw name p cs'
 
+    mkDep :: Dependency -> ParDiffT a m (ParVNode a) -> ParDiffT a m (ParVNode a)
+    mkDep d pd = ParDepend d <$> pd
+
     mkPotato :: JSM RawNode -> ParDiffT a m (ParVNode a)
     mkPotato = fmap ParPotato . liftJSM . newOnce
 
@@ -400,8 +427,12 @@ instance
     Nothing ->
       liftJSM $ do
         let RawNode p = parent
-        RawNode c <- runOnce (getRaw new)
-        _ <- p # "appendChild" $ c
+        case getRaw new of
+          Nothing -> pure ()
+          Just monce -> do
+            RawNode c <- runOnce monce
+            _ <- p # "appendChild" $ c
+            pure ()
         return new
     Just old -> patch' parent old new
 
diff --git a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
index be5ef61f..31710c73 100644
--- a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
+++ b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
@@ -30,7 +30,7 @@ module Shpadoinkle.Backend.Snabbdom
   ) where
 
 
-import           Control.Category            ((.))
+import           Control.Category            (id, (.))
 import           Control.Monad.Base          (MonadBase (..), liftBaseDefault)
 import           Control.Monad.Catch         (MonadCatch, MonadThrow)
 import           Control.Monad.Reader        (MonadIO, MonadReader (..),
@@ -186,6 +186,8 @@ instance (MonadJSM m, NFData a) => Backend (SnabbdomT a) m a where
         o <- props toJSM i $ fromProps ps
         jsg3 "vnode" name o cs >>= fromJSValUnchecked)
 
+    (const id)
+
     (\mrn -> liftJSM $ do
       o <- create
       hook <- create
diff --git a/backends/static/Shpadoinkle/Backend/Static.hs b/backends/static/Shpadoinkle/Backend/Static.hs
index 04083b65..91a3fdbd 100644
--- a/backends/static/Shpadoinkle/Backend/Static.hs
+++ b/backends/static/Shpadoinkle/Backend/Static.hs
@@ -14,12 +14,12 @@ import           Control.Compactable (Compactable (fmapMaybe))
 import           Data.Monoid         (mconcat, (<>))
 import           Data.Text           (Text, null, unwords)
 
-import           Shpadoinkle         (Html, Prop (PText), cataH, cataProp)
+import           Shpadoinkle         (Html, Prop (PText), cataHtml, cataProp)
 
 
 -- | Render as @Text@
 renderStatic :: Html m a -> Text
-renderStatic = cataH renderTag (const mempty) id
+renderStatic = cataHtml renderTag (const id) (const mempty) id
 
 
 renderTag :: Text -> [(Text, Prop m a)] -> [Text] -> Text
diff --git a/core/Shpadoinkle/Core.hs b/core/Shpadoinkle/Core.hs
index 292330c0..19916397 100644
--- a/core/Shpadoinkle/Core.hs
+++ b/core/Shpadoinkle/Core.hs
@@ -32,11 +32,11 @@ module Shpadoinkle.Core (
   -- *** Listeners
   , listenRaw, listen, listenM, listenM_, listenC, listener
   -- ** Html Constructors
-  , h, baked, text
+  , h, baked, text, depending
   -- ** Hoists
   , hoistHtml, hoistProp
   -- ** Catamorphisms
-  , cataH, cataProp
+  , cataHtml, cataProp
   -- ** Utilities
   , mapProps, injectProps, eitherH
   -- * JSVal Wrappers
@@ -60,11 +60,12 @@ import           Control.PseudoInverseCategory (EndoIso (..),
                                                 PIArrow (piendo, piiso),
                                                 PseudoInverseCategory (piinverse),
                                                 ToHask (piapply))
-import           Data.Kind                     (Constraint, Type)
+import           Data.Kind                     (Type)
 import           Data.Map                      as M (Map, singleton, toList,
                                                      unionWithKey)
 import           Data.String                   (IsString (..))
 import           Data.Text                     (Text, pack)
+import           Data.Typeable                 (Typeable, cast)
 import           GHCJS.DOM.Types               (JSM, MonadJSM, liftJSM)
 import           Language.Javascript.JSaddle   (FromJSVal (..), JSVal,
                                                 ToJSVal (..), askJSM, runJSM)
@@ -325,8 +326,8 @@ h t ps cs = Html $ \a d b c -> a t (toProps ps) ((\(Html h') -> h' a d b c) <$>
 
 
 -- | Memoed
-depending :: forall b m a c. Requirments b m => (a -> Html m c) -> (a -> Html m c)
-depending f x = Html $ \a d b c -> d (Dependency @b @m x)
+depending :: (Eq a, Show a, Typeable a) => (a -> Html m c) -> (a -> Html m c)
+depending f x = Html $ \a d b c -> d (Dependency x)
               $ case f x of Html h' -> h' a d b c
 
 
@@ -349,12 +350,12 @@ eitherH = eitherC
 
 
 -- | Fold an HTML element, i.e. transform an h-algebra into an h-catamorphism.
-cataH :: (Text -> [(Text, Prop m a)] -> [b] -> b)
-      -> (Dependency -> b -> b)
-      -> (JSM RawNode -> b)
-      -> (Text -> b)
-      -> Html m a -> b
-cataH f d g h' (Html h'') = h'' (\t ps cs -> f t (fromProps ps) cs) d g h'
+cataHtml :: (Text -> [(Text, Prop m a)] -> [r] -> r)
+      -> (Dependency -> r -> r)
+      -> (JSM RawNode -> r)
+      -> (Text -> r)
+      -> Html m a -> r
+cataHtml f d g h' (Html h'') = h'' (\t ps cs -> f t (fromProps ps) cs) d g h'
 
 
 -- | Natural Transformation
@@ -419,7 +420,15 @@ injectProps ps = mapProps (<> toProps ps)
 {-# INLINE injectProps #-}
 
 
-data Dependency = forall b m a. Requirments b m => Dependency a
+data Dependency = forall a. (Eq a, Show a, Typeable a) => Dependency !a
+
+
+instance Eq Dependency where
+  Dependency l == Dependency r = cast l == Just r
+
+
+instance Show Dependency where
+  show (Dependency x) = "Dependency (" ++ show x ++ ")"
 
 
 -- | The Backend class describes a backend that can render 'Html'.
@@ -427,7 +436,6 @@ data Dependency = forall b m a. Requirments b m => Dependency a
 --
 -- prop> patch raw Nothing >=> patch raw Nothing = patch raw Nothing
 class Backend b m a | b m -> a where
-  type Requirments b m :: Constraint
   -- | 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.
diff --git a/examples/TODOMVC.hs b/examples/TODOMVC.hs
index bacd934a..2b0cdf5e 100644
--- a/examples/TODOMVC.hs
+++ b/examples/TODOMVC.hs
@@ -15,11 +15,12 @@ import           Control.Lens                  hiding (view)
 import           Data.Generics.Labels          ()
 import           Data.String                   (IsString)
 import           Data.Text                     hiding (count, filter, length)
+import           Data.Typeable                 (Typeable)
 import           GHC.Generics                  (Generic)
 import           Prelude                       hiding (div, unwords)
 import           Shpadoinkle                   (Html, JSM, NFData, readTVarIO,
                                                 shpadoinkle, text)
-import           Shpadoinkle.Backend.Snabbdom  (runSnabbdom, stage)
+import           Shpadoinkle.Backend.ParDiff   (runParDiff, stage)
 import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 button', checked, class', div,
                                                 div_, footer, for', form, h1_,
@@ -39,24 +40,24 @@ default (Text)
 
 
 newtype Description = Description { unDescription :: Text }
-  deriving stock Generic deriving newtype (Show, Read, Eq, IsString) deriving anyclass NFData
+  deriving stock (Generic, Typeable) deriving newtype (Show, Read, Eq, IsString) deriving anyclass NFData
 newtype TaskId      = TaskId      { unTaskId      :: Int  }
-  deriving stock Generic deriving newtype (Show, Read, Eq, Ord, Num) deriving anyclass NFData
+  deriving stock (Generic, Typeable) deriving newtype (Show, Read, Eq, Ord, Num) deriving anyclass NFData
 
 
 data Completed  = Complete | Incomplete
-  deriving (Generic, Show, Read, Eq, NFData)
+  deriving (Generic, Typeable, Show, Read, Eq, NFData)
 
 
 data Visibility = All | Active | Completed
-  deriving (Generic, Show, Read, Eq, Ord, Enum, Bounded, NFData)
+  deriving (Generic, Typeable, Show, Read, Eq, Ord, Enum, Bounded, NFData)
 
 
 data Task = Task
   { description :: Description
   , completed   :: Completed
   , taskId      :: TaskId
-  } deriving (Generic, Show, Read, Eq, NFData)
+  } deriving (Generic, Typeable, Show, Read, Eq, NFData)
 
 
 data Model = Model
@@ -64,7 +65,7 @@ data Model = Model
   , editing    :: Maybe TaskId
   , visibility :: Visibility
   , current    :: Description
-  } deriving (Generic, Show, Read, Eq, NFData)
+  } deriving (Generic, Typeable, Show, Read, Eq, NFData)
 
 
 emptyModel :: Model
@@ -129,11 +130,11 @@ htmlIfTasks :: Model -> [Html m a] -> [Html m a]
 htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
 
 
-taskView :: Applicative m => Model -> Task -> Html m Model
-taskView m = memo $ \(Task (Description d) c tid) ->
+taskView :: Applicative m => Maybe TaskId -> Task -> Html m Model
+taskView = memo $ \currentEdit (Task (Description d) c tid) ->
   li [ id' . pack . show $ unTaskId tid
      , class' [ ("completed", c == Complete)
-              , ("editing", Just tid == editing m)
+              , ("editing", Just tid == currentEdit)
               ]
      ]
   [ div "view"
@@ -187,7 +188,7 @@ newTaskForm model = form [ class' "todo-form", onSubmit appendItem ]
 
 
 todoList :: Applicative m => Model -> Html m Model
-todoList model = ul "todo-list" $ taskView model <$> visibility model `toVisible` tasks model
+todoList model = ul "todo-list" $ taskView (editing model) <$> visibility model `toVisible` tasks model
 
 
 toggleAllBtn :: Applicative m => [Html m Model]
@@ -216,7 +217,7 @@ app = do
   initial <- readTVarIO model
   addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
   addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
-  shpadoinkle id runSnabbdom initial model view stage
+  shpadoinkle id runParDiff initial model view stage
 
 
 main :: IO ()
diff --git a/examples/package.yaml b/examples/package.yaml
index 82684227..710f5193 100644
--- a/examples/package.yaml
+++ b/examples/package.yaml
@@ -58,6 +58,7 @@ executables:
       - Shpadoinkle-html
       - Shpadoinkle-lens
       - Shpadoinkle-backend-snabbdom
+      - Shpadoinkle-backend-pardiff
 
   lens:
     main: Lens.hs
diff --git a/html/Shpadoinkle/Html/Memo.hs b/html/Shpadoinkle/Html/Memo.hs
index 713e98e4..d72b2788 100644
--- a/html/Shpadoinkle/Html/Memo.hs
+++ b/html/Shpadoinkle/Html/Memo.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ExplicitForAll    #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
@@ -16,34 +17,40 @@ module Shpadoinkle.Html.Memo (
   Memo (..)
   -- * Uniadic
   , memo1,  memo2,  memo3,  memo4,  memo5,  memo6,  memo7,  memo8,  memo9
-  -- * Custom Equality
+  -- * Custom Deuality
   , memo1', memo2', memo3', memo4', memo5', memo6', memo7', memo8', memo9'
   ) where
 
 
 import           Data.IORef
+import           Data.Typeable
+import           Shpadoinkle      (Html, depending)
 import           System.IO.Unsafe
 
 
+
+type De a = (Eq a, Typeable a, Show a)
+
+
 {-|
    Variadic ditzy memoizer that only recalls at most one thing.
 
    prop> memo = id
 -}
 class Memo f where memo :: f -> f
-instance                   Eq a                                                  => Memo (a -> b)                                         where memo = memo1
-instance {-# OVERLAPS #-} (Eq a, Eq b)                                           => Memo (a -> b -> c)                                    where memo = memo2
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c)                                     => Memo (a -> b -> c -> d)                               where memo = memo3
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d)                               => Memo (a -> b -> c -> d -> e)                          where memo = memo4
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d, Eq e)                         => Memo (a -> b -> c -> d -> e -> f)                     where memo = memo5
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f)                   => Memo (a -> b -> c -> d -> e -> f -> g)                where memo = memo6
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)             => Memo (a -> b -> c -> d -> e -> f -> g -> h)           where memo = memo7
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h)       => Memo (a -> b -> c -> d -> e -> f -> g -> h -> i)      where memo = memo8
-instance {-# OVERLAPS #-} (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g, Eq h, Eq i) => Memo (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) where memo = memo9
+instance                   De a                                                  => Memo (a -> Html m b)                                         where memo = memo1
+instance {-# OVERLAPS #-} (De a, De b)                                           => Memo (a -> b -> Html m c)                                    where memo = memo2
+instance {-# OVERLAPS #-} (De a, De b, De c)                                     => Memo (a -> b -> c -> Html m d)                               where memo = memo3
+instance {-# OVERLAPS #-} (De a, De b, De c, De d)                               => Memo (a -> b -> c -> d -> Html m e)                          where memo = memo4
+instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e)                         => Memo (a -> b -> c -> d -> e -> Html m f)                     where memo = memo5
+instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f)                   => Memo (a -> b -> c -> d -> e -> f -> Html m g)                where memo = memo6
+instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g)             => Memo (a -> b -> c -> d -> e -> f -> g -> Html m h)           where memo = memo7
+instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g, De h)       => Memo (a -> b -> c -> d -> e -> f -> g -> h -> Html m i)      where memo = memo8
+instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g, De h, De i) => Memo (a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j) where memo = memo9
 
 memo1' e f a = unsafePerformIO $ do
-  r <- newIORef (a, f a)
-  return $ applyEq e f r a
+  r <- newIORef (a, depending f a)
+  return $ applyDe e f r a
 memo2' e f a b               = memo1' e (uncurry  f) (a,b)
 memo3' e f a b c             = memo1' e (uncurry2 f) (a,b,c)
 memo4' e f a b c d           = memo1' e (uncurry3 f) (a,b,c,d)
@@ -53,15 +60,15 @@ memo7' e f a b c d g h i     = memo1' e (uncurry6 f) (a,b,c,d,g,h,i)
 memo8' e f a b c d g h i j   = memo1' e (uncurry7 f) (a,b,c,d,g,h,i,j)
 memo9' e f a b c d g h i j k = memo1' e (uncurry8 f) (a,b,c,d,g,h,i,j,k)
 
-memo1 :: Eq a =>                                                                 (a -> b)                                         -> a -> b
-memo2 :: Eq a => Eq b =>                                                         (a -> b -> c)                                    -> a -> b -> c
-memo3 :: Eq a => Eq b => Eq c =>                                                 (a -> b -> c -> d)                               -> a -> b -> c -> d
-memo4 :: Eq a => Eq b => Eq c => Eq d =>                                         (a -> b -> c -> d -> e)                          -> a -> b -> c -> d -> e
-memo5 :: Eq a => Eq b => Eq c => Eq d => Eq e =>                                 (a -> b -> c -> d -> e -> f)                     -> a -> b -> c -> d -> e -> f
-memo6 :: Eq a => Eq b => Eq c => Eq d => Eq e => Eq f =>                         (a -> b -> c -> d -> e -> f -> g)                -> a -> b -> c -> d -> e -> f -> g
-memo7 :: Eq a => Eq b => Eq c => Eq d => Eq e => Eq f => Eq g =>                 (a -> b -> c -> d -> e -> f -> g -> h)           -> a -> b -> c -> d -> e -> f -> g -> h
-memo8 :: Eq a => Eq b => Eq c => Eq d => Eq e => Eq f => Eq g => Eq h =>         (a -> b -> c -> d -> e -> f -> g -> h -> i)      -> a -> b -> c -> d -> e -> f -> g -> h -> i
-memo9 :: Eq a => Eq b => Eq c => Eq d => Eq e => Eq f => Eq g => Eq h => Eq i => (a -> b -> c -> d -> e -> f -> g -> h -> i -> j) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> j
+memo1 :: De a =>                                                                 (a -> Html m b)                                         -> a -> Html m b
+memo2 :: De a => De b =>                                                         (a -> b -> Html m c)                                    -> a -> b -> Html m c
+memo3 :: De a => De b => De c =>                                                 (a -> b -> c -> Html m d)                               -> a -> b -> c -> Html m d
+memo4 :: De a => De b => De c => De d =>                                         (a -> b -> c -> d -> Html m e)                          -> a -> b -> c -> d -> Html m e
+memo5 :: De a => De b => De c => De d => De e =>                                 (a -> b -> c -> d -> e -> Html m f)                     -> a -> b -> c -> d -> e -> Html m f
+memo6 :: De a => De b => De c => De d => De e => De f =>                         (a -> b -> c -> d -> e -> f -> Html m g)                -> a -> b -> c -> d -> e -> f -> Html m g
+memo7 :: De a => De b => De c => De d => De e => De f => De g =>                 (a -> b -> c -> d -> e -> f -> g -> Html m h)           -> a -> b -> c -> d -> e -> f -> g -> Html m h
+memo8 :: De a => De b => De c => De d => De e => De f => De g => De h =>         (a -> b -> c -> d -> e -> f -> g -> h -> Html m i)      -> a -> b -> c -> d -> e -> f -> g -> h -> Html m i
+memo9 :: De a => De b => De c => De d => De e => De f => De g => De h => De i => (a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j
 
 memo1 = memo1' (/=)
 memo2 = memo2' (/=)
@@ -81,8 +88,8 @@ uncurry6 f (a,b,c,d,e,g,h)     = f a b c d e g h
 uncurry7 f (a,b,c,d,e,g,h,i)   = f a b c d e g h i
 uncurry8 f (a,b,c,d,e,g,h,i,j) = f a b c d e g h i j
 
-applyEq :: (a -> a -> Bool) -> (a -> b) -> IORef (a, b) -> a -> b
-applyEq e f r a = unsafePerformIO $ do
+applyDe :: (a -> a -> Bool) -> (a -> b) -> IORef (a, b) -> a -> b
+applyDe e f r a = unsafePerformIO $ do
   (a', b) <- readIORef r
   if not $ e a' a then return b else do
     let b' = f a
-- 
GitLab


From e04f8633c913ae4f8bc1b8538adc997ddfab9742 Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 15:33:41 -0700
Subject: [PATCH 3/9] depending

---
 .../pardiff/Shpadoinkle/Backend/ParDiff.hs    | 65 +++++++------------
 backends/pardiff/package.yaml                 |  1 +
 examples/TODOMVC.hs                           |  9 ++-
 3 files changed, 30 insertions(+), 45 deletions(-)

diff --git a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
index 9f625333..b27bbec9 100644
--- a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
+++ b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
@@ -11,6 +11,7 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
@@ -45,7 +46,6 @@ module Shpadoinkle.Backend.ParDiff
 
 
 import           Control.Applicative         (Alternative)
-import           Control.Compactable         (traverseMaybe)
 import           Control.Monad               (forM_, void, when)
 import           Control.Monad.Base          (MonadBase (..), liftBaseDefault)
 import           Control.Monad.Catch         (MonadCatch, MonadThrow)
@@ -189,12 +189,12 @@ setListener i m o k = do
   unsafeSetProp ("on" <> k) f o
 
 
-getRaw :: ParVNode a -> Maybe (Once JSM RawNode)
+getRaw :: ParVNode a -> Once JSM RawNode
 getRaw = \case
-  ParNode mk _ _ _ -> Just mk
-  ParPotato mk     -> Just mk
-  ParTextNode mk _ -> Just mk
-  ParDepend _ _    -> Nothing
+  ParNode mk _ _ _ -> mk
+  ParPotato mk     -> mk
+  ParTextNode mk _ -> mk
+  ParDepend _ h    -> getRaw h
 
 
 makeProp :: Monad m => (m ~> JSM) -> TVar a -> Prop (ParDiffT a m) a -> ParVProp a
@@ -300,20 +300,15 @@ patchChildren
   => NFData a
   => RawNode -> [ParVNode a] -> [ParVNode a] -> ParDiffT a m [ParVNode a]
 patchChildren (RawNode p) [] new = liftJSM $ do
-  forM_ new $ \newChild ->
-      case getRaw newChild of
-        Nothing -> pure ()
-        Just ronce -> do
-          RawNode cRaw <- runOnce ronce
-          _ <- p # "appendChild" $ cRaw
-          pure ()
+  forM_ new $ \newChild -> do
+    RawNode cRaw <- runOnce $ getRaw newChild
+    _ <- p # "appendChild" $ cRaw
+    pure ()
   pure new
 patchChildren _ old [] = liftJSM $ do
   doc <- jsg "document"
   tmp <- doc # "createElement" $ "div"
-  old' :: [JSVal] <- traverseMaybe (\x -> case getRaw x of
-     Just once -> Just . unRawNode <$> runOnce once
-     Nothing   -> pure Nothing) old
+  old' :: [JSVal] <- traverse (fmap unRawNode . runOnce . getRaw) old
   void (tmp # "replaceChildren" $ old')
   void (tmp # "remove" $ ())
   pure []
@@ -356,7 +351,8 @@ patch' parent old new = do
         return $ ParNode raw name ps' cs''
 
     (ParDepend dep html, ParDepend dep' _)
-      | dep == dep' -> pure $ ParDepend dep html
+      | dep == dep' -> do
+        pure $ ParDepend dep html
 
     (ParDepend _ html, ParDepend _ html') ->
       patch' parent html html'
@@ -364,13 +360,10 @@ patch' parent old new = do
     -- node definitely has changed
     _ -> liftJSM $ do
         let RawNode p = parent
-        case (,) <$> getRaw old <*> getRaw new of
-          Nothing -> return new
-          Just (mold, mnew) -> do
-            RawNode r <- runOnce mold
-            RawNode c <- runOnce mnew
-            _ <- p # "replaceChild" $ (c, r)
-            return new
+        RawNode r <- runOnce $ getRaw old
+        RawNode c <- runOnce $ getRaw new
+        _ <- p # "replaceChild" $ (c, r)
+        return new
 
 
 interpret'
@@ -388,12 +381,9 @@ interpret' toJSM (Html h') = h' mkNode mkDep mkPotato mkText
         doc <- jsg "document"
         raw' <- doc # "createElement" $ name
         props toJSM i ps (RawNode raw')
-        forM_ cs' $ \c -> case getRaw c of
-          Nothing -> pure ()
-          Just monce -> do
-            RawNode cRaw <- runOnce monce
-            _ <- raw' # "appendChild" $ cRaw
-            pure ()
+        forM_ cs' $ \c -> do
+            RawNode cRaw <- runOnce $ getRaw c
+            raw' # "appendChild" $ cRaw
         return (RawNode raw')
 
       let p = Props (makeProp toJSM i <$> getProps ps)
@@ -424,16 +414,11 @@ instance
   setup = setup'
   patch parent mOld new = case mOld of
     -- first patch
-    Nothing ->
-      liftJSM $ do
-        let RawNode p = parent
-        case getRaw new of
-          Nothing -> pure ()
-          Just monce -> do
-            RawNode c <- runOnce monce
-            _ <- p # "appendChild" $ c
-            pure ()
-        return new
+    Nothing -> liftJSM $ do
+      let RawNode p = parent
+      RawNode c <- runOnce $ getRaw new
+      _ <- p # "appendChild" $ c
+      return new
     Just old -> patch' parent old new
 
 
diff --git a/backends/pardiff/package.yaml b/backends/pardiff/package.yaml
index 9a9ccd74..14fd3fe9 100644
--- a/backends/pardiff/package.yaml
+++ b/backends/pardiff/package.yaml
@@ -52,6 +52,7 @@ library:
     - transformers-base    >= 0.4.5 && < 0.5
 
     - Shpadoinkle
+    - Shpadoinkle-console
 
 
 git: https://gitlab.com/fresheyeball/Shpadoinkle.git
diff --git a/examples/TODOMVC.hs b/examples/TODOMVC.hs
index 2b0cdf5e..46267bf5 100644
--- a/examples/TODOMVC.hs
+++ b/examples/TODOMVC.hs
@@ -18,8 +18,8 @@ import           Data.Text                     hiding (count, filter, length)
 import           Data.Typeable                 (Typeable)
 import           GHC.Generics                  (Generic)
 import           Prelude                       hiding (div, unwords)
-import           Shpadoinkle                   (Html, JSM, NFData, readTVarIO,
-                                                shpadoinkle, text)
+import           Shpadoinkle                   (Html, JSM, NFData, depending,
+                                                readTVarIO, shpadoinkle, text)
 import           Shpadoinkle.Backend.ParDiff   (runParDiff, stage)
 import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 button', checked, class', div,
@@ -31,7 +31,6 @@ import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 placeholder, section, span,
                                                 strong_, type', ul, value)
 import           Shpadoinkle.Html.LocalStorage (manageLocalStorage)
-import           Shpadoinkle.Html.Memo         (memo)
 import           Shpadoinkle.Lens              (generalize)
 import           Shpadoinkle.Run               (runJSorWarp)
 
@@ -120,7 +119,7 @@ toVisible v = case v of
 
 
 filterHtml :: Applicative m => Visibility -> Visibility -> Html m Visibility
-filterHtml = memo $ \cur item -> li_
+filterHtml = curry . depending $ \(cur, item) -> li_
   [ a (href "#" : onClick (const item)
         : [class' ("selected", cur == item)]) [ text . pack $ show item ]
   ]
@@ -131,7 +130,7 @@ htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
 
 
 taskView :: Applicative m => Maybe TaskId -> Task -> Html m Model
-taskView = memo $ \currentEdit (Task (Description d) c tid) ->
+taskView = curry . depending $ \(currentEdit, (Task (Description d) c tid)) ->
   li [ id' . pack . show $ unTaskId tid
      , class' [ ("completed", c == Complete)
               , ("editing", Just tid == currentEdit)
-- 
GitLab


From 74e1c4588c68fe26d4f812f5b13cca607e2bea3b Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 15:35:10 -0700
Subject: [PATCH 4/9] lint

---
 backends/pardiff/Shpadoinkle/Backend/ParDiff.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
index b27bbec9..6648f2ad 100644
--- a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
+++ b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
@@ -11,7 +11,6 @@
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE RankNTypes                 #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
-- 
GitLab


From fe86490dce3540fee8d6b6af36228c134c64e37f Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 15:41:31 -0700
Subject: [PATCH 5/9] lint

---
 examples/TODOMVC.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/examples/TODOMVC.hs b/examples/TODOMVC.hs
index 46267bf5..1b6b808a 100644
--- a/examples/TODOMVC.hs
+++ b/examples/TODOMVC.hs
@@ -130,7 +130,7 @@ htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
 
 
 taskView :: Applicative m => Maybe TaskId -> Task -> Html m Model
-taskView = curry . depending $ \(currentEdit, (Task (Description d) c tid)) ->
+taskView = curry . depending $ \(currentEdit, Task (Description d) c tid) ->
   li [ id' . pack . show $ unTaskId tid
      , class' [ ("completed", c == Complete)
               , ("editing", Just tid == currentEdit)
-- 
GitLab


From 18f64142af645e5cd94f650f64dee301df715816 Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 15:55:48 -0700
Subject: [PATCH 6/9] typo fix

---
 html/Shpadoinkle/Html/Memo.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/html/Shpadoinkle/Html/Memo.hs b/html/Shpadoinkle/Html/Memo.hs
index d72b2788..9e069954 100644
--- a/html/Shpadoinkle/Html/Memo.hs
+++ b/html/Shpadoinkle/Html/Memo.hs
@@ -17,7 +17,7 @@ module Shpadoinkle.Html.Memo (
   Memo (..)
   -- * Uniadic
   , memo1,  memo2,  memo3,  memo4,  memo5,  memo6,  memo7,  memo8,  memo9
-  -- * Custom Deuality
+  -- * Custom Equality
   , memo1', memo2', memo3', memo4', memo5', memo6', memo7', memo8', memo9'
   ) where
 
@@ -50,7 +50,7 @@ instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g, De h, De i)
 
 memo1' e f a = unsafePerformIO $ do
   r <- newIORef (a, depending f a)
-  return $ applyDe e f r a
+  return $ applyEq e f r a
 memo2' e f a b               = memo1' e (uncurry  f) (a,b)
 memo3' e f a b c             = memo1' e (uncurry2 f) (a,b,c)
 memo4' e f a b c d           = memo1' e (uncurry3 f) (a,b,c,d)
@@ -88,8 +88,8 @@ uncurry6 f (a,b,c,d,e,g,h)     = f a b c d e g h
 uncurry7 f (a,b,c,d,e,g,h,i)   = f a b c d e g h i
 uncurry8 f (a,b,c,d,e,g,h,i,j) = f a b c d e g h i j
 
-applyDe :: (a -> a -> Bool) -> (a -> b) -> IORef (a, b) -> a -> b
-applyDe e f r a = unsafePerformIO $ do
+applyEq :: (a -> a -> Bool) -> (a -> b) -> IORef (a, b) -> a -> b
+applyEq e f r a = unsafePerformIO $ do
   (a', b) <- readIORef r
   if not $ e a' a then return b else do
     let b' = f a
-- 
GitLab


From 784e52d68b064cc28fb3a2622b2aefc7e93bc3d4 Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sat, 27 Feb 2021 17:02:10 -0700
Subject: [PATCH 7/9] fix memo

---
 .../pardiff/Shpadoinkle/Backend/ParDiff.hs    |  3 +-
 core/Shpadoinkle/Core.hs                      | 18 ++++++++
 examples/TODOMVC.hs                           |  9 ++--
 html/Shpadoinkle/Html/Memo.hs                 | 45 +++++++++----------
 4 files changed, 46 insertions(+), 29 deletions(-)

diff --git a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
index 6648f2ad..abf36c48 100644
--- a/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
+++ b/backends/pardiff/Shpadoinkle/Backend/ParDiff.hs
@@ -350,8 +350,7 @@ patch' parent old new = do
         return $ ParNode raw name ps' cs''
 
     (ParDepend dep html, ParDepend dep' _)
-      | dep == dep' -> do
-        pure $ ParDepend dep html
+      | dep == dep' -> pure $ ParDepend dep html
 
     (ParDepend _ html, ParDepend _ html') ->
       patch' parent html html'
diff --git a/core/Shpadoinkle/Core.hs b/core/Shpadoinkle/Core.hs
index 19916397..d6b8abd5 100644
--- a/core/Shpadoinkle/Core.hs
+++ b/core/Shpadoinkle/Core.hs
@@ -97,6 +97,14 @@ newtype Html m a = Html
   }
 
 
+instance Show (Html m a) where
+  show (Html h') = h'
+    (\t ps cs -> "Node " ++ show t ++ " " ++ show ps ++ " " ++ show cs)
+    (\d r -> "Depend (" ++ show d ++ ") (" ++ r ++ ")")
+    (const "Potato _")
+    show
+
+
 -- | 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
@@ -123,6 +131,15 @@ data Prop :: (Type -> Type) -> Type -> Type where
   PListener :: (RawNode -> RawEvent -> JSM (Continuation m a)) -> Prop m a
 
 
+instance Show (Prop m a) where
+  show = \case
+    PData _     -> "PData _"
+    PText t     -> "PText " ++ show t
+    PFlag b     -> "PFlag " ++ show b
+    PPotato _   -> "PPotato _"
+    PListener _ -> "PListener _"
+
+
 instance Eq (Prop m a) where
   x == y = case (x,y) of
     (PText x', PText y') -> x' == y'
@@ -141,6 +158,7 @@ listenM_ k = listenC k . causes
 
 
 newtype Props m a = Props { getProps :: Map Text (Prop m a) }
+  deriving Show
 
 
 toProps :: Applicative m => [(Text, Prop m a)] -> Props m a
diff --git a/examples/TODOMVC.hs b/examples/TODOMVC.hs
index 1b6b808a..2b0cdf5e 100644
--- a/examples/TODOMVC.hs
+++ b/examples/TODOMVC.hs
@@ -18,8 +18,8 @@ import           Data.Text                     hiding (count, filter, length)
 import           Data.Typeable                 (Typeable)
 import           GHC.Generics                  (Generic)
 import           Prelude                       hiding (div, unwords)
-import           Shpadoinkle                   (Html, JSM, NFData, depending,
-                                                readTVarIO, shpadoinkle, text)
+import           Shpadoinkle                   (Html, JSM, NFData, readTVarIO,
+                                                shpadoinkle, text)
 import           Shpadoinkle.Backend.ParDiff   (runParDiff, stage)
 import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 button', checked, class', div,
@@ -31,6 +31,7 @@ import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 placeholder, section, span,
                                                 strong_, type', ul, value)
 import           Shpadoinkle.Html.LocalStorage (manageLocalStorage)
+import           Shpadoinkle.Html.Memo         (memo)
 import           Shpadoinkle.Lens              (generalize)
 import           Shpadoinkle.Run               (runJSorWarp)
 
@@ -119,7 +120,7 @@ toVisible v = case v of
 
 
 filterHtml :: Applicative m => Visibility -> Visibility -> Html m Visibility
-filterHtml = curry . depending $ \(cur, item) -> li_
+filterHtml = memo $ \cur item -> li_
   [ a (href "#" : onClick (const item)
         : [class' ("selected", cur == item)]) [ text . pack $ show item ]
   ]
@@ -130,7 +131,7 @@ htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
 
 
 taskView :: Applicative m => Maybe TaskId -> Task -> Html m Model
-taskView = curry . depending $ \(currentEdit, Task (Description d) c tid) ->
+taskView = memo $ \currentEdit (Task (Description d) c tid) ->
   li [ id' . pack . show $ unTaskId tid
      , class' [ ("completed", c == Complete)
               , ("editing", Just tid == currentEdit)
diff --git a/html/Shpadoinkle/Html/Memo.hs b/html/Shpadoinkle/Html/Memo.hs
index 9e069954..8a6c8c02 100644
--- a/html/Shpadoinkle/Html/Memo.hs
+++ b/html/Shpadoinkle/Html/Memo.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE ConstraintKinds   #-}
 {-# LANGUAGE ExplicitForAll    #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 
@@ -22,10 +23,10 @@ module Shpadoinkle.Html.Memo (
   ) where
 
 
-import           Data.IORef
-import           Data.Typeable
+import           Data.IORef       (IORef, newIORef, readIORef, writeIORef)
+import           Data.Typeable    (Typeable)
 import           Shpadoinkle      (Html, depending)
-import           System.IO.Unsafe
+import           System.IO.Unsafe (unsafePerformIO)
 
 
 
@@ -48,9 +49,10 @@ instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g)
 instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g, De h)       => Memo (a -> b -> c -> d -> e -> f -> g -> h -> Html m i)      where memo = memo8
 instance {-# OVERLAPS #-} (De a, De b, De c, De d, De e, De f, De g, De h, De i) => Memo (a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j) where memo = memo9
 
-memo1' e f a = unsafePerformIO $ do
-  r <- newIORef (a, depending f a)
-  return $ applyEq e f r a
+memo1' e f = unsafePerformIO $ do
+  r <- newIORef Nothing
+  return $ applyEq e f r
+{-# NOINLINE memo1' #-}
 memo2' e f a b               = memo1' e (uncurry  f) (a,b)
 memo3' e f a b c             = memo1' e (uncurry2 f) (a,b,c)
 memo4' e f a b c d           = memo1' e (uncurry3 f) (a,b,c,d)
@@ -70,15 +72,15 @@ memo7 :: De a => De b => De c => De d => De e => De f => De g =>
 memo8 :: De a => De b => De c => De d => De e => De f => De g => De h =>         (a -> b -> c -> d -> e -> f -> g -> h -> Html m i)      -> a -> b -> c -> d -> e -> f -> g -> h -> Html m i
 memo9 :: De a => De b => De c => De d => De e => De f => De g => De h => De i => (a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j) -> a -> b -> c -> d -> e -> f -> g -> h -> i -> Html m j
 
-memo1 = memo1' (/=)
-memo2 = memo2' (/=)
-memo3 = memo3' (/=)
-memo4 = memo4' (/=)
-memo5 = memo5' (/=)
-memo6 = memo6' (/=)
-memo7 = memo7' (/=)
-memo8 = memo8' (/=)
-memo9 = memo9' (/=)
+memo1 = memo1' (==)
+memo2 = memo2' (==)
+memo3 = memo3' (==)
+memo4 = memo4' (==)
+memo5 = memo5' (==)
+memo6 = memo6' (==)
+memo7 = memo7' (==)
+memo8 = memo8' (==)
+memo9 = memo9' (==)
 
 uncurry2 f (a,b,c)             = f a b c
 uncurry3 f (a,b,c,d)           = f a b c d
@@ -88,11 +90,8 @@ uncurry6 f (a,b,c,d,e,g,h)     = f a b c d e g h
 uncurry7 f (a,b,c,d,e,g,h,i)   = f a b c d e g h i
 uncurry8 f (a,b,c,d,e,g,h,i,j) = f a b c d e g h i j
 
-applyEq :: (a -> a -> Bool) -> (a -> b) -> IORef (a, b) -> a -> b
-applyEq e f r a = unsafePerformIO $ do
-  (a', b) <- readIORef r
-  if not $ e a' a then return b else do
-    let b' = f a
-    writeIORef r (a', b')
-    return b'
-
+applyEq :: (Typeable a, Eq a, Show a) => (a -> a -> Bool) -> (a -> Html m b) -> IORef (Maybe (a, Html m b)) -> a -> Html m b
+applyEq e f r a = unsafePerformIO $ readIORef r >>= \case
+  Just (a', b) | e a' a -> return b
+  _ -> let b = depending f a in b <$ writeIORef r (Just (a, b))
+{-# NOINLINE applyEq #-}
-- 
GitLab


From 2b0a6e81bdf5dea576b72c298da0bc6e0e3158ab Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Sun, 28 Feb 2021 12:03:31 -0700
Subject: [PATCH 8/9] wakadoo

---
 backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs | 10 +++++++++-
 backends/snabbdom/package.yaml                    |  2 ++
 examples/TODOMVC.hs                               | 14 +++++++-------
 html/Shpadoinkle/Html/Memo.hs                     |  4 ++--
 html/package.yaml                                 |  1 +
 5 files changed, 21 insertions(+), 10 deletions(-)

diff --git a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
index 31710c73..71d72503 100644
--- a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
+++ b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
@@ -47,6 +47,8 @@ import           GHCJS.DOM                   (currentDocumentUnchecked)
 import           GHCJS.DOM.Document          (createElement, getBodyUnsafe)
 import           GHCJS.DOM.Element           (setAttribute)
 import           GHCJS.DOM.Node              (appendChild)
+import           GHCJS.Foreign.Export
+import           GHCJS.Types                 (jsval)
 import           Language.Javascript.JSaddle hiding (JSM, MonadJSM, liftJSM,
                                               (#))
 import           Prelude                     hiding (id, (.))
@@ -56,6 +58,7 @@ import           UnliftIO                    (MonadUnliftIO (..), TVar,
 import           UnliftIO.Concurrent         (forkIO)
 
 import           Shpadoinkle
+import qualified Shpadoinkle.Console         as Console
 
 
 default (Text)
@@ -186,7 +189,12 @@ instance (MonadJSM m, NFData a) => Backend (SnabbdomT a) m a where
         o <- props toJSM i $ fromProps ps
         jsg3 "vnode" name o cs >>= fromJSValUnchecked)
 
-    (const id)
+    (\dep html -> do
+      exp' <- liftJSM $ export dep
+      let jsv :: JSVal = jsval exp'
+      Console.log @ToJSVal jsv
+      html
+    )
 
     (\mrn -> liftJSM $ do
       o <- create
diff --git a/backends/snabbdom/package.yaml b/backends/snabbdom/package.yaml
index 22680ef2..ee23eac5 100644
--- a/backends/snabbdom/package.yaml
+++ b/backends/snabbdom/package.yaml
@@ -44,12 +44,14 @@ library:
     - exceptions
     - transformers-base
     - monad-control
+    - ghcjs-base
 
     - mtl        >= 2.2.2 && < 2.3
     - unliftio   >= 0.2.12 && < 0.3
     - file-embed >= 0.0.11 && < 0.1
 
     - Shpadoinkle
+    - Shpadoinkle-console
 
 
 git: https://gitlab.com/fresheyeball/Shpadoinkle.git
diff --git a/examples/TODOMVC.hs b/examples/TODOMVC.hs
index 2b0cdf5e..1cd43e9b 100644
--- a/examples/TODOMVC.hs
+++ b/examples/TODOMVC.hs
@@ -18,9 +18,10 @@ import           Data.Text                     hiding (count, filter, length)
 import           Data.Typeable                 (Typeable)
 import           GHC.Generics                  (Generic)
 import           Prelude                       hiding (div, unwords)
-import           Shpadoinkle                   (Html, JSM, NFData, readTVarIO,
-                                                shpadoinkle, text)
-import           Shpadoinkle.Backend.ParDiff   (runParDiff, stage)
+import           Shpadoinkle                   (Html, JSM, NFData, depending,
+                                                readTVarIO, shpadoinkle, text)
+-- import           Shpadoinkle.Backend.ParDiff   (runParDiff, stage)
+import           Shpadoinkle.Backend.Snabbdom  (runSnabbdom, stage)
 import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 button', checked, class', div,
                                                 div_, footer, for', form, h1_,
@@ -31,7 +32,6 @@ import           Shpadoinkle.Html              (a, addStyle, autofocus, button,
                                                 placeholder, section, span,
                                                 strong_, type', ul, value)
 import           Shpadoinkle.Html.LocalStorage (manageLocalStorage)
-import           Shpadoinkle.Html.Memo         (memo)
 import           Shpadoinkle.Lens              (generalize)
 import           Shpadoinkle.Run               (runJSorWarp)
 
@@ -120,7 +120,7 @@ toVisible v = case v of
 
 
 filterHtml :: Applicative m => Visibility -> Visibility -> Html m Visibility
-filterHtml = memo $ \cur item -> li_
+filterHtml = curry . depending $ \(cur, item) -> li_
   [ a (href "#" : onClick (const item)
         : [class' ("selected", cur == item)]) [ text . pack $ show item ]
   ]
@@ -131,7 +131,7 @@ htmlIfTasks m h' = if Prelude.null (tasks m) then [] else h'
 
 
 taskView :: Applicative m => Maybe TaskId -> Task -> Html m Model
-taskView = memo $ \currentEdit (Task (Description d) c tid) ->
+taskView = curry . depending $ \(currentEdit, Task (Description d) c tid) ->
   li [ id' . pack . show $ unTaskId tid
      , class' [ ("completed", c == Complete)
               , ("editing", Just tid == currentEdit)
@@ -217,7 +217,7 @@ app = do
   initial <- readTVarIO model
   addStyle "https://cdn.jsdelivr.net/npm/todomvc-common@1.0.5/base.css"
   addStyle "https://cdn.jsdelivr.net/npm/todomvc-app-css@2.2.0/index.css"
-  shpadoinkle id runParDiff initial model view stage
+  shpadoinkle id runSnabbdom initial model view stage
 
 
 main :: IO ()
diff --git a/html/Shpadoinkle/Html/Memo.hs b/html/Shpadoinkle/Html/Memo.hs
index 8a6c8c02..adf787df 100644
--- a/html/Shpadoinkle/Html/Memo.hs
+++ b/html/Shpadoinkle/Html/Memo.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE ExplicitForAll    #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase        #-}
+{-# LANGUAGE TypeApplications  #-}
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
 
 
@@ -29,7 +30,6 @@ import           Shpadoinkle      (Html, depending)
 import           System.IO.Unsafe (unsafePerformIO)
 
 
-
 type De a = (Eq a, Typeable a, Show a)
 
 
@@ -92,6 +92,6 @@ uncurry8 f (a,b,c,d,e,g,h,i,j) = f a b c d e g h i j
 
 applyEq :: (Typeable a, Eq a, Show a) => (a -> a -> Bool) -> (a -> Html m b) -> IORef (Maybe (a, Html m b)) -> a -> Html m b
 applyEq e f r a = unsafePerformIO $ readIORef r >>= \case
-  Just (a', b) | e a' a -> return b
+  Just (a', b) | e a' a -> pure b
   _ -> let b = depending f a in b <$ writeIORef r (Just (a, b))
 {-# NOINLINE applyEq #-}
diff --git a/html/package.yaml b/html/package.yaml
index 842f3599..512099ad 100644
--- a/html/package.yaml
+++ b/html/package.yaml
@@ -46,6 +46,7 @@ dependencies:
     - lens
 
     - Shpadoinkle
+    - Shpadoinkle-console
 
 
 when:
-- 
GitLab


From 70b839adaef4c28a42752071e5d89b0a2e5b01c2 Mon Sep 17 00:00:00 2001
From: Isaac Shapira <fresheyeball@protonmail.com>
Date: Mon, 1 Mar 2021 15:24:25 -0700
Subject: [PATCH 9/9]  hell

---
 .../snabbdom/Shpadoinkle/Backend/Snabbdom.hs  | 162 +++++++++---------
 backends/snabbdom/package.yaml                |   2 +-
 cabal.project                                 |   1 +
 core/Shpadoinkle/Continuation.hs              |  56 ++++--
 core/Shpadoinkle/Core.hs                      |  17 +-
 default.nix                                   |   5 +-
 examples/Streaming.hs                         |  51 ++++++
 examples/package.yaml                         |  13 ++
 nix/hpackall.sh                               |   1 +
 nix/overlay-shpadoinkle.nix                   |   1 +
 nix/overlay.nix                               |   4 +-
 nix/pkgs.nix                                  |   4 +-
 streaming/LICENSE                             |  27 +++
 streaming/Setup.hs                            |   2 +
 streaming/Shpadoinkle/Streaming.hs            |  28 +++
 streaming/default.nix                         |   4 +
 streaming/package.yaml                        |  34 ++++
 17 files changed, 310 insertions(+), 102 deletions(-)
 create mode 100644 examples/Streaming.hs
 create mode 100644 streaming/LICENSE
 create mode 100644 streaming/Setup.hs
 create mode 100644 streaming/Shpadoinkle/Streaming.hs
 create mode 100644 streaming/default.nix
 create mode 100644 streaming/package.yaml

diff --git a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
index 71d72503..d740a40c 100644
--- a/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
+++ b/backends/snabbdom/Shpadoinkle/Backend/Snabbdom.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns               #-}
 {-# LANGUAGE CPP                        #-}
 {-# LANGUAGE ExtendedDefaultRules       #-}
 {-# LANGUAGE FlexibleInstances          #-}
@@ -41,24 +42,21 @@ import           Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
                                               defaultLiftBaseWith,
                                               defaultRestoreM)
 import           Data.FileEmbed              (embedStringFile)
-import           Data.Text                   (Text, split)
-import           Data.Traversable            (for)
+import           Data.Map.Internal           (Map (Bin, Tip))
+import           Data.Text                   (Text, words)
 import           GHCJS.DOM                   (currentDocumentUnchecked)
 import           GHCJS.DOM.Document          (createElement, getBodyUnsafe)
 import           GHCJS.DOM.Element           (setAttribute)
 import           GHCJS.DOM.Node              (appendChild)
-import           GHCJS.Foreign.Export
-import           GHCJS.Types                 (jsval)
 import           Language.Javascript.JSaddle hiding (JSM, MonadJSM, liftJSM,
                                               (#))
-import           Prelude                     hiding (id, (.))
+import           Prelude                     hiding (id, words, (.))
 import           UnliftIO                    (MonadUnliftIO (..), TVar,
                                               UnliftIO (UnliftIO, unliftIO),
                                               withUnliftIO)
 import           UnliftIO.Concurrent         (forkIO)
 
 import           Shpadoinkle
-import qualified Shpadoinkle.Console         as Console
 
 
 default (Text)
@@ -115,54 +113,67 @@ runSnabbdom :: TVar model -> SnabbdomT model m ~> m
 runSnabbdom t (Snabbdom r) = runReaderT r t
 
 
-props :: Monad m => NFData a => (m ~> JSM) -> TVar a -> [(Text, Prop (SnabbdomT a m) a)] -> JSM Object
-props toJSM i xs = do
+traverseWithKey_ :: Applicative t => (k -> a -> t ()) -> Map k a -> t ()
+traverseWithKey_ f = go
+  where
+    go Tip             = pure ()
+    go (Bin 1 k v _ _) = f k v
+    go (Bin _ k v l r) = go l *> f k v *> go r
+{-# INLINE traverseWithKey_ #-}
+
+
+props :: Monad m => NFData a => (m ~> JSM) -> TVar a -> Props (SnabbdomT a m) a -> JSM Object
+props toJSM i (Props xs) = do
   o <- create
   propsObj     <- create
   listenersObj <- create
   classesObj   <- create
   attrsObj     <- create
   hooksObj     <- create
-  void $ xs `for` \(k, p) -> case p of
-    PData d -> unsafeSetProp (toJSString k) d propsObj
-    PPotato pot -> do
-      f' <- toJSVal . fun $ \_ _ ->
-        let
-          g vnode = do
-            vnode' <- valToObject vnode
-            stm <- pot . RawNode =<< unsafeGetProp "elm" vnode'
-            let go = atomically stm >>= writeUpdate i . hoist (toJSM . runSnabbdom i)
-            void $ forkIO go
-        in \case
-          [vnode]    -> g vnode
-          [_, vnode] -> g vnode
-          _          -> return ()
-      unsafeSetProp "insert" f' hooksObj
-      unsafeSetProp "update" f' hooksObj
-
-    PText t -> do
-      t' <- toJSVal t
-      true <- toJSVal True
-      case k of
-        "className" | t /= "" -> forM_ (split (== ' ') t) $ \u ->
-          if u == mempty then pure () else unsafeSetProp (toJSString u) true classesObj
-        "style"     | t /= "" -> unsafeSetProp (toJSString k) t' attrsObj
-        "type"      | t /= "" -> unsafeSetProp (toJSString k) t' attrsObj
-        "autofocus" | t /= "" -> unsafeSetProp (toJSString k) t' attrsObj
-        _                     -> unsafeSetProp (toJSString k) t' propsObj
-
-    PListener f -> do
-      f' <- toJSVal . fun $ \_ _ -> \case
-        [] -> return ()
-        ev:_ -> do
-          rn <- unsafeGetProp "target" =<< valToObject ev
-          x <- f (RawNode rn) (RawEvent ev)
-          writeUpdate i $ hoist (toJSM . runSnabbdom i) x
-      unsafeSetProp (toJSString k) f' listenersObj
-
-    PFlag b -> do
-      f <- toJSVal b
-      unsafeSetProp (toJSString k) f propsObj
+  flip traverseWithKey_ xs $ \k p ->
+    let k' = toJSString k
+    in  case p of
+      PData d -> unsafeSetProp k' d propsObj
+      PPotato pot -> do
+        f' <- toJSVal . fun $ \_ _ ->
+          let
+            g vnode = do
+              vnode' <- valToObject vnode
+              stm <- pot . RawNode =<< unsafeGetProp "elm" vnode'
+              let go = atomically stm >>= writeUpdate i . hoist (toJSM . runSnabbdom i)
+              void $ forkIO go
+          in \case
+            [vnode]    -> g vnode
+            [_, vnode] -> g vnode
+            _          -> return ()
+        unsafeSetProp "insert" f' hooksObj
+        unsafeSetProp "update" f' hooksObj
+
+      PText t
+        | k == "className" -> forM_ (words t) $ \u ->
+            unsafeSetProp (toJSString u) jsTrue classesObj
+        | t /= "" -> do
+            t' <- valMakeText t
+            unsafeSetProp k' t' $ case k of
+              "style"     -> attrsObj
+              "type"      -> attrsObj
+              "autofocus" -> attrsObj
+              _           -> propsObj
+        | otherwise -> do
+            t' <- valMakeText t
+            unsafeSetProp k' t' propsObj
+
+      PListener f -> do
+        f' <- toJSVal . fun $ \_ _ -> \case
+          [] -> return ()
+          ev:_ -> do
+            rn <- unsafeGetProp "target" =<< valToObject ev
+            x <- f (RawNode rn) (RawEvent ev)
+            writeUpdate i $ hoist (toJSM . runSnabbdom i) x
+        unsafeSetProp k' f' listenersObj
+
+      PFlag b ->
+        unsafeSetProp k' (toJSBool b) propsObj
 
   p  <- toJSVal propsObj
   l  <- toJSVal listenersObj
@@ -181,39 +192,34 @@ instance (MonadJSM m, NFData a) => Backend (SnabbdomT a) m a where
   type VNode (SnabbdomT a) m = SnabVNode
 
   interpret :: (m ~> JSM) -> Html (SnabbdomT a m) a -> SnabbdomT a m SnabVNode
-  interpret toJSM (Html h') = h'
-
-    (\name ps children -> do
-      cs <- sequence children
-      i <- ask; liftJSM $ do
-        o <- props toJSM i $ fromProps ps
-        jsg3 "vnode" name o cs >>= fromJSValUnchecked)
-
-    (\dep html -> do
-      exp' <- liftJSM $ export dep
-      let jsv :: JSVal = jsval exp'
-      Console.log @ToJSVal jsv
-      html
-    )
-
-    (\mrn -> liftJSM $ do
-      o <- create
-      hook <- create
-      rn <- mrn
-      ins <- toJSVal =<< function (\_ _ -> \case
-        [n] -> void $ jsg2 "potato" n rn
-        _   -> return ())
-      unsafeSetProp "insert" ins hook
-      hoo <- toJSVal hook
-      unsafeSetProp "hook" hoo o
-      fromJSValUnchecked =<< jsg2 "vnode" "div" o)
-
-    (\t -> liftJSM $ fromJSValUnchecked =<< toJSVal t)
+  interpret toJSM (Html h') = h' mkNode mkDep mkPotato mkText
+    where
+      mkNode name ps children = do
+        i <- ask; liftJSM $ do
+          !o <- props toJSM i ps
+          !cs <- toJSM . runSnabbdom i $ sequence children
+          SnabVNode <$> jsg3 "vnode" name o cs
+
+      mkDep = const id
+
+      mkPotato mrn = liftJSM $ do
+        o <- create
+        hook <- create
+        rn <- mrn
+        ins <- toJSVal =<< function (\_ _ -> \case
+          [n] -> void $ jsg2 "potato" n rn
+          _   -> return ())
+        unsafeSetProp "insert" ins hook
+        hoo <- toJSVal hook
+        unsafeSetProp "hook" hoo o
+        SnabVNode <$> jsg2 "vnode" "div" o
+
+      mkText = liftJSM . fmap SnabVNode . valMakeText
 
 
   patch :: RawNode -> Maybe SnabVNode -> SnabVNode -> SnabbdomT a m SnabVNode
-  patch (RawNode r) f t = t <$ (liftJSM . void $ jsg2 "patchh" f' t)
-    where f' = maybe r unVNode f
+  patch (RawNode container) mPreviousNode newNode = liftJSM $ newNode <$ jsg2 "patchh" previousNode newNode
+    where previousNode = maybe container unVNode mPreviousNode
 
 
   setup :: JSM () -> JSM ()
diff --git a/backends/snabbdom/package.yaml b/backends/snabbdom/package.yaml
index ee23eac5..e9fccc65 100644
--- a/backends/snabbdom/package.yaml
+++ b/backends/snabbdom/package.yaml
@@ -44,7 +44,7 @@ library:
     - exceptions
     - transformers-base
     - monad-control
-    - ghcjs-base
+    - containers
 
     - mtl        >= 2.2.2 && < 2.3
     - unliftio   >= 0.2.12 && < 0.3
diff --git a/cabal.project b/cabal.project
index 29a1c6a7..a6a761b7 100644
--- a/cabal.project
+++ b/cabal.project
@@ -10,6 +10,7 @@ packages: core
         , marketing
         , html
         , router
+        , streaming
         , widgets
 
         , examples
diff --git a/core/Shpadoinkle/Continuation.hs b/core/Shpadoinkle/Continuation.hs
index 21bea3fd..4478b993 100644
--- a/core/Shpadoinkle/Continuation.hs
+++ b/core/Shpadoinkle/Continuation.hs
@@ -17,7 +17,7 @@ module Shpadoinkle.Continuation (
   -- * The Continuation Type
   Continuation (..)
   , runContinuation
-  , done, pur, impur, kleisli, causes, contIso
+  , done, pur, impur, kleisli, causes, causedBy, merge, contIso
   -- * The Class
   , Continuous (..)
   -- ** Hoist
@@ -45,6 +45,7 @@ module Shpadoinkle.Continuation (
 import           Control.Arrow                           (first)
 import qualified Control.Categorical.Functor             as F
 import           Control.DeepSeq                         (NFData (..), force)
+import           Control.Monad                           (void)
 import           Control.Monad.Trans.Class               (MonadTrans (..))
 import           Control.PseudoInverseCategory           (EndoIso (..))
 import           Data.Maybe                              (fromMaybe)
@@ -58,7 +59,6 @@ import           Language.Javascript.JSaddle             (MonadJSM)
 import           UnliftIO                                (MonadUnliftIO, TVar,
                                                           UnliftIO, askUnliftIO,
                                                           atomically, liftIO,
-                                                          modifyTVar',
                                                           newTVarIO, readTVar,
                                                           readTVarIO, unliftIO,
                                                           writeTVar)
@@ -84,6 +84,7 @@ import           UnliftIO.Concurrent                     (forkIO)
 --   finishes and they are all done atomically together.
 data Continuation m a = Continuation (a -> a, a -> m (Continuation m a))
                       | Rollback (Continuation m a)
+                      | Merge (Continuation m a)
                       | Pure (a -> a)
 
 
@@ -117,6 +118,15 @@ causes :: Applicative m => m () -> Continuation m a
 causes m = impur (id <$ m)
 
 
+causedBy :: m (Continuation m a) -> Continuation m a
+causedBy = Continuation . (id,) . const
+
+
+-- | A continuation can be forced to write its changes midflight.
+merge :: Continuation m a -> Continuation m a
+merge = Merge
+
+
 -- | 'runContinuation' takes a 'Continuation' and a state value and runs the whole Continuation
 --   as if the real state was frozen at the value given to 'runContinuation'. It performs all the
 --   IO actions in the stages of the Continuation and returns a pure state updating function
@@ -134,6 +144,7 @@ runContinuation' f (Continuation (g, h)) x = do
   i <- h (f x)
   runContinuation' (g.f) i x
 runContinuation' _ (Rollback f) x = runContinuation' id f x
+runContinuation' f (Merge g) x = runContinuation' f g x
 runContinuation' f (Pure g) _ = return (g.f)
 
 
@@ -151,13 +162,15 @@ instance Continuous Continuation where
 hoist :: Functor m => (forall b. m b -> n b) -> Continuation m a -> Continuation n a
 hoist _ (Pure f)              = Pure f
 hoist f (Rollback r)          = Rollback (hoist f r)
+hoist f (Merge g)             = Merge (hoist f g)
 hoist f (Continuation (g, h)) = Continuation . (g,) $ \x -> f $ hoist f <$> h x
 
 
 -- | Apply a lens inside a Continuation to change the Continuation's type.
 liftC' :: Functor m => (a -> b -> b) -> (b -> a) -> Continuation m a -> Continuation m b
-liftC' f g (Pure h) = Pure (\x -> f (h (g x)) x)
-liftC' f g (Rollback r) = Rollback (liftC' f g r)
+liftC' f g (Pure h)              = Pure (\x -> f (h (g x)) x)
+liftC' f g (Rollback r)          = Rollback (liftC' f g r)
+liftC' f g (Merge h)             = Merge (liftC' f g h)
 liftC' f g (Continuation (h, i)) = Continuation (\x -> f (h (g x)) x, \x -> liftC' f g <$> i (g x))
 
 
@@ -165,6 +178,7 @@ liftC' f g (Continuation (h, i)) = Continuation (\x -> f (h (g x)) x, \x -> lift
 liftCMay' :: Applicative m => (a -> b -> b) -> (b -> Maybe a) -> Continuation m a -> Continuation m b
 liftCMay' f g (Pure h)     = Pure $ \x -> maybe x (flip f x . h) $ g x
 liftCMay' f g (Rollback r) = Rollback (liftCMay' f g r)
+liftCMay' f g (Merge h)    = Merge (liftCMay' f g h)
 liftCMay' f g (Continuation (h, i)) =
   Continuation (\x -> maybe x (flip f x . h) $ g x, maybe (pure done) (fmap (liftCMay' f g) . i) . g)
 
@@ -218,8 +232,9 @@ rightC = mapC rightC'
 
 -- | Transform a Continuation to work on 'Maybe's. If it encounters 'Nothing', then it cancels itself.
 maybeC' :: Applicative m => Continuation m a -> Continuation m (Maybe a)
-maybeC' (Pure f) = Pure (fmap f)
-maybeC' (Rollback r) = Rollback (maybeC' r)
+maybeC' (Pure f)              = Pure (fmap f)
+maybeC' (Rollback r)          = Rollback (maybeC' r)
+maybeC' (Merge f)             = Merge (maybeC' f)
 maybeC' (Continuation (f, g)) = Continuation . (fmap f,) $
   \case
     Just x  -> maybeC' <$> g x
@@ -242,8 +257,9 @@ comaybe f x = fromMaybe x . f $ Just x
 --   when the input Continuation would replace the current value with 'Nothing',
 --   instead the current value is retained.
 comaybeC' :: Functor m => Continuation m (Maybe a) -> Continuation m a
-comaybeC' (Pure f) = Pure (comaybe f)
-comaybeC' (Rollback r) = Rollback (comaybeC' r)
+comaybeC' (Pure f)             = Pure (comaybe f)
+comaybeC' (Rollback r)         = Rollback (comaybeC' r)
+comaybeC' (Merge f)            = Merge (comaybeC' f)
 comaybeC' (Continuation (f,g)) = Continuation (comaybe f, fmap comaybeC' . g . Just)
 
 
@@ -275,12 +291,14 @@ eitherC' f g = Continuation . (id,) $ \case
   Left x -> case f of
     Pure h -> pure (Pure (mapLeft h))
     Rollback r -> pure . Rollback $ eitherC' r done
+    Merge h -> pure . Merge $ eitherC' h done
     Continuation (h, i) ->
       (\j -> Continuation (mapLeft h, const . pure $ eitherC' j (Rollback done)))
         <$> i x
   Right x -> case g of
     Pure h -> pure (Pure (mapRight h))
     Rollback r -> pure . Rollback $ eitherC' done r
+    Merge h -> pure . Merge $ eitherC' done h
     Continuation (h, i) ->
       (\j -> Continuation (mapRight h, const . pure $ eitherC' (Rollback done) j))
         <$> i x
@@ -300,7 +318,8 @@ eitherC _ r (Right x) = mapC (eitherC' (pur id)) (r x)
 contIso :: Functor m => (a -> b) -> (b -> a) -> Continuation m a -> Continuation m b
 contIso f g (Continuation (h, i)) = Continuation (f.h.g, fmap (contIso f g) . i . g)
 contIso f g (Rollback h) = Rollback (contIso f g h)
-contIso f g (Pure h) = Pure (f.h.g)
+contIso f g (Merge h)    = Merge (contIso f g h)
+contIso f g (Pure h)     = Pure (f.h.g)
 
 
 -- | @Continuation m@ is a Functor in the EndoIso category (where the objects
@@ -313,8 +332,9 @@ instance Applicative m => F.Functor EndoIso EndoIso (Continuation m) where
 -- | You can combine multiple Continuations homogeneously using the 'Monoid' typeclass
 --   instance. The resulting Continuation will execute all the subcontinuations in parallel,
 --   allowing them to see each other's state updates and roll back each other's updates,
---   applying all of the updates generated by all the subcontinuations atomically once
---   all of them are done.
+--   applying all of the unmerged updates generated by all the subcontinuations atomically once
+--   all of them are done. A merge in any one of the branches will cause all of
+--   the changes that branch can see to be merged.
 instance Applicative m => Semigroup (Continuation m a) where
   (Continuation (f, g)) <> (Continuation (h, i)) =
     Continuation (f.h, \x -> (<>) <$> g x <*> i x)
@@ -328,6 +348,8 @@ instance Applicative m => Semigroup (Continuation m a) where
   (Continuation (f,g)) <> (Pure h) = Continuation (f.h,g)
   (Pure f) <> (Rollback g) = Continuation (f, const (pure (Rollback g)))
   (Rollback f) <> (Pure _) = Rollback f
+  (Merge f) <> g = Merge (f <> g)
+  f <> (Merge g) = Merge (f <> g)
 
 
 -- | Since combining Continuations homogeneously is an associative operation,
@@ -342,8 +364,11 @@ writeUpdate' h model f = do
   m <- f (h i)
   case m of
     Continuation (g,gs) -> writeUpdate' (g . h) model gs
-    Pure g              -> atomically (modifyTVar' model (force . g . h))
-    Rollback gs         -> writeUpdate' id model (const (return gs))
+    Pure g -> atomically (writeTVar model . g . h =<< readTVar model)
+    Merge g -> do
+      atomically $ writeTVar model . h =<< readTVar model
+      writeUpdate' id model (const (return g))
+    Rollback gs -> writeUpdate' id model (const (return gs))
 
 
 -- | Run a Continuation on a state variable. This may update the state.
@@ -351,8 +376,9 @@ writeUpdate' h model f = do
 --   and an asynchronous, non-blocking operation for impure updates.
 writeUpdate :: MonadUnliftIO m => NFData a => TVar a -> Continuation m a -> m ()
 writeUpdate model = \case
-  Continuation (f,g) -> () <$ forkIO (writeUpdate' f model g)
-  Pure f             -> atomically (modifyTVar' model (force . f))
+  Continuation (f,g) -> void . forkIO $ writeUpdate' f model g
+  Pure f             -> atomically (writeTVar model . f =<< readTVar model)
+  Merge f            -> writeUpdate model f
   Rollback f         -> writeUpdate model f
 
 
diff --git a/core/Shpadoinkle/Core.hs b/core/Shpadoinkle/Core.hs
index d6b8abd5..a6c80655 100644
--- a/core/Shpadoinkle/Core.hs
+++ b/core/Shpadoinkle/Core.hs
@@ -510,16 +510,25 @@ shpadoinkle toJSM toM initial model view stage = do
     j :: b m ~> JSM
     j = toJSM . toM model
 
+    sview = view
+    {-# SCC sview #-}
+
+    sinterpret = interpret
+    {-# SCC sinterpret #-}
+
+    spatch = patch
+    {-# SCC spatch #-}
+
     go :: RawNode -> VNode b m -> a -> JSM (VNode b m)
     go c n a = j $ do
-      !m  <- interpret toJSM $ view a
-      patch c (Just n) m
+      !m  <- sinterpret toJSM $ sview a
+      spatch c (Just n) m
 
   setup @b @m @a $ do
     (c,n) <- j $ do
       c <- stage
-      n <- interpret toJSM $ view initial
-      _ <- patch c Nothing n
+      n <- sinterpret toJSM $ sview initial
+      _ <- spatch c Nothing n
       return (c,n)
     _ <- shouldUpdate (go c) n model
     return ()
diff --git a/default.nix b/default.nix
index 6180bb0d..153eddad 100644
--- a/default.nix
+++ b/default.nix
@@ -6,10 +6,12 @@
 , extra ? (_: b: b)
 , optimize ? true
 , system ? builtins.currentSystem
+, enableLibraryProfiling ? false
+, enableExecutableProfiling ? false
 }:
 
 let
-  pkgs = import ./nix/pkgs.nix { inherit compiler isJS system chan; };
+  pkgs = import ./nix/pkgs.nix { inherit compiler isJS system chan enableLibraryProfiling enableExecutableProfiling; };
   util = import ./nix/util.nix { inherit pkgs compiler isJS; };
 in
   with pkgs; with lib;
@@ -37,6 +39,7 @@ in
         Shpadoinkle-lens
         Shpadoinkle-html
         Shpadoinkle-router
+        Shpadoinkle-streaming
         Shpadoinkle-widgets
         Shpadoinkle-isreal
 
diff --git a/examples/Streaming.hs b/examples/Streaming.hs
new file mode 100644
index 00000000..dab99597
--- /dev/null
+++ b/examples/Streaming.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE ExtendedDefaultRules       #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE PackageImports             #-}
+
+
+module Main where
+
+
+import           Prelude                     hiding (div)
+
+import           Control.Concurrent          (threadDelay)
+import           Control.Monad.IO.Class      (MonadIO (liftIO))
+import           Data.Text                   (Text, pack)
+import           Shpadoinkle                 (Html, NFData, liftC)
+import           Shpadoinkle.Backend.ParDiff (runParDiff)
+import           Shpadoinkle.Html            (button, div, getBody, onClickC,
+                                              text)
+import           Shpadoinkle.Run             (runJSorWarp, simple)
+import           Shpadoinkle.Streaming       (consumeStream)
+import           "streaming" Streaming       (Of, Stream)
+import           Streaming.Prelude           (repeatM)
+
+default (Text)
+
+
+exampleStream :: MonadIO m => Stream (Of Int) m ()
+exampleStream = repeatM $ do
+  liftIO $ threadDelay 1000000
+  return 1
+
+
+newtype Model = Model { streamContents :: [Int] }
+  deriving (Eq, Show, NFData)
+
+
+view :: MonadIO m => Model -> Html m Model
+view (Model ns) =
+  div
+    []
+    [ text (pack (show ns))
+    , liftC (\c m -> m { streamContents = c }) streamContents $
+      button
+        [ onClickC (consumeStream exampleStream (return . (:))) ]
+        [ text "Go" ]
+    ]
+
+
+main :: IO ()
+main = runJSorWarp 8080 $
+  simple runParDiff (Model []) view getBody
diff --git a/examples/package.yaml b/examples/package.yaml
index 710f5193..a77c8402 100644
--- a/examples/package.yaml
+++ b/examples/package.yaml
@@ -290,6 +290,19 @@ executables:
       - Shpadoinkle-backend-pardiff
       - Shpadoinkle-lens
 
+  streaming:
+    main: Streaming.hs
+    other-modules: []
+    source-dirs: .
+    dependencies:
+    - streaming
+    - text
+
+    - Shpadoinkle
+    - Shpadoinkle-streaming
+    - Shpadoinkle-html
+    - Shpadoinkle-backend-pardiff
+
 
 
 git: https://gitlab.com/fresheyeball/Shpadoinkle.git
diff --git a/nix/hpackall.sh b/nix/hpackall.sh
index 560c5f77..906451f1 100755
--- a/nix/hpackall.sh
+++ b/nix/hpackall.sh
@@ -16,3 +16,4 @@ p widgets
 p examples
 p tests
 p isreal
+p streaming
diff --git a/nix/overlay-shpadoinkle.nix b/nix/overlay-shpadoinkle.nix
index 8b82ff13..06f0ef9d 100644
--- a/nix/overlay-shpadoinkle.nix
+++ b/nix/overlay-shpadoinkle.nix
@@ -160,6 +160,7 @@ in {
           Shpadoinkle-marketing        = call "Shpadoinkle-marketing"        ../marketing;
           Shpadoinkle-html             = call "Shpadoinkle-html"             ../html;
           Shpadoinkle-router           = call "Shpadoinkle-router"           ../router;
+          Shpadoinkle-streaming        = call "Shpadoinkle-streaming"        ../streaming;
           Shpadoinkle-widgets          = addTest (call "Shpadoinkle-widgets" ../widgets) hpkgs;
 
           Shpadoinkle-tests            = super.haskell.packages.${compiler}.callCabal2nix "tests" (gitignore ../tests) {};
diff --git a/nix/overlay.nix b/nix/overlay.nix
index cd1439fa..569ac2e5 100644
--- a/nix/overlay.nix
+++ b/nix/overlay.nix
@@ -1,7 +1,7 @@
-{ chan, compiler, isJS }:
+{ chan, compiler, isJS, enableLibraryProfiling, enableExecutableProfiling }:
 with (import ./base-pkgs.nix { inherit chan; } {}).lib;
 foldl' composeExtensions (_: _: {})
 [
-  (import ./overlay-reflex.nix { inherit compiler isJS; })
+  (import ./overlay-reflex.nix { inherit compiler isJS enableLibraryProfiling; })
   (import ./overlay-shpadoinkle.nix { inherit compiler isJS; })
 ]
diff --git a/nix/pkgs.nix b/nix/pkgs.nix
index e5a22a0e..54df2427 100644
--- a/nix/pkgs.nix
+++ b/nix/pkgs.nix
@@ -2,10 +2,12 @@
 , isJS ? false
 , system ? "x86_64-linux"
 , chan ? (import ./chan.nix)
+, enableLibraryProfiling ? false
+, enableExecutableProfiling ? false
 }:
 import ./base-pkgs.nix { inherit chan; } {
   inherit system;
   overlays = [
-    (import ./overlay.nix { inherit chan compiler isJS; })
+    (import ./overlay.nix { inherit chan compiler isJS enableLibraryProfiling enableExecutableProfiling; })
   ];
 }
diff --git a/streaming/LICENSE b/streaming/LICENSE
new file mode 100644
index 00000000..e0066cfb
--- /dev/null
+++ b/streaming/LICENSE
@@ -0,0 +1,27 @@
+Shpadoinkle Streaming aka S11 Streaming
+Copyright © 2021 Morgan Thomas
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright notice,
+   this list of conditions and the following disclaimer.
+ * Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the distribution.
+ * Neither the name of Shpadoinkle nor the names of its contributors may be
+   used to endorse or promote products derived from this software without
+   specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
diff --git a/streaming/Setup.hs b/streaming/Setup.hs
new file mode 100644
index 00000000..44671092
--- /dev/null
+++ b/streaming/Setup.hs
@@ -0,0 +1,2 @@
+import           Distribution.Simple
+main = defaultMain
diff --git a/streaming/Shpadoinkle/Streaming.hs b/streaming/Shpadoinkle/Streaming.hs
new file mode 100644
index 00000000..0e744914
--- /dev/null
+++ b/streaming/Shpadoinkle/Streaming.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+
+
+module Shpadoinkle.Streaming
+  ( consumeStream
+  ) where
+
+
+import           Shpadoinkle        hiding (h)
+
+import           Data.Functor.Of    (Of ((:>)))
+import           Streaming          (Stream)
+import           Streaming.Internal (destroy)
+
+
+consumeStream :: forall m a b. Monad m => Stream (Of a) m () -> (a -> m (b -> b)) -> Continuation m b
+consumeStream stream f = destroy stream g h j
+  where
+    g :: Of a (Continuation m b) -> Continuation m b
+    g (a :> k) = voidRunContinuationT $ do
+      commit (impur (f a))
+      commit (merge k)
+
+    h :: m (Continuation m b) -> Continuation m b
+    h = causedBy
+
+    j :: () -> Continuation m b
+    j = const done
diff --git a/streaming/default.nix b/streaming/default.nix
new file mode 100644
index 00000000..c7b5bb88
--- /dev/null
+++ b/streaming/default.nix
@@ -0,0 +1,4 @@
+import ../default.nix { pack = "Shpadoinkle-streaming"; }
+
+
+
diff --git a/streaming/package.yaml b/streaming/package.yaml
new file mode 100644
index 00000000..c158cdd5
--- /dev/null
+++ b/streaming/package.yaml
@@ -0,0 +1,34 @@
+name:         Shpadoinkle-streaming
+license:      BSD3
+license-file: LICENSE
+version:      0.0.0.1
+author:       Morgan Thomas
+maintainer:   morgan.a.s.thomas@gmail.com
+category:     Web
+build-type:   Simple
+synopsis:     Integration of the streaming library with Shpadoinkle continuations.
+description:
+  Integration of the streaming library with Shpadoinkle continuations.
+
+
+ghc-options:
+    - -Wall
+    - -Wcompat
+    - -fwarn-redundant-constraints
+    - -fwarn-tabs
+    - -fwarn-incomplete-record-updates
+    - -fwarn-identities
+
+
+dependencies:
+    - base >= 4.12.0 && < 4.16
+    - lens
+    - streaming >= 0.2 && < 0.3
+    - text
+
+    - Shpadoinkle
+
+
+library:
+  exposed-modules: Shpadoinkle.Streaming
+  source-dirs: .
-- 
GitLab