{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Synthesizer.Dimensional.Causal.Process (
   module Synthesizer.Dimensional.Causal.Process,

   -- * re-export Arrow, it would be better to restrict that to Causal processes
   (Arrow.***), (Arrow.&&&),
   (Arrow.>>>), (Arrow.<<<),

   ArrowD.compose,
   ArrowD.first,
   ArrowD.second,
   ArrowD.split,
   ArrowD.fanout,
   ArrowD.loop,
   ArrowD.loopVolume,
   ) where

import qualified Synthesizer.Dimensional.Arrow as ArrowD
import qualified Synthesizer.Dimensional.Map as Map

import qualified Synthesizer.Dimensional.Signal.Private as SigA
import qualified Synthesizer.Dimensional.Sample as Sample
import qualified Synthesizer.Dimensional.Amplitude.Flat as Flat
import qualified Synthesizer.Dimensional.Amplitude as Amp
import qualified Synthesizer.Dimensional.Rate as Rate

import qualified Synthesizer.Causal.Arrow as CausalArrow
import qualified Synthesizer.Causal.Process as Causal
import qualified Control.Arrow as Arrow
import Control.Arrow (Arrow, ArrowLoop, first, (>>>), (<<<), )
import Control.Category (Category, )

import Control.Applicative (Applicative, )

import qualified Synthesizer.State.Signal as Sig
import qualified Synthesizer.Generic.Signal  as SigG

import qualified Algebra.Module as Module
import qualified Algebra.Field  as Field
import qualified Algebra.Ring   as Ring

import qualified Number.DimensionTerm        as DN
import qualified Algebra.DimensionTerm       as Dim

import Data.Tuple.HT as TupleHT (mapFst, )

-- import NumericPrelude.Numeric (one)
import Prelude hiding (map, id, fst, snd, )



{- |
Note that @amp@ can also be a pair of amplitudes
or a more complicated ensemble of amplitudes.
-}
type T s sample0 sample1 =
   ArrowD.T (Core s) sample0 sample1

type Single s amp0 amp1 yv0 yv1 =
   ArrowD.Single (Core s) amp0 amp1 yv0 yv1

newtype Core s yv0 yv1 =
   Core (Causal.T yv0 yv1)
   deriving (forall a. Core s a a
forall s a. Core s a a
forall b c a. Core s b c -> Core s a b -> Core s a c
forall s b c a. Core s b c -> Core s a b -> Core s a c
forall {k} (cat :: k -> k -> *).
(forall (a :: k). cat a a)
-> (forall (b :: k) (c :: k) (a :: k).
    cat b c -> cat a b -> cat a c)
-> Category cat
. :: forall b c a. Core s b c -> Core s a b -> Core s a c
$c. :: forall s b c a. Core s b c -> Core s a b -> Core s a c
id :: forall a. Core s a a
$cid :: forall s a. Core s a a
Category, forall s. Category (Core s)
forall b c. (b -> c) -> Core s b c
forall b c d. Core s b c -> Core s (b, d) (c, d)
forall b c d. Core s b c -> Core s (d, b) (d, c)
forall b c c'. Core s b c -> Core s b c' -> Core s b (c, c')
forall s b c. (b -> c) -> Core s b c
forall s b c d. Core s b c -> Core s (b, d) (c, d)
forall s b c d. Core s b c -> Core s (d, b) (d, c)
forall s b c c'. Core s b c -> Core s b c' -> Core s b (c, c')
forall b c b' c'.
Core s b c -> Core s b' c' -> Core s (b, b') (c, c')
forall s b c b' c'.
Core s b c -> Core s b' c' -> Core s (b, b') (c, c')
forall (a :: * -> * -> *).
Category a
-> (forall b c. (b -> c) -> a b c)
-> (forall b c d. a b c -> a (b, d) (c, d))
-> (forall b c d. a b c -> a (d, b) (d, c))
-> (forall b c b' c'. a b c -> a b' c' -> a (b, b') (c, c'))
-> (forall b c c'. a b c -> a b c' -> a b (c, c'))
-> Arrow a
&&& :: forall b c c'. Core s b c -> Core s b c' -> Core s b (c, c')
$c&&& :: forall s b c c'. Core s b c -> Core s b c' -> Core s b (c, c')
*** :: forall b c b' c'.
Core s b c -> Core s b' c' -> Core s (b, b') (c, c')
$c*** :: forall s b c b' c'.
Core s b c -> Core s b' c' -> Core s (b, b') (c, c')
second :: forall b c d. Core s b c -> Core s (d, b) (d, c)
$csecond :: forall s b c d. Core s b c -> Core s (d, b) (d, c)
first :: forall b c d. Core s b c -> Core s (b, d) (c, d)
$cfirst :: forall s b c d. Core s b c -> Core s (b, d) (c, d)
arr :: forall b c. (b -> c) -> Core s b c
$carr :: forall s b c. (b -> c) -> Core s b c
Arrow, forall s. Arrow (Core s)
forall b d c. Core s (b, d) (c, d) -> Core s b c
forall s b d c. Core s (b, d) (c, d) -> Core s b c
forall (a :: * -> * -> *).
Arrow a -> (forall b d c. a (b, d) (c, d) -> a b c) -> ArrowLoop a
loop :: forall b d c. Core s (b, d) (c, d) -> Core s b c
$cloop :: forall s b d c. Core s (b, d) (c, d) -> Core s b c
ArrowLoop, forall s. Arrow (Core s)
forall s (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
Core s a b -> sig a -> sig b
forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
Core s a b -> sig a -> sig b
forall (arrow :: * -> * -> *).
Arrow arrow
-> (forall (sig :: * -> *) a b.
    (Transform sig a, Transform sig b) =>
    arrow a b -> sig a -> sig b)
-> C arrow
apply :: forall (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
Core s a b -> sig a -> sig b
$capply :: forall s (sig :: * -> *) a b.
(Transform sig a, Transform sig b) =>
Core s a b -> sig a -> sig b
CausalArrow.C)

instance ArrowD.Applicable (Core s) (Rate.Phantom s)


consFlip ::
   (Sample.Amplitude sample0 ->
    (Sample.Amplitude sample1,
     Causal.T (Sample.Displacement sample0)
              (Sample.Displacement sample1))) ->
   T s sample0 sample1
consFlip :: forall sample0 sample1 s.
(Amplitude sample0
 -> (Amplitude sample1,
     T (Displacement sample0) (Displacement sample1)))
-> T s sample0 sample1
consFlip Amplitude sample0
-> (Amplitude sample1,
    T (Displacement sample0) (Displacement sample1))
f =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \Amplitude sample0
ampIn ->
      let (Amplitude sample1
ampOut, T (Displacement sample0) (Displacement sample1)
causal) = Amplitude sample0
-> (Amplitude sample1,
    T (Displacement sample0) (Displacement sample1))
f Amplitude sample0
ampIn
      in  (forall s yv0 yv1. T yv0 yv1 -> Core s yv0 yv1
Core T (Displacement sample0) (Displacement sample1)
causal, Amplitude sample1
ampOut)


infixl 9 `apply`

{-# INLINE apply #-}
apply ::
   (SigG.Transform sig yv0, SigG.Transform sig yv1) =>
   Single s amp0 amp1 yv0 yv1 ->
   SigA.T (Rate.Phantom s) amp0 (sig yv0) ->
   SigA.T (Rate.Phantom s) amp1 (sig yv1)
apply :: forall (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Transform sig yv0, Transform sig yv1) =>
Single s amp0 amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
apply = forall (sig :: * -> *) sample0 sample1 (arrow :: * -> * -> *) rate.
(Transform sig (Displacement sample0),
 Transform sig (Displacement sample1), Applicable arrow rate) =>
T arrow sample0 sample1
-> T rate (Amplitude sample0) (sig (Displacement sample0))
-> T rate (Amplitude sample1) (sig (Displacement sample1))
ArrowD.apply

{-# INLINE applyFlat #-}
applyFlat ::
   (Flat.C yv0 amp0,
    SigG.Transform sig yv0, SigG.Transform sig yv1) =>
   Single s (Amp.Flat yv0) amp1 yv0 yv1 ->
   SigA.T (Rate.Phantom s) amp0 (sig yv0) ->
   SigA.T (Rate.Phantom s) amp1 (sig yv1)
applyFlat :: forall yv0 amp0 (sig :: * -> *) yv1 s amp1.
(C yv0 amp0, Transform sig yv0, Transform sig yv1) =>
Single s (Flat yv0) amp1 yv0 yv1
-> T (Phantom s) amp0 (sig yv0) -> T (Phantom s) amp1 (sig yv1)
applyFlat = forall yv0 amp0 (sig :: * -> *) yv1 (arrow :: * -> * -> *) rate
       amp1.
(C yv0 amp0, Transform sig yv0, Transform sig yv1,
 Applicable arrow rate) =>
Single arrow (Flat yv0) amp1 yv0 yv1
-> T rate amp0 (sig yv0) -> T rate amp1 (sig yv1)
ArrowD.applyFlat

{-# INLINE canonicalizeFlat #-}
canonicalizeFlat ::
   (Flat.C y flat) =>
   Single s flat (Amp.Flat y) y y
canonicalizeFlat :: forall y flat s. C y flat => Single s flat (Flat y) y y
canonicalizeFlat =
   forall y flat (arrow :: * -> * -> *).
(C y flat, Arrow arrow) =>
Single arrow flat (Flat y) y y
ArrowD.canonicalizeFlat


{-# INLINE applyConst #-}
applyConst ::
   (Amp.C amp1, Ring.C y0) =>
   Single s (Amp.Numeric amp0) amp1 y0 yv1 ->
   amp0 ->
   SigA.T (Rate.Phantom s) amp1 (Sig.T yv1)
applyConst :: forall amp1 y0 s amp0 yv1.
(C amp1, C y0) =>
Single s (Numeric amp0) amp1 y0 yv1
-> amp0 -> T (Phantom s) amp1 (T yv1)
applyConst = forall amp1 y0 (arrow :: * -> * -> *) amp0 yv1 s.
(C amp1, C y0, C arrow) =>
Single arrow (Numeric amp0) amp1 y0 yv1
-> amp0 -> T (Phantom s) amp1 (T yv1)
ArrowD.applyConst



infixl 0 $/:, $/-

{-# INLINE ($/:) #-}
($/:) ::
   (Applicative f,
    SigG.Transform sig yv0, SigG.Transform sig yv1) =>
   f (Single s amp0 amp1 yv0 yv1) ->
   f (SigA.T (Rate.Phantom s) amp0 (sig yv0)) ->
   f (SigA.T (Rate.Phantom s) amp1 (sig yv1))
$/: :: forall (f :: * -> *) (sig :: * -> *) yv0 yv1 s amp0 amp1.
(Applicative f, Transform sig yv0, Transform sig yv1) =>
f (Single s amp0 amp1 yv0 yv1)
-> f (T (Phantom s) amp0 (sig yv0))
-> f (T (Phantom s) amp1 (sig yv1))
($/:) = forall (f :: * -> *) (sig :: * -> *) yv0 yv1 (arrow :: * -> * -> *)
       rate amp0 amp1.
(Applicative f, Transform sig yv0, Transform sig yv1,
 Applicable arrow rate) =>
f (Single arrow amp0 amp1 yv0 yv1)
-> f (T rate amp0 (sig yv0)) -> f (T rate amp1 (sig yv1))
(ArrowD.$/:)

{-# INLINE ($/-) #-}
($/-) ::
   (Amp.C amp1, Functor f, Ring.C y0) =>
   f (Single s (Amp.Numeric amp0) amp1 y0 yv1) ->
   amp0 ->
   f (SigA.T (Rate.Phantom s) amp1 (Sig.T yv1))
$/- :: forall amp1 (f :: * -> *) y0 s amp0 yv1.
(C amp1, Functor f, C y0) =>
f (Single s (Numeric amp0) amp1 y0 yv1)
-> amp0 -> f (T (Phantom s) amp1 (T yv1))
($/-) = forall amp1 (f :: * -> *) y0 (arrow :: * -> * -> *) amp0 yv1 s.
(C amp1, Functor f, C y0, C arrow) =>
f (Single arrow (Numeric amp0) amp1 y0 yv1)
-> amp0 -> f (T (Phantom s) amp1 (T yv1))
(ArrowD.$/-)



infixl 9 `applyFst`

{-# INLINE applyFst #-}
applyFst ::
   (SigG.Read sig yv) =>
   T s (Sample.T amp yv, restSampleIn) restSampleOut ->
   SigA.T (Rate.Phantom s) amp (sig yv) ->
   T s restSampleIn restSampleOut
applyFst :: forall (sig :: * -> *) yv s amp restSampleIn restSampleOut.
Read sig yv =>
T s (T amp yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
applyFst T s (T amp yv, restSampleIn) restSampleOut
c T (Phantom s) amp (sig yv)
x = T s (T amp yv, restSampleIn) restSampleOut
c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (T amp yv, restSample)
feedFst T (Phantom s) amp (sig yv)
x

{-# INLINE applyFlatFst #-}
applyFlatFst ::
   (Flat.C yv amp, SigG.Read sig yv) =>
   T s (Sample.T (Amp.Flat yv) yv, restSampleIn) restSampleOut ->
   SigA.T (Rate.Phantom s) amp (sig yv) ->
   T s restSampleIn restSampleOut
applyFlatFst :: forall yv amp (sig :: * -> *) s restSampleIn restSampleOut.
(C yv amp, Read sig yv) =>
T s (T (Flat yv) yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
applyFlatFst T s (T (Flat yv) yv, restSampleIn) restSampleOut
c =
   forall (sig :: * -> *) yv s amp restSampleIn restSampleOut.
Read sig yv =>
T s (T amp yv, restSampleIn) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
applyFst (T s (T (Flat yv) yv, restSampleIn) restSampleOut
c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall y flat s. C y flat => Single s flat (Flat y) y y
canonicalizeFlat)


{-# INLINE feedFst #-}
feedFst ::
   (SigG.Read sig yv) =>
   SigA.T (Rate.Phantom s) amp (sig yv) ->
   T s restSample (Sample.T amp yv, restSample)
feedFst :: forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (T amp yv, restSample)
feedFst T (Phantom s) amp (sig yv)
x =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \Amplitude restSample
yAmp ->
      (forall s yv0 yv1. T yv0 yv1 -> Core s yv0 yv1
Core forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) a b. Read sig a => sig a -> T b (a, b)
Causal.feedFst (forall rate amplitude body. T rate amplitude body -> body
SigA.body T (Phantom s) amp (sig yv)
x), (forall rate amplitude body. T rate amplitude body -> amplitude
SigA.amplitude T (Phantom s) amp (sig yv)
x, Amplitude restSample
yAmp))


{-# INLINE applySnd #-}
applySnd ::
   (SigG.Read sig yv) =>
   T s (restSampleIn, Sample.T amp yv) restSampleOut ->
   SigA.T (Rate.Phantom s) amp (sig yv) ->
   T s restSampleIn restSampleOut
applySnd :: forall (sig :: * -> *) yv s restSampleIn amp restSampleOut.
Read sig yv =>
T s (restSampleIn, T amp yv) restSampleOut
-> T (Phantom s) amp (sig yv) -> T s restSampleIn restSampleOut
applySnd T s (restSampleIn, T amp yv) restSampleOut
c T (Phantom s) amp (sig yv)
x = T s (restSampleIn, T amp yv) restSampleOut
c forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (restSample, T amp yv)
feedSnd T (Phantom s) amp (sig yv)
x

{-# INLINE feedSnd #-}
feedSnd ::
   (SigG.Read sig yv) =>
   SigA.T (Rate.Phantom s) amp (sig yv) ->
   T s restSample (restSample, Sample.T amp yv)
feedSnd :: forall (sig :: * -> *) yv s amp restSample.
Read sig yv =>
T (Phantom s) amp (sig yv) -> T s restSample (restSample, T amp yv)
feedSnd T (Phantom s) amp (sig yv)
x =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \Amplitude restSample
yAmp ->
      (forall s yv0 yv1. T yv0 yv1 -> Core s yv0 yv1
Core forall a b. (a -> b) -> a -> b
$ forall (sig :: * -> *) a b. Read sig a => sig a -> T b (b, a)
Causal.feedSnd (forall rate amplitude body. T rate amplitude body -> body
SigA.body T (Phantom s) amp (sig yv)
x), (Amplitude restSample
yAmp, forall rate amplitude body. T rate amplitude body -> amplitude
SigA.amplitude T (Phantom s) amp (sig yv)
x))


{-# INLINE map #-}
map ::
   Map.T sample0 sample1 ->
   T s sample0 sample1
map :: forall sample0 sample1 s. T sample0 sample1 -> T s sample0 sample1
map (ArrowD.Cons Amplitude sample0
-> (Displacement sample0 -> Displacement sample1,
    Amplitude sample1)
f) =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amplitude sample0
-> (Displacement sample0 -> Displacement sample1,
    Amplitude sample1)
f


infixr 1 ^>>, >>^
infixr 1 ^<<, <<^

{-# INLINE (^>>) #-}
-- | Precomposition with a pure function.
(^>>) ::
   Map.T sample0 sample1 ->
   T s sample1 sample2 ->
   T s sample0 sample2
T sample0 sample1
f ^>> :: forall sample0 sample1 s sample2.
T sample0 sample1 -> T s sample1 sample2 -> T s sample0 sample2
^>> T s sample1 sample2
a = forall sample0 sample1 s. T sample0 sample1 -> T s sample0 sample1
map T sample0 sample1
f forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> T s sample1 sample2
a

{-# INLINE (>>^) #-}
-- | Postcomposition with a pure function.
(>>^) ::
   T s sample0 sample1 ->
   Map.T sample1 sample2 ->
   T s sample0 sample2
T s sample0 sample1
a >>^ :: forall s sample0 sample1 sample2.
T s sample0 sample1 -> T sample1 sample2 -> T s sample0 sample2
>>^ T sample1 sample2
f = T s sample0 sample1
a forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall sample0 sample1 s. T sample0 sample1 -> T s sample0 sample1
map T sample1 sample2
f

{-# INLINE (<<^) #-}
-- | Precomposition with a pure function (right-to-left variant).
(<<^) ::
   T s sample1 sample2 ->
   Map.T sample0 sample1 ->
   T s sample0 sample2
T s sample1 sample2
a <<^ :: forall s sample1 sample2 sample0.
T s sample1 sample2 -> T sample0 sample1 -> T s sample0 sample2
<<^ T sample0 sample1
f = T s sample1 sample2
a forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< forall sample0 sample1 s. T sample0 sample1 -> T s sample0 sample1
map T sample0 sample1
f

{-# INLINE (^<<) #-}
-- | Postcomposition with a pure function (right-to-left variant).
(^<<) ::
   Map.T sample1 sample2 ->
   T s sample0 sample1 ->
   T s sample0 sample2
T sample1 sample2
f ^<< :: forall sample1 sample2 s sample0.
T sample1 sample2 -> T s sample0 sample1 -> T s sample0 sample2
^<< T s sample0 sample1
a = forall sample0 sample1 s. T sample0 sample1 -> T s sample0 sample1
map T sample1 sample2
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
<<< T s sample0 sample1
a


{- |
Lift a low-level homogeneous process to a dimensional one.

Note that the @amp@ type variable is unrestricted.
This way we show, that the amplitude is not touched,
which also means that the underlying low-level process must be homogeneous.
-}
{-# INLINE homogeneous #-}
homogeneous ::
   Causal.T yv0 yv1 ->
   Single s amp amp yv0 yv1
homogeneous :: forall yv0 yv1 s amp. T yv0 yv1 -> Single s amp amp yv0 yv1
homogeneous T yv0 yv1
c =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
ArrowD.Cons forall a b. (a -> b) -> a -> b
$ \ Amplitude (T amp yv0)
xAmp -> (forall s yv0 yv1. T yv0 yv1 -> Core s yv0 yv1
Core T yv0 yv1
c, Amplitude (T amp yv0)
xAmp)


{-# INLINE id #-}
id ::
   T s sample sample
id :: forall s sample. T s sample sample
id =
   forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
ArrowD.id


{-# INLINE loop2Volume #-}
loop2Volume ::
   (Field.C y0, Module.C y0 yv0, Dim.C v0,
    Field.C y1, Module.C y1 yv1, Dim.C v1) =>
   (DN.T v0 y0, DN.T v1 y1) ->
   T s
     (restSampleIn,  (Sample.T (Amp.Dimensional v0 y0) yv0,
                      Sample.T (Amp.Dimensional v1 y1) yv1))
     (restSampleOut, (Sample.T (Amp.Dimensional v0 y0) yv0,
                      Sample.T (Amp.Dimensional v1 y1) yv1)) ->
   T s restSampleIn restSampleOut
loop2Volume :: forall y0 yv0 v0 y1 yv1 v1 s restSampleIn restSampleOut.
(C y0, C y0 yv0, C v0, C y1, C y1 yv1, C v1) =>
(T v0 y0, T v1 y1)
-> T s
     (restSampleIn,
      (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
     (restSampleOut,
      (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
-> T s restSampleIn restSampleOut
loop2Volume (T v0 y0
amp0,T v1 y1
amp1) T s
  (restSampleIn,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
  (restSampleOut,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
p =
   forall y yv v (arrow :: * -> * -> *) restSampleIn restSampleOut.
(C y, C y yv, C v, ArrowLoop arrow) =>
T v y
-> T arrow
     (restSampleIn, T (Dimensional v y) yv)
     (restSampleOut, T (Dimensional v y) yv)
-> T arrow restSampleIn restSampleOut
ArrowD.loopVolume T v0 y0
amp0 forall a b. (a -> b) -> a -> b
$
   forall y yv v (arrow :: * -> * -> *) restSampleIn restSampleOut.
(C y, C y yv, C v, ArrowLoop arrow) =>
T v y
-> T arrow
     (restSampleIn, T (Dimensional v y) yv)
     (restSampleOut, T (Dimensional v y) yv)
-> T arrow restSampleIn restSampleOut
ArrowD.loopVolume T v1 y1
amp1 forall a b. (a -> b) -> a -> b
$
   (forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow ((sample0, sample1), sample2) (sample0, (sample1, sample2))
Map.balanceRight forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> T s
  (restSampleIn,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
  (restSampleOut,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
p forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Arrow arrow =>
T arrow (sample0, (sample1, sample2)) ((sample0, sample1), sample2)
Map.balanceLeft)
-- alternative implementation to ArrowD.loop2Volume