runST (#79)

Co-authored-by: Mike Solomon <[email protected]>
mikesol · Dec 7, 2022 · 56ce8b4 · 56ce8b4
1 parent 49f6632
commit 56ce8b4
Show file tree

Hide file tree

Showing 3 changed files with 54 additions and 28 deletions.
diff --git 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
@@ -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
@@ -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