{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{- |
A wrapper around @(->)@ or @Causal.Process@
that adds amplitude handling to the Arrow paradigm.
This wrapper unifies "Synthesizer.Dimensional.Map"
and "Synthesizer.Dimensional.Causal.Process".
-}
module Synthesizer.Dimensional.Arrow where

import qualified Synthesizer.Dimensional.Sample as Sample
import Synthesizer.Dimensional.Sample (Amplitude, Displacement, )

import qualified Synthesizer.Dimensional.Signal.Private as SigA
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 Control.Arrow as Arrow
import qualified Control.Category as Category
import Control.Arrow (Arrow, ArrowLoop, (>>>), (***), )
import Control.Category (Category, )

import Control.Applicative (Applicative, liftA2, )

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 Algebra.Module ((*>))

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

import NumericPrelude.Numeric (one)
import NumericPrelude.Base hiding (id)
import Prelude ()



{- |
The sample type parameters
can be arbitrarily nested tuples of 'Samples'.
Type functions are used for untangling amplitudes and displacements.
We use this approach in order to be able to match
(as good as possible) the Arrow type class.
-}
newtype T arrow sample0 sample1 =
   Cons (Amplitude sample0 ->
            (arrow (Displacement sample0) (Displacement sample1),
             Amplitude sample1))

type Single arrow amp0 amp1 yv0 yv1 =
        T arrow (Sample.T amp0 yv0) (Sample.T amp1 yv1)


{-
It is tempting to declare a rate parameter for the process type,
instead of putting the rate phantom into the arrow.
However, Map would then be defined as

> type Map amp0 amp1 yv0 yv1 = T (forall rate. rate) amp0 amp1 (yv0->yv1)@

which is at least ugly. Even more, in module Rate we would need

> class Applicable process signal | signal -> process
> instance Applicable (Phantom s) (Phantom s)
> instance Applicable (forall process. process) (Actual rate)

and this is not possible, at all.

With the current approach we can have
both generic apply functions and generic arrow combinators.
-}

class CausalArrow.C arrow => Applicable arrow rate

instance Applicable (->) rate




infixl 9 `apply`

-- we need this generality in ControlledProcess.applyConverter
{-# INLINE apply #-}
apply ::
   (SigG.Transform sig (Displacement sample0),
    SigG.Transform sig (Displacement sample1),
    Applicable arrow rate) =>
   T arrow sample0 sample1 ->
   SigA.T rate (Amplitude sample0) (sig (Displacement sample0)) ->
   SigA.T rate (Amplitude sample1) (sig (Displacement sample1))
{-
   (SigG.Transform sig yv0, SigG.Transform sig yv1, Applicable arrow rate) =>
   Single arrow amp0 amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate 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))
apply (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f) (SigA.Cons rate
rate Amplitude sample0
xAmp sig (Displacement sample0)
samples) =
   let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f Amplitude sample0
xAmp
   in  forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons rate
rate Amplitude sample1
yAmp (forall (arrow :: * -> * -> *) (sig :: * -> *) a b.
(C arrow, Transform sig a, Transform sig b) =>
arrow a b -> sig a -> sig b
CausalArrow.apply arrow (Displacement sample0) (Displacement sample1)
arrow sig (Displacement sample0)
samples)

{-# INLINE applyFlat #-}
applyFlat ::
   (Flat.C yv0 amp0,
    SigG.Transform sig yv0,
    SigG.Transform sig yv1, Applicable arrow rate) =>
   Single arrow (Amp.Flat yv0) amp1 yv0 yv1 ->
   SigA.T rate amp0 (sig yv0) ->
   SigA.T rate 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)
applyFlat Single arrow (Flat yv0) amp1 yv0 yv1
f =
   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))
apply (forall y flat (arrow :: * -> * -> *).
(C y flat, Arrow arrow) =>
Single arrow flat (Flat y) y y
canonicalizeFlat forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Single arrow (Flat yv0) amp1 yv0 yv1
f)

{-# INLINE canonicalizeFlat #-}
canonicalizeFlat ::
   (Flat.C y flat, Arrow arrow) =>
   Single arrow flat (Amp.Flat y) y y
canonicalizeFlat :: forall y flat (arrow :: * -> * -> *).
(C y flat, Arrow arrow) =>
Single arrow flat (Flat y) y y
canonicalizeFlat =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ Amplitude (T flat y)
amp -> (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr (forall y amp. C y amp => amp -> y -> y
Flat.amplifySample Amplitude (T flat y)
amp), forall y. Flat y
Amp.Flat)


{-# INLINE applyConst #-}
applyConst ::
   (Amp.C amp1, Ring.C y0, CausalArrow.C arrow) =>
   Single arrow (Amp.Numeric amp0) amp1 y0 yv1 ->
   amp0 ->
   SigA.T (Rate.Phantom s) amp1 (Sig.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)
applyConst (Cons Amplitude (T (Numeric amp0) y0)
-> (arrow
      (Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1)),
    Amplitude (T amp1 yv1))
f) amp0
x =
   let (arrow
  (Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1))
arrow, Amplitude (T amp1 yv1)
yAmp) = Amplitude (T (Numeric amp0) y0)
-> (arrow
      (Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1)),
    Amplitude (T amp1 yv1))
f (forall amp. amp -> Numeric amp
Amp.Numeric amp0
x)
   in  forall rate amplitude body.
rate -> amplitude -> body -> T rate amplitude body
SigA.Cons forall s. Phantom s
Rate.Phantom Amplitude (T amp1 yv1)
yAmp
          (forall (arrow :: * -> * -> *) (sig :: * -> *) a b.
(C arrow, Transform sig a, Transform sig b) =>
arrow a b -> sig a -> sig b
CausalArrow.apply arrow
  (Displacement (T (Numeric amp0) y0)) (Displacement (T amp1 yv1))
arrow (forall a. a -> T a
Sig.repeat forall a. C a => a
one))


infixl 0 $/:, $/-

{-# INLINE ($/:) #-}
($/:) ::
   (Applicative f,
    SigG.Transform sig yv0, SigG.Transform sig yv1,
    Applicable arrow rate) =>
   f (Single arrow amp0 amp1 yv0 yv1) ->
   f (SigA.T rate amp0 (sig yv0)) ->
   f (SigA.T rate 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))
($/:) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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))
apply

{-# INLINE ($/-) #-}
($/-) ::
   (Amp.C amp1, Functor f, Ring.C y0, CausalArrow.C arrow) =>
   f (Single arrow (Amp.Numeric amp0) amp1 y0 yv1) ->
   amp0 ->
   f (SigA.T (Rate.Phantom s) amp1 (Sig.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))
($/-) f (Single arrow (Numeric amp0) amp1 y0 yv1)
p amp0
x = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> b -> a -> c
flip 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)
applyConst amp0
x) f (Single arrow (Numeric amp0) amp1 y0 yv1)
p



{-# INLINE id #-}
id ::
   (Category arrow) =>
   T arrow sample sample
id :: forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
id =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons (\Amplitude sample
amp -> (forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Category.id, Amplitude sample
amp))


{-# INLINE compose #-}
compose ::
   (Category arrow) =>
   T arrow sample0 sample1 ->
   T arrow sample1 sample2 ->
   T arrow sample0 sample2
compose :: forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f) (Cons Amplitude sample1
-> (arrow (Displacement sample1) (Displacement sample2),
    Amplitude sample2)
g) =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ Amplitude sample0
xAmp ->
      let (arrow (Displacement sample0) (Displacement sample1)
causalXY, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f Amplitude sample0
xAmp
          (arrow (Displacement sample1) (Displacement sample2)
causalYZ, Amplitude sample2
zAmp) = Amplitude sample1
-> (arrow (Displacement sample1) (Displacement sample2),
    Amplitude sample2)
g Amplitude sample1
yAmp
      in  (arrow (Displacement sample0) (Displacement sample1)
causalXY forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
Arrow.>>> arrow (Displacement sample1) (Displacement sample2)
causalYZ, Amplitude sample2
zAmp)


instance (Category arrow) => Category (T arrow) where
   {-# INLINE id #-}
   id :: forall a. T arrow a a
id = forall (arrow :: * -> * -> *) sample.
Category arrow =>
T arrow sample sample
id
   {-# INLINE (.) #-}
   . :: forall b c a. T arrow b c -> T arrow a b -> T arrow a c
(.) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose


{- |
This instance lacks an implementation for 'arr'.
However the syntactic sugar for arrows
uses 'arr' for shuffling the operands.
Actually shuffling is possible for our arrow,
but lifting general functions is a problem.
If you want to use arrow syntax,
you should hide the 'arr' from Control.Arrow
and use the one provided as plain function, here.
-}
instance (Arrow arrow) => Arrow (T arrow) where
   {-# INLINE first #-}
   {-# INLINE second #-}
   {-# INLINE (***) #-}
   {-# INLINE (&&&) #-}

   arr :: forall b c. (b -> c) -> T arrow b c
arr = forall a. HasCallStack => [Char] -> a
error [Char]
"Dimensional.Arrow.arr: sorry, there is no reasonable implementation"
   first :: forall b c d. T arrow b c -> T arrow (b, d) (c, d)
first  = forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first
   second :: forall b c d. T arrow b c -> T arrow (d, b) (d, c)
second = forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second
   *** :: forall b c b' c'.
T arrow b c -> T arrow b' c' -> T arrow (b, b') (c, c')
(***)  = forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split
   &&& :: forall b c c'. T arrow b c -> T arrow b c' -> T arrow b (c, c')
(&&&)  = forall (arrow :: * -> * -> *) sample sample0 sample1.
Arrow arrow =>
T arrow sample sample0
-> T arrow sample sample1 -> T arrow sample (sample0, sample1)
fanout


{- |
This implementation would work for all 'f's
where the output amplitude does not depend on the input displacement.
This is true for all shuffling operations
that are needed in the translation of the arrow syntax.
However, for the implementation we would need type constraints
of the function passed to 'arr'
and this is not allowed.
-}
{-# INLINE arr #-}
arr ::
   (Arrow arrow, Sample.Build sample0, Sample.Inspect sample1) =>
   (sample0 -> sample1) -> T arrow sample0 sample1
arr :: forall (arrow :: * -> * -> *) sample0 sample1.
(Arrow arrow, Build sample0, Inspect sample1) =>
(sample0 -> sample1) -> T arrow sample0 sample1
arr sample0 -> sample1
f = forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \Amplitude sample0
amp0 ->
   (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr forall a b. (a -> b) -> a -> b
$ \Displacement sample0
yv0 ->
       forall sample. Inspect sample => sample -> Displacement sample
Sample.displacement forall a b. (a -> b) -> a -> b
$ sample0 -> sample1
f forall a b. (a -> b) -> a -> b
$ forall sample.
Build sample =>
Amplitude sample -> Displacement sample -> sample
Sample.build Amplitude sample0
amp0 Displacement sample0
yv0,
    forall sample. Inspect sample => sample -> Amplitude sample
Sample.amplitude forall a b. (a -> b) -> a -> b
$ sample0 -> sample1
f forall a b. (a -> b) -> a -> b
$ forall sample.
Build sample =>
Amplitude sample -> Displacement sample -> sample
Sample.build Amplitude sample0
amp0 forall a b. (a -> b) -> a -> b
$
       forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Dimensional.Arrow.arr: " forall a. [a] -> [a] -> [a]
++
               [Char]
"output amplitude must not depend on input displacement")

{-# INLINE first #-}
first ::
   (Arrow arrow) =>
   T arrow sample0 sample1 ->
   T arrow (sample0, sample) (sample1, sample)
first :: forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f) =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ (Amplitude sample0
xAmp, Amplitude sample
amp) ->
      let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f Amplitude sample0
xAmp
      in  (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
Arrow.first arrow (Displacement sample0) (Displacement sample1)
arrow, (Amplitude sample1
yAmp, Amplitude sample
amp))

{-# INLINE second #-}
second ::
   (Arrow arrow) =>
   T arrow sample0 sample1 ->
   T arrow (sample, sample0) (sample, sample1)
second :: forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second (Cons Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f) =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \ (Amplitude sample
amp, Amplitude sample0
xAmp) ->
      let (arrow (Displacement sample0) (Displacement sample1)
arrow, Amplitude sample1
yAmp) = Amplitude sample0
-> (arrow (Displacement sample0) (Displacement sample1),
    Amplitude sample1)
f Amplitude sample0
xAmp
      in  (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
Arrow.second arrow (Displacement sample0) (Displacement sample1)
arrow, (Amplitude sample
amp, Amplitude sample1
yAmp))

{-# INLINE split #-}
split ::
   (Arrow arrow) =>
   T arrow sample0 sample1 ->
   T arrow sample2 sample3 ->
   T arrow (sample0, sample2) (sample1, sample3)
split :: forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split T arrow sample0 sample1
f T arrow sample2 sample3
g =
   forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose (forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample0, sample) (sample1, sample)
first T arrow sample0 sample1
f) (forall (arrow :: * -> * -> *) sample0 sample1 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second T arrow sample2 sample3
g)

{-# INLINE fanout #-}
fanout ::
   (Arrow arrow) =>
   T arrow sample sample0 ->
   T arrow sample sample1 ->
   T arrow sample (sample0, sample1)
fanout :: forall (arrow :: * -> * -> *) sample sample0 sample1.
Arrow arrow =>
T arrow sample sample0
-> T arrow sample sample1 -> T arrow sample (sample0, sample1)
fanout T arrow sample sample0
f T arrow sample sample1
g =
   forall (arrow :: * -> * -> *) sample0 sample1 sample2.
Category arrow =>
T arrow sample0 sample1
-> T arrow sample1 sample2 -> T arrow sample0 sample2
compose forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
double (forall (arrow :: * -> * -> *) sample0 sample1 sample2 sample3.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow sample2 sample3
-> T arrow (sample0, sample2) (sample1, sample3)
split T arrow sample sample0
f T arrow sample sample1
g)




-- * map functions

{-
This has become a bit safer by the use of type families,
since now we can assert that amplitude and displacement tuples match.
Unless someone adds inappropriate type instances.
-}
independentMap ::
   (Arrow arrow) =>
   (Amplitude sample0 -> Amplitude sample1) ->
   (Displacement sample0 -> Displacement sample1) ->
   T arrow sample0 sample1
independentMap :: forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independentMap Amplitude sample0 -> Amplitude sample1
f Displacement sample0 -> Displacement sample1
g =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons (\Amplitude sample0
amp -> (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr Displacement sample0 -> Displacement sample1
g, Amplitude sample0 -> Amplitude sample1
f Amplitude sample0
amp))

double ::
   (Arrow arrow) =>
   T arrow sample (sample, sample)
double :: forall (arrow :: * -> * -> *) sample.
Arrow arrow =>
T arrow sample (sample, sample)
double =
   let aux :: sample -> (sample, sample)
       aux :: forall sample. sample -> (sample, sample)
aux sample
x = (sample
x, sample
x)
   in  forall (arrow :: * -> * -> *) sample0 sample1.
Arrow arrow =>
(Amplitude sample0 -> Amplitude sample1)
-> (Displacement sample0 -> Displacement sample1)
-> T arrow sample0 sample1
independentMap forall sample. sample -> (sample, sample)
aux forall sample. sample -> (sample, sample)
aux

{-# INLINE forceDimensionalAmplitude #-}
forceDimensionalAmplitude ::
   (Dim.C v, Field.C y, Module.C y yv, Arrow arrow) =>
   DN.T v y ->
   Single arrow (Amp.Dimensional v y) (Amp.Dimensional v y) yv yv
forceDimensionalAmplitude :: forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v y
ampOut =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \(Amp.Numeric T v y
ampIn) ->
      (forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
Arrow.arr (forall u a. (C u, C a) => T u a -> T u a -> a
DN.divToScalar T v y
ampIn T v y
ampOut forall a v. C a v => a -> v -> v
*>),
       forall amp. amp -> Numeric amp
Amp.Numeric T v y
ampOut)



{- |
I will call the connection from input to output amplitudes of type @amp@
the looping channel.
It is essential, that the looping channel decouples output from input amplitude.
You can achieve this by inserting one of the @forceAmplitude@ functions
somewhere in the looping channel.
-}
{-# INLINE loop #-}
loop ::
   (ArrowLoop arrow) =>
   T arrow (restSampleIn, sample) (restSampleOut, sample) ->
   T arrow restSampleIn restSampleOut
loop :: forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (Cons Amplitude (restSampleIn, sample)
-> (arrow
      (Displacement (restSampleIn, sample))
      (Displacement (restSampleOut, sample)),
    Amplitude (restSampleOut, sample))
f) =
   forall (arrow :: * -> * -> *) sample0 sample1.
(Amplitude sample0
 -> (arrow (Displacement sample0) (Displacement sample1),
     Amplitude sample1))
-> T arrow sample0 sample1
Cons forall a b. (a -> b) -> a -> b
$ \Amplitude restSampleIn
restAmpIn ->
      let (arrow
  (Displacement restSampleIn, Displacement sample)
  (Displacement restSampleOut, Displacement sample)
arrow, (Amplitude restSampleOut
restAmpOut, Amplitude sample
amp)) = Amplitude (restSampleIn, sample)
-> (arrow
      (Displacement (restSampleIn, sample))
      (Displacement (restSampleOut, sample)),
    Amplitude (restSampleOut, sample))
f (Amplitude restSampleIn
restAmpIn, Amplitude sample
amp)
      in  (forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
Arrow.loop arrow
  (Displacement restSampleIn, Displacement sample)
  (Displacement restSampleOut, Displacement sample)
arrow, Amplitude restSampleOut
restAmpOut)


{-# INLINE loopVolume #-}
loopVolume ::
   (Field.C y, Module.C y yv, Dim.C v,
    ArrowLoop arrow) =>
   DN.T v y ->
   T arrow
     (restSampleIn,  Sample.T (Amp.Dimensional v y) yv)
     (restSampleOut, Sample.T (Amp.Dimensional v y) yv) ->
   T arrow restSampleIn restSampleOut
loopVolume :: 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
loopVolume T v y
ampIn T arrow
  (restSampleIn, T (Dimensional v y) yv)
  (restSampleOut, T (Dimensional v y) yv)
f =
   forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (T arrow
  (restSampleIn, T (Dimensional v y) yv)
  (restSampleOut, T (Dimensional v y) yv)
f 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 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second (forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v y
ampIn))


{-# INLINE loop2Volume #-}
loop2Volume ::
   (Field.C y0, Module.C y0 yv0, Dim.C v0,
    Field.C y1, Module.C y1 yv1, Dim.C v1,
    ArrowLoop arrow) =>
   (DN.T v0 y0, DN.T v1 y1) ->
   T arrow
     (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 arrow restSampleIn restSampleOut
loop2Volume :: forall y0 yv0 v0 y1 yv1 v1 (arrow :: * -> * -> *) restSampleIn
       restSampleOut.
(C y0, C y0 yv0, C v0, C y1, C y1 yv1, C v1, ArrowLoop arrow) =>
(T v0 y0, T v1 y1)
-> T arrow
     (restSampleIn,
      (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
     (restSampleOut,
      (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
-> T arrow restSampleIn restSampleOut
loop2Volume (T v0 y0
ampIn0,T v1 y1
ampIn1) T arrow
  (restSampleIn,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
  (restSampleOut,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
f =
   forall (arrow :: * -> * -> *) restSampleIn sample restSampleOut.
ArrowLoop arrow =>
T arrow (restSampleIn, sample) (restSampleOut, sample)
-> T arrow restSampleIn restSampleOut
loop (T arrow
  (restSampleIn,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
  (restSampleOut,
   (T (Dimensional v0 y0) yv0, T (Dimensional v1 y1) yv1))
f 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 sample.
Arrow arrow =>
T arrow sample0 sample1
-> T arrow (sample, sample0) (sample, sample1)
second
      (forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v0 y0
ampIn0 forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
***
       forall v y yv (arrow :: * -> * -> *).
(C v, C y, C y yv, Arrow arrow) =>
T v y -> Single arrow (Dimensional v y) (Dimensional v y) yv yv
forceDimensionalAmplitude T v1 y1
ampIn1))