From 56ce8b44299b2cb9172f98c7d221c97404ef0f85 Mon Sep 17 00:00:00 2001
From: Mike Solomon <mike@meeshkan.com>
Date: Wed, 7 Dec 2022 12:58:42 +0200
Subject: [PATCH] runST (#79)

Co-authored-by: Mike Solomon <mike120982@gmail.com>
---
 CHANGELOG.md           |  5 +++
 package.json           |  2 +-
 src/Deku/Toplevel.purs | 75 +++++++++++++++++++++++++++---------------
 3 files changed, 54 insertions(+), 28 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 7c15a330..967c16f2 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -6,6 +6,11 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
 and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
 
 
+## [0.9.7] - 2022-12-07
+
+- Makes `runST` polymorphic over `r`.
+
+
 ## [0.9.6] - 2022-12-01
 
 - Adds `NutWith`.
diff --git a/package.json b/package.json
index b7cdbca9..58dacfda 100644
--- a/package.json
+++ b/package.json
@@ -1,6 +1,6 @@
 {
 	"name": "purescript-deku",
-	"version": "0.9.6",
+	"version": "0.9.7",
 	"description": "A friendly tree-like structure in the browser.",
 	"scripts": {
 		"postinstall": "node node_modules/puppeteer/install.js",
diff --git a/src/Deku/Toplevel.purs b/src/Deku/Toplevel.purs
index 2caf6011..d88a0563 100644
--- a/src/Deku/Toplevel.purs
+++ b/src/Deku/Toplevel.purs
@@ -89,43 +89,64 @@ derive instance Newtype Template _
 
 runSSR
   :: Template
-  -> ( forall lock
+  -> ( forall lock r
         . Domable lock
-            (RRef.STRef Global (Array Instruction) -> ST Global Unit)
+            (RRef.STRef r (Array Instruction) -> ST r Unit)
+       -> ST r String
      )
-  -> ST Global String
 runSSR = runSSR' "body"
 
 runSSR'
   :: String
   -> Template
-  -> ( forall lock
+  -> ( forall lock r
         . Domable lock
-            (RRef.STRef Global (Array Instruction) -> ST Global Unit)
+            (RRef.STRef r (Array Instruction) -> ST r Unit)
+       -> ST r String
      )
-  -> ST Global String
-runSSR' topTag (Template { head, tail }) children =
-  (head <> _) <<< (_ <> tail) <<< ssr' topTag
-    <$> liftST
-      ( do
-          seed <- RRef.new 0
-          instr <- RRef.new []
-          let di = ssrDOMInterpret seed
-          void $ subscribePure
-            ( ( __internalDekuFlatten
-                  { parent: Just "deku-root"
-                  , scope: Local "rootScope"
-                  , raiseId: \_ -> pure unit
-                  , ez: true
-                  , pos: Nothing
-                  , dynFamily: Nothing
-                  }
-                  di
-                  children
-              )
+runSSR' topTag (Template { head, tail }) = go
+  where
+  go
+    :: forall lock r
+     . Domable lock
+         (RRef.STRef r (Array Instruction) -> ST r Unit)
+    -> ST r String
+  go children' = do
+    let
+      children =
+        ( unsafeCoerce
+            :: ( Domable lock
+                   (RRef.STRef r (Array Instruction) -> ST r Unit)
+               )
+            -> ( Domable lock
+                   (RRef.STRef Global (Array Instruction) -> ST Global Unit)
+               )
+        ) children'
+      unglobal = unsafeCoerce :: ST Global String -> ST r String
+
+    unglobal
+      ( (head <> _) <<< (_ <> tail) <<< ssr' topTag
+          <$>
+            ( do
+                seed <- RRef.new 0
+                instr <- RRef.new []
+                let di = ssrDOMInterpret seed
+                void $ subscribePure
+                  ( ( __internalDekuFlatten
+                        { parent: Just "deku-root"
+                        , scope: Local "rootScope"
+                        , raiseId: \_ -> pure unit
+                        , ez: true
+                        , pos: Nothing
+                        , dynFamily: Nothing
+                        }
+                        di
+                        children
+                    )
+                  )
+                  \i -> i instr
+                RRef.read instr
             )
-            \i -> i instr
-          RRef.read instr
       )
 
 __internalDekuFlatten