From 5772a4b517d0eefc4254dd6ca8627cc7ef39da73 Mon Sep 17 00:00:00 2001 From: Mike Solomon Date: Sat, 19 Jun 2021 21:16:54 +0300 Subject: [PATCH] Uses more precise typeclasses for create and change --- CHANGELOG.md | 6 + package.json | 2 +- src/WAGS/Change.purs | 226 +++++++++------------- src/WAGS/Connect.purs | 32 ---- src/WAGS/Create.purs | 429 ++++++++++++++++++------------------------ 5 files changed, 276 insertions(+), 419 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index bd253083..976d8b2f 100644 --- 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 index 3588a34c..0bcabc12 100644 --- 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 index affa24f8..58ee280e 100644 --- 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 index 34aaf520..ddef5192 100644 --- 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 diff --git a/src/WAGS/Create.purs b/src/WAGS/Create.purs index a297a1cc..c3474789 100644 --- a/src/WAGS/Create.purs +++ b/src/WAGS/Create.purs @@ -1,7 +1,6 @@ module WAGS.Create where import Prelude - import Control.Comonad (extract) import Data.Either (Either(..)) import Data.Functor (voidRight) @@ -9,10 +8,11 @@ import Data.Symbol (class IsSymbol, reflectSymbol) import Data.Tuple (Tuple) 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 import Type.Proxy (Proxy(..)) -import WAGS.Connect (ConnectFoldingWithIndex(..)) +import WAGS.Connect (class Connect, connect) import WAGS.Control.Indexed (IxWAG(..)) import WAGS.Control.Types (WAG, unsafeUnWAG, unsafeWAG) import WAGS.Edgeable (class Edgeable, withEdge) @@ -25,253 +25,194 @@ import WAGS.Graph.Parameter (class Paramable, paramize) import WAGS.Interpret (class AudioInterpret, makeAllpass, makeBandpass, makeConstant, makeConvolver, makeDelay, makeDynamicsCompressor, makeGain, makeHighpass, makeHighshelf, makeLoopBuf, makeLowpass, makeLowshelf, makeMicrophone, makeNotch, makePeaking, makePeriodicOsc, makePeriodicOscV, makePlayBuf, makeRecorder, makeSawtoothOsc, makeSinOsc, makeSpeaker, makeSquareOsc, makeStereoPanner, makeTriangleOsc, makeWaveShaper) import WAGS.Util (tmap) -data CreateFoldingWithIndex - = CreateFoldingWithIndex - -instance createFoldingWithIndex :: - ( AudioInterpret audio engine - , Edgeable node' (Tuple node edges) - , Create' sym node inGraph midGraph - , HFoldlWithIndex - CreateFoldingWithIndex - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) - edges - ( WAG - audio - engine - proof - res - { | outGraph } - Unit - ) - , IsSymbol sym +class CreateStep (r :: Row Type) (inGraph :: Graph) (outGraph :: Graph) | r inGraph -> outGraph where + createStep :: + forall audio engine proof res. + AudioInterpret audio engine => + WAG + audio + engine + proof + res + { | inGraph } + { | r } -> + WAG + audio + engine + proof + res + { | outGraph } + Unit + +class CreateStepRL (rl :: RL.RowList Type) (r :: Row Type) (inGraph :: Graph) (outGraph :: Graph) | rl r inGraph -> outGraph where + createStepRL :: + forall proxy audio engine proof res. + AudioInterpret audio engine => + proxy rl -> + WAG + audio + engine + proof + res + { | inGraph } + { | r } -> + WAG + audio + engine + proof + res + { | outGraph } + Unit + +instance createStepAll :: (RL.RowToList r rl, CreateStepRL rl r inGraph outGraph) => CreateStep r inGraph outGraph where + createStep = createStepRL (Proxy :: _ rl) + +instance createStepRLNil :: CreateStepRL RL.Nil r inGraph inGraph where + createStepRL _ r = r $> unit + +instance createStepRLCons :: + ( IsSymbol key + , R.Cons key val ignore r + , Edgeable val (node /\ { | edges }) + , Create' key node graph0 graph1 + , CreateStep edges graph1 graph2 + , CreateStepRL rest r graph2 graph3 ) => - FoldingWithIndex - CreateFoldingWithIndex - (proxy sym) - ( WAG - audio - engine - proof - res - { | inGraph } - Unit - ) - node' - ( WAG - audio - engine - proof - res - { | outGraph } - Unit - ) where - foldingWithIndex CreateFoldingWithIndex prop ifr edgeable = - let - node /\ edges = withEdge edgeable - - res = create' prop (ifr $> node) - in - hfoldlWithIndex - CreateFoldingWithIndex - (res $> unit) - edges - -data ThenConnectFoldingWithIndex - = ThenConnectFoldingWithIndex - -instance thenConnectFoldingWithIndex :: - ( IsSymbol sym - , Edgeable node' (Tuple node edges) - , HFoldlWithIndex - ConnectFoldingWithIndex - ( WAG - audio - engine - proof - res - { | inGraph } - (Proxy sym) - ) - edges - ( WAG - audio - engine - proof - res - { | midGraph } - (Proxy sym) - ) - , HFoldlWithIndex - ThenConnectFoldingWithIndex - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) - edges - ( WAG - audio - engine - proof - res - { | outGraph } - Unit + CreateStepRL (RL.Cons key val rest) r graph0 graph3 where + createStepRL _ r = step3 + where + rx = extract r + + node /\ edges = withEdge (Record.get (Proxy :: _ key) rx) + + step1 = create' (Proxy :: _ key) (r $> node) + + step2 = + ( createStep :: + forall audio engine proof res. + AudioInterpret audio engine => + WAG + audio + engine + proof + res + { | graph1 } + { | edges } -> + WAG + audio + engine + proof + res + { | graph2 } + Unit ) + (step1 $> edges) + + step3 = createStepRL (Proxy :: _ rest) (step2 $> rx) + +class ConnectEdgesToNode (sources :: RL.RowList Type) (dest :: Symbol) (inGraph :: Graph) (outGraph :: Graph) | sources dest inGraph -> outGraph where + connectEdgesToNode :: + forall proxyRL proxyS audio engine proof res. + AudioInterpret audio engine => + proxyRL sources -> + WAG + audio + engine + proof + res + { | inGraph } + (proxyS dest) -> + WAG + audio + engine + proof + res + { | outGraph } + (proxyS dest) + +instance connectEdgesToNodeNil :: ConnectEdgesToNode RL.Nil dest inGraph inGraph where + connectEdgesToNode _ w = w + +instance connectEdgesToNodeCons :: (Connect key dest inGraph midGraph, ConnectEdgesToNode rest dest midGraph outGraph) => ConnectEdgesToNode (RL.Cons key ignore rest) dest inGraph outGraph where + connectEdgesToNode _ w = step2 + where + step1 = connect (w $> { source: (Proxy :: _ key), dest: (Proxy :: _ dest) }) + + step2 = connectEdgesToNode (Proxy :: _ rest) (step1 $> (extract w)) + +class ConnectAfterCreate (rl :: RL.RowList Type) (inGraph :: Graph) (outGraph :: Graph) | rl inGraph -> outGraph where + connectAfterCreate :: + forall audio engine proof res. + AudioInterpret audio engine => + WAG + audio + engine + proof + res + { | inGraph } + (Proxy rl) -> + WAG + audio + engine + proof + res + { | outGraph } + Unit + +instance connectAfterCreateNil :: ConnectAfterCreate RL.Nil graph0 graph0 where + connectAfterCreate w = w $> unit + +instance connectAfterCreateCons :: + ( Edgeable node' (Tuple node { | edges }) + , RL.RowToList edges edgesList + , ConnectEdgesToNode edgesList sym graph0 graph1 + , ConnectAfterCreate edgesList graph1 graph2 + , ConnectAfterCreate rest graph2 graph3 ) => - FoldingWithIndex - ThenConnectFoldingWithIndex - (proxy sym) - ( WAG - audio - engine - proof - res - { | inGraph } - Unit - ) - node' - ( WAG - audio - engine - proof - res - { | outGraph } - Unit - ) where - foldingWithIndex ThenConnectFoldingWithIndex prop ifr edgeable = - let - _ /\ edges = withEdge edgeable - in - hfoldlWithIndex - ThenConnectFoldingWithIndex - ( hfoldlWithIndex - ConnectFoldingWithIndex - (ifr $> (Proxy :: _ sym)) - edges - $> (extract ifr) - ) - edges - --- | Similar to `create`, but accepts a record with multiple units to create _and_ connect. -create :: - forall r audio engine proof res inGraph midGraph outGraph. - AudioInterpret audio engine => - HFoldlWithIndex - CreateFoldingWithIndex - ( WAG - audio - engine - proof - res - { | inGraph } - Unit - ) - { | r } - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) => - HFoldlWithIndex - ThenConnectFoldingWithIndex - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) - { | r } - ( WAG - audio - engine - proof - res - { | outGraph } - Unit - ) => - WAG - audio - engine - proof - res - { | inGraph } - { | r } -> - WAG - audio - engine - proof - res - { | outGraph } - Unit -create w = - hfoldlWithIndex - ThenConnectFoldingWithIndex - innerStep - (extract w) - where - innerStep = - hfoldlWithIndex - CreateFoldingWithIndex - (w $> unit) - (extract w) + ConnectAfterCreate (RL.Cons sym node' rest) graph0 graph3 where + connectAfterCreate w = step3 + where + step1 = connectEdgesToNode (Proxy :: _ edgesList) (w $> (Proxy :: _ sym)) + + step2 = connectAfterCreate (step1 $> (Proxy :: _ edgesList)) + + step3 = connectAfterCreate (step2 $> (Proxy :: _ rest)) + +class Create (r :: Row Type) (inGraph :: Graph) (outGraph :: Graph) | r inGraph -> outGraph where + create :: + forall audio engine proof res. + AudioInterpret audio engine => + WAG + audio + engine + proof + res + { | inGraph } + { | r } -> + WAG + audio + engine + proof + res + { | outGraph } + Unit + +instance createAll :: + ( CreateStep r inGraph midGraph + , RL.RowToList r rl + , ConnectAfterCreate rl midGraph outGraph + ) => + Create r inGraph outGraph where + create r = step1 + where + step0 = createStep r + + step1 = connectAfterCreate (step0 $> (Proxy :: _ rl)) icreate :: - forall r audio engine proof res inGraph midGraph outGraph. + forall r audio engine proof res inGraph outGraph. AudioInterpret audio engine => - HFoldlWithIndex - CreateFoldingWithIndex - ( WAG - audio - engine - proof - res - { | inGraph } - Unit - ) - { | r } - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) => - HFoldlWithIndex - ThenConnectFoldingWithIndex - ( WAG - audio - engine - proof - res - { | midGraph } - Unit - ) - { | r } - ( WAG - audio - engine - proof - res - { | outGraph } - Unit - ) => + Create r inGraph outGraph => { | r } -> IxWAG audio