Skip to content

Commit

Permalink
Adds new template definitiong
Browse files Browse the repository at this point in the history
  • Loading branch information
Mike Solomon committed Jul 15, 2021
1 parent 034f6cd commit 78af3d4
Show file tree
Hide file tree
Showing 2 changed files with 157 additions and 36 deletions.
69 changes: 51 additions & 18 deletions src/WAGS/Template.purs
View file
Original file line number Diff line number Diff line change
@@ -1,13 +1,12 @@
module WAGS.Template where

import Prelude

import Data.Symbol (class IsSymbol)
import Data.Symbol (class IsSymbol, reflectSymbol)
import Data.Tuple.Nested (type (/\), (/\))
import Data.Typelevel.Num (class Pos, class Pred, D0, toInt')
import Data.Vec as V
import Prim.Row (class Lacks, class Cons)
import Prim.RowList (RowList)
import Prim.RowList (class RowToList, RowList)
import Prim.RowList as RowList
import Prim.Symbol as Symbol
import Record as Record
Expand Down Expand Up @@ -51,36 +50,70 @@ instance suffixAllRecordsRec :: SuffixAllRecords s i o => SuffixAllRecordsRec s
instance suffixAllRecordsTupRec :: SuffixAllRecordsRec s i o => SuffixAllRecordsRec s (a /\ i) (a /\ o) where
suffixizeRec s (a /\ b) = a /\ suffixizeRec s b

class PoolWithTemplate' (suffix :: Symbol) (n :: Type) (a :: Type) (g :: Type) (o :: Row Type) | suffix n a g -> o where
fromTemplate' :: forall proxy. proxy suffix -> V.Vec n a -> (Int -> a -> g) -> { | o }
class AssertHomogeneous (rl :: RowList Type) (t :: Type) | rl -> t

instance assertHomogeneousNil :: AssertHomogeneous RowList.Nil Void

instance assertHomogeneousCons :: AssertHomogeneous (RowList.Cons a b c) b

class PoolWithTemplateVec (suffix :: Symbol) (n :: Type) (a :: Type) (g :: Type) (o :: Row Type) | suffix n a g -> o where
fromTemplateVec :: forall proxy. proxy suffix -> V.Vec n a -> (Int -> a -> g) -> { | o }

instance poolWithTemplate'D0 :: PoolWithTemplate' suffix D0 a g () where
fromTemplate' _ _ _ = {}
else instance poolWithTemplate'D ::
instance poolWithTemplateVecD0 :: PoolWithTemplateVec suffix D0 a g () where
fromTemplateVec _ _ _ = {}
else instance poolWithTemplateVecD ::
( Pred n n'
, PoolWithTemplate' suffix n' a g x
, PoolWithTemplateVec suffix n' a g x
, NatToSym n sn
, Symbol.Append "busFor_" sn s0
, Symbol.Append s0 suffix sym
, Symbol.Append s0 "_" sym''
, Symbol.Append sym'' suffix sym
, Symbol.Append "_unitFor_" sn s1
, Symbol.Append s1 suffix sym'
, SuffixAllRecordsRec sym' g gg
, Cons sym gg x o
, Lacks sym x
, IsSymbol sym
) =>
PoolWithTemplate' suffix n a g o where
fromTemplate' px v fa =
PoolWithTemplateVec suffix n a g o where
fromTemplateVec px v fa =
let
uc = V.uncons v
in
Record.insert (Proxy :: _ sym)
(suffixizeRec (Proxy :: _ sym') (fa (toInt' (Proxy :: _ n)) uc.head))
(fromTemplate' px uc.tail fa)
(fromTemplateVec px uc.tail fa)

class PoolWithTemplateRec (suffix :: Symbol) (rl :: RowList Type) (r :: Row Type) (a :: Type) (g :: Type) (o :: Row Type) | suffix rl r a g -> o where
fromTemplateRec :: forall proxyS proxyRL. proxyS suffix -> proxyRL rl -> { | r } -> (String -> a -> g) -> { | o }

instance poolWithTemplateRecNil :: PoolWithTemplateRec suffix RowList.Nil r a g () where
fromTemplateRec _ _ _ _ = {}
else instance poolWithTemplateRecCons ::
( IsSymbol sn
, PoolWithTemplateRec suffix tail r a g x
, Cons sn a r' r
, Symbol.Append "busFor_" sn s0
, Symbol.Append s0 "_" sym''
, Symbol.Append sym'' suffix sym
, Symbol.Append "_unitFor_" sn s1
, Symbol.Append s1 suffix sym'
, SuffixAllRecordsRec sym' g gg
, Cons sym gg x o
, Lacks sym x
, IsSymbol sym
) =>
PoolWithTemplateRec suffix (RowList.Cons sn val tail) r a g o where
fromTemplateRec px _ v fa =
Record.insert (Proxy :: _ sym)
(suffixizeRec (Proxy :: _ sym') (fa (reflectSymbol (Proxy :: _ sn)) (Record.get (Proxy :: _ sn) v)))
(fromTemplateRec px (Proxy :: _ tail) v fa)

class PoolWithTemplate (suffix :: Symbol) (v :: Type) (g :: Type) (i :: Type) (a :: Type) (o :: Type) | suffix v g -> i a o where
fromTemplate :: forall proxy. proxy suffix -> v -> (i -> a -> g) -> o

class
Pos n <= PoolWithTemplate (suffix :: Symbol) (n :: Type) (a :: Type) (g :: Type) (o :: Type) | suffix n a g -> o where
fromTemplate :: forall proxy. proxy suffix -> V.Vec n a -> (Int -> a -> g) -> o
instance poolWithTemplateVec :: (Pos n, PoolWithTemplateVec suffix n a g o) => PoolWithTemplate suffix (V.Vec n a) g Int a (Gain AudioParameter /\ { | o }) where
fromTemplate a b c = gain 1.0 (fromTemplateVec a b c)

instance poolWithTemplateAll :: (Pos n, PoolWithTemplate' suffix n a g o) => PoolWithTemplate suffix n a g (Gain AudioParameter /\ { | o }) where
fromTemplate a b c = gain 1.0 (fromTemplate' a b c)
instance poolWithTemplateRec :: (RowToList r rl, AssertHomogeneous rl a, PoolWithTemplateRec suffix rl r a g o) => PoolWithTemplate suffix { | r } g String a (Gain AudioParameter /\ { | o }) where
fromTemplate a b c = gain 1.0 (fromTemplateRec a (Proxy :: _ rl) b c)
124 changes: 106 additions & 18 deletions test/TLP.purs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,7 +110,7 @@ testC2Cr ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C2 } Unit
testC2Cr = icreate (speaker (highpass 440.0 (highpass 440.0(sinOsc 440.0))))
testC2Cr = icreate (speaker (highpass 440.0 (highpass 440.0 (sinOsc 440.0))))

testC2CrT ::
forall r (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
Expand All @@ -125,16 +125,15 @@ testC2CrT' ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C2 } Unit
testC2CrT' = testC2CrT (speaker (highpass 440.0 (highpass 440.0(sinOsc 440.0))))
testC2CrT' = testC2CrT (speaker (highpass 440.0 (highpass 440.0 (sinOsc 440.0))))

testC2Ch ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res { | C2 } { | C2 } Unit
testC2Ch = ichange (speaker (highpass 440.0 (highpass 440.0(sinOsc 440.0))))
testC2Ch = ichange (speaker (highpass 440.0 (highpass 440.0 (sinOsc 440.0))))

---

-----
type C3
= ( speaker :: TSpeaker /\ { hello :: Unit, world :: Unit }
Expand All @@ -146,7 +145,7 @@ testC3Cr ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C3 } Unit
testC3Cr = icreate (speaker { hello: sinOsc 440.0, world: sinOsc 440.0 } )
testC3Cr = icreate (speaker { hello: sinOsc 440.0, world: sinOsc 440.0 })

testC3CrT ::
forall r (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
Expand Down Expand Up @@ -181,7 +180,7 @@ testC4Cr ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C4 } Unit
testC4Cr = icreate (speaker { hello: (highpass 440.0 (sinOsc 440.0)), world: sinOsc 440.0 } )
testC4Cr = icreate (speaker { hello: (highpass 440.0 (sinOsc 440.0)), world: sinOsc 440.0 })

testC4CrT ::
forall r (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
Expand All @@ -206,30 +205,30 @@ testC4Ch = ichange (speaker { hello: (highpass 440.0 (sinOsc 440.0)), world: sin

----
type C5
= ( busFor_D1hello ::
= ( busFor_D1_hello ::
TGain
/\ { busFor_D1hello_PlayBuf_D0 :: Unit
/\ { busFor_D1_hello_PlayBuf_D0 :: Unit
}
, busFor_D1hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_D2hello ::
, busFor_D1_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_D2_hello ::
TGain
/\ { busFor_D2hello_PlayBuf_D0 :: Unit
/\ { busFor_D2_hello_PlayBuf_D0 :: Unit
}
, busFor_D2hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_D3hello ::
, busFor_D2_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_D3_hello ::
TGain
/\ { busFor_D3hello_PlayBuf_D0 :: Unit
/\ { busFor_D3_hello_PlayBuf_D0 :: Unit
}
, busFor_D3hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_D3_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, speaker ::
TSpeaker
/\ { speaker_Gain_D0 :: Unit
}
, speaker_Gain_D0 ::
TGain
/\ { busFor_D1hello :: Unit
, busFor_D2hello :: Unit
, busFor_D3hello :: Unit
/\ { busFor_D1_hello :: Unit
, busFor_D2_hello :: Unit
, busFor_D3_hello :: Unit
}
)

Expand Down Expand Up @@ -292,3 +291,92 @@ testC5Ch =
"hi-hat"
)
)

-----
type C6
= ( busFor_foo_hello ::
TGain
/\ { busFor_foo_hello_PlayBuf_D0 :: Unit
}
, busFor_foo_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_bar_hello ::
TGain
/\ { busFor_bar_hello_PlayBuf_D0 :: Unit
}
, busFor_bar_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, busFor_baz_hello ::
TGain
/\ { busFor_baz_hello_PlayBuf_D0 :: Unit
}
, busFor_baz_hello_PlayBuf_D0 :: TPlayBuf /\ {}
, speaker ::
TSpeaker
/\ { speaker_Gain_D0 :: Unit
}
, speaker_Gain_D0 ::
TGain
/\ { busFor_foo_hello :: Unit
, busFor_bar_hello :: Unit
, busFor_baz_hello :: Unit
}
)

testC6Cr ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C6 } Unit
testC6Cr =
icreate
$ speaker
( fromTemplate (Proxy :: _ "hello") { foo: unit, bar: unit, baz: unit } \_ ipt ->
gain 0.0
( playBuf
{ playbackRate: 1.0
, onOff: On
}
"hi-hat"
)
)

testC6CrT ::
forall r (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
CreateT r () C6 =>
Patch () C6 =>
{ | r } ->
IxWAG audio engine proof res {} { | C6 } Unit
testC6CrT _ = ipatch

testC6CrT' ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res {} { | C6 } Unit
testC6CrT' =
testC6CrT
$ speaker
( fromTemplate (Proxy :: _ "hello") { foo: unit, bar: unit, baz: unit } \_ ipt ->
gain 0.0
( playBuf
{ playbackRate: 1.0
, onOff: On
}
"hi-hat"
)
)

testC6Ch ::
forall (audio :: Type) (engine :: Type) (proof :: Type) (res :: Type).
AudioInterpret audio engine =>
IxWAG audio engine proof res { | C6 } { | C6 } Unit
testC6Ch =
ichange
$ speaker
( fromTemplate (Proxy :: _ "hello") { foo: unit, bar: unit, baz: unit } \_ ipt ->
gain 0.0
( playBuf
{ playbackRate: 1.0
, onOff: On
}
"hi-hat"
)
)

0 comments on commit 78af3d4

Please sign in to comment.