Uses more precise typeclasses for create and change

mikesol · Jun 19, 2021 · 5772a4b · 5772a4b
1 parent 5f4bf59
commit 5772a4b
Show file tree

Hide file tree

Showing 5 changed files with 276 additions and 419 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -5,6 +5,12 @@ All notable changes to this project will be documented in this file.
 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.3.2] - 2021-06-19
+
+### Changed
+
+- Typeclasses for `create` and `change` no longer use `hfoldlWithIndex`.
+
 ## [0.3.1] - 2021-06-09
 
 ### Added

diff --git a/package.json b/package.json
@@ -1,6 +1,6 @@
 {
   "name": "purescript-wags",
-  "version": "0.3.1",
+  "version": "0.3.2",
   "description": "Web Audio Graphs as a Stream",
   "scripts": {
     "build": "spago build",

diff --git a/src/WAGS/Change.purs b/src/WAGS/Change.purs
@@ -6,7 +6,6 @@ import Data.Maybe (Maybe(..), maybe)
 import Data.Symbol (class IsSymbol, reflectSymbol)
 import Data.Tuple.Nested ((/\), type (/\))
 import Data.Vec as V
-import Heterogeneous.Folding (class FoldingWithIndex, class HFoldlWithIndex, hfoldlWithIndex)
 import Prim.Row as R
 import Prim.RowList as RL
 import Record as Record
@@ -88,154 +87,97 @@ ichange' ::
   IxWAG audio engine proof res { | i } { | i } Unit
 ichange' ptr a = IxWAG (change' ptr <<< (<$) a)
 
-data ChangeFoldingWithIndex
-  = ChangeFoldingWithIndex
-
-instance changeFoldingWithIndexUnit ::
-  ( AudioInterpret audio engine
-  , Change' sym Unit inGraph
+-- | Similar to `change'`, but accepts a record with multiple units to change.
+class Change (r :: Row Type) (graph :: Graph) where
+  change ::
+    forall audio engine proof res.
+    AudioInterpret audio engine =>
+    WAG
+      audio
+      engine
+      proof
+      res
+      { | graph }
+      { | r } ->
+    WAG
+      audio
+      engine
+      proof
+      res
+      { | graph }
+      Unit
+
+class ChangeRL (rl :: RL.RowList Type) (r :: Row Type) (graph :: Graph) where
+  changeRL ::
+    forall proxy audio engine proof res.
+    AudioInterpret audio engine =>
+    proxy rl ->
+    WAG
+      audio
+      engine
+      proof
+      res
+      { | graph }
+      { | r } ->
+    WAG
+      audio
+      engine
+      proof
+      res
+      { | graph }
+      Unit
+
+instance changeAll :: (RL.RowToList r rl, ChangeRL rl r graph) => Change r graph where
+  change = changeRL (Proxy :: _ rl)
+
+instance changeRLNil :: ChangeRL RL.Nil r graph where
+  changeRL _ r = r $> unit
+
+instance changeRLConsU :: ChangeRL (RL.Cons key Unit rest) r graph where
+  changeRL _ r = r $> unit
+else instance changeRLCons ::
+  ( IsSymbol key
+  , R.Cons key val ignore r
+  , Edgeable val (node /\ { | edges })
+  , Change' key node graph
+  , Change edges graph
+  , ChangeRL rest r graph
   ) =>
-  FoldingWithIndex
-    ChangeFoldingWithIndex
-    (proxy sym)
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        { | inRecord }
-    )
-    Unit
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    ) where
-  foldingWithIndex ChangeFoldingWithIndex _ ifr node = ifr $> unit
-else instance changeFoldingWithIndex ::
-  ( AudioInterpret audio engine
-  , Edgeable node' (node /\ edges)
-  , Change' sym node inGraph
-  , HFoldlWithIndex
-      ChangeFoldingWithIndex
-      ( WAG
-          audio
-          engine
-          proof
-          res
-          { | inGraph }
-          Unit
-      )
-      edges
-      ( WAG
-          audio
-          engine
-          proof
-          res
-          { | inGraph }
-          Unit
+  ChangeRL (RL.Cons key val rest) r graph where
+  changeRL _ r = step3
+    where
+    rx = extract r
+    node /\ edges = withEdge (Record.get (Proxy :: _ key) rx)
+
+    step1 = change' (Proxy :: _ key) (r $> node)
+
+    step2 =
+      ( change ::
+          forall audio engine proof res.
+          AudioInterpret audio engine =>
+          WAG
+            audio
+            engine
+            proof
+            res
+            { | graph }
+            { | edges } ->
+          WAG
+            audio
+            engine
+            proof
+            res
+            { | graph }
+            Unit
       )
-  ) =>
-  FoldingWithIndex
-    ChangeFoldingWithIndex
-    (proxy sym)
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    )
-    node'
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    ) where
-  foldingWithIndex ChangeFoldingWithIndex prop ifr node' =
-    let
-      node /\ edges = withEdge node'
+        (step1 $> edges)
 
-      res = change' prop (ifr $> node)
-    in
-      hfoldlWithIndex
-        ChangeFoldingWithIndex
-        (res $> unit)
-        edges
-
--- | Similar to `change'`, but accepts a record with multiple units to change.
-change ::
-  forall r audio engine proof res inGraph.
-  AudioInterpret audio engine =>
-  HFoldlWithIndex
-    ChangeFoldingWithIndex
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    )
-    { | r }
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    ) =>
-  WAG
-    audio
-    engine
-    proof
-    res
-    { | inGraph }
-    { | r } ->
-  WAG
-    audio
-    engine
-    proof
-    res
-    { | inGraph }
-    Unit
-change r =
-  hfoldlWithIndex
-    ChangeFoldingWithIndex
-    (r $> unit)
-    (extract r)
+    step3 = changeRL (Proxy :: _ rest) (step2 $> rx)
 
 ichange ::
   forall r audio engine proof res inGraph.
   AudioInterpret audio engine =>
-  HFoldlWithIndex
-    ChangeFoldingWithIndex
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    )
-    { | r }
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        Unit
-    ) =>
+  Change r inGraph =>
   { | r } ->
   IxWAG
     audio

diff --git a/src/WAGS/Connect.purs b/src/WAGS/Connect.purs
@@ -2,10 +2,8 @@ module WAGS.Connect where
 
 import Prelude hiding (Ordering(..))
 
-import Control.Comonad (extract)
 import Data.Functor (voidRight)
 import Data.Symbol (class IsSymbol, reflectSymbol)
-import Heterogeneous.Folding (class FoldingWithIndex)
 import Prim.Row as R
 import WAGS.Control.Indexed (IxWAG(..))
 import WAGS.Control.Types (WAG, unsafeUnWAG, unsafeWAG)
@@ -54,33 +52,3 @@ instance connectInstance ::
 
     toI = reflectSymbol toI'
 
-data ConnectFoldingWithIndex
-  = ConnectFoldingWithIndex
-
-instance connectFoldingWithIndex ::
-  ( AudioInterpret audio engine
-  , Connect from to inGraph outGraph
-  , IsSymbol from
-  , IsSymbol to
-  ) =>
-  FoldingWithIndex
-    ConnectFoldingWithIndex
-    (proxy from)
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | inGraph }
-        (proxy to)
-    )
-    anything
-    ( WAG
-        audio
-        engine
-        proof
-        res
-        { | outGraph }
-        (proxy to)
-    ) where
-  foldingWithIndex ConnectFoldingWithIndex from ifr a = connect (ifr $> { source: from, dest: extract ifr }) $> extract ifr