module Synthesizer.Plain.Signal where
import qualified Number.Peano as Peano
import qualified Synthesizer.Plain.Modifier as Modifier
import qualified Data.List.Match as ListMatch
import qualified Data.List.HT as ListHT
import qualified Data.List as List
import Data.Tuple.HT (forcePair, mapFst, mapSnd, )
type T = []
type Modifier s ctrl a b = Modifier.Simple s ctrl a b
modifyStatic ::
Modifier s ctrl a b -> ctrl -> T a -> T b
modifyStatic :: forall s ctrl a b. Modifier s ctrl a b -> ctrl -> T a -> T b
modifyStatic = Simple s ctrl a b -> ctrl -> T a -> T b
forall s ctrl a b. Modifier s ctrl a b -> ctrl -> T a -> T b
Modifier.static
modifyModulated ::
Modifier s ctrl a b -> T ctrl -> T a -> T b
modifyModulated :: forall s ctrl a b. Modifier s ctrl a b -> T ctrl -> T a -> T b
modifyModulated = Simple s ctrl a b -> T ctrl -> T a -> T b
forall s ctrl a b. Modifier s ctrl a b -> T ctrl -> T a -> T b
Modifier.modulated
type ModifierInit s init ctrl a b = Modifier.Initialized s init ctrl a b
modifierInitialize ::
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
modifierInitialize :: forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
modifierInitialize = Initialized s init ctrl a b -> init -> Simple s ctrl a b
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> Modifier s ctrl a b
Modifier.initialize
modifyStaticInit ::
ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
modifyStaticInit :: forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
modifyStaticInit = Initialized s init ctrl a b -> init -> ctrl -> T a -> T b
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> ctrl -> T a -> T b
Modifier.staticInit
modifyModulatedInit ::
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
modifyModulatedInit :: forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
modifyModulatedInit = Initialized s init ctrl a b -> init -> T ctrl -> T a -> T b
forall s init ctrl a b.
ModifierInit s init ctrl a b -> init -> T ctrl -> T a -> T b
Modifier.modulatedInit
unfoldR :: (acc -> Maybe (y, acc)) -> acc -> (acc, T y)
unfoldR :: forall acc y. (acc -> Maybe (y, acc)) -> acc -> (acc, T y)
unfoldR acc -> Maybe (y, acc)
f =
let recourse :: acc -> (acc, [y])
recourse acc
acc0 =
(acc, [y]) -> (acc, [y])
forall a b. (a, b) -> (a, b)
forcePair ((acc, [y]) -> (acc, [y])) -> (acc, [y]) -> (acc, [y])
forall a b. (a -> b) -> a -> b
$
(acc, [y])
-> ((y, acc) -> (acc, [y])) -> Maybe (y, acc) -> (acc, [y])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(acc
acc0,[])
(\(y
y,acc
acc1) ->
([y] -> [y]) -> (acc, [y]) -> (acc, [y])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:) ((acc, [y]) -> (acc, [y])) -> (acc, [y]) -> (acc, [y])
forall a b. (a -> b) -> a -> b
$ acc -> (acc, [y])
recourse acc
acc1)
(acc -> Maybe (y, acc)
f acc
acc0)
in acc -> (acc, [y])
recourse
reduceL :: (x -> acc -> Maybe acc) -> acc -> T x -> acc
reduceL :: forall x acc. (x -> acc -> Maybe acc) -> acc -> T x -> acc
reduceL x -> acc -> Maybe acc
f =
let recourse :: acc -> [x] -> acc
recourse acc
a [x]
xt =
case [x]
xt of
[] -> acc
a
(x
x:[x]
xs) ->
acc -> (acc -> acc) -> Maybe acc -> acc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe acc
a
(\ acc
a' -> acc -> acc -> acc
forall a b. a -> b -> b
seq acc
a' (acc -> [x] -> acc
recourse acc
a' [x]
xs))
(x -> acc -> Maybe acc
f x
x acc
a)
in acc -> [x] -> acc
recourse
mapAccumL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL :: forall x acc y.
(x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL x -> acc -> Maybe (y, acc)
f =
let recourse :: acc -> [x] -> (acc, [y])
recourse acc
acc0 [x]
xt =
(acc, [y]) -> (acc, [y])
forall a b. (a, b) -> (a, b)
forcePair ((acc, [y]) -> (acc, [y])) -> (acc, [y]) -> (acc, [y])
forall a b. (a -> b) -> a -> b
$
case [x]
xt of
[] -> (acc
acc0,[])
(x
x:[x]
xs) ->
(acc, [y])
-> ((y, acc) -> (acc, [y])) -> Maybe (y, acc) -> (acc, [y])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(acc
acc0,[])
(\(y
y,acc
acc1) ->
([y] -> [y]) -> (acc, [y]) -> (acc, [y])
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (y
yy -> [y] -> [y]
forall a. a -> [a] -> [a]
:) ((acc, [y]) -> (acc, [y])) -> (acc, [y]) -> (acc, [y])
forall a b. (a -> b) -> a -> b
$ acc -> [x] -> (acc, [y])
recourse acc
acc1 [x]
xs)
(x -> acc -> Maybe (y, acc)
f x
x acc
acc0)
in acc -> [x] -> (acc, [y])
recourse
crochetL :: (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL :: forall x acc y. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> T y
crochetL x -> acc -> Maybe (y, acc)
f acc
a = (acc, T y) -> T y
forall a b. (a, b) -> b
snd ((acc, T y) -> T y) -> (T x -> (acc, T y)) -> T x -> T y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
forall x acc y.
(x -> acc -> Maybe (y, acc)) -> acc -> T x -> (acc, T y)
mapAccumL x -> acc -> Maybe (y, acc)
f acc
a
fix1 :: y -> (T y -> T y) -> T y
fix1 :: forall y. y -> (T y -> T y) -> T y
fix1 y
pad T y -> T y
f =
let y :: T y
y = T y -> T y
f (y
pady -> T y -> T y
forall a. a -> [a] -> [a]
:T y
y)
in T y
y
{-# RULES
"fix1/crochetL" forall f a b.
fix1 a (crochetL f b) =
snd $ unfoldR (\(a0,b0) ->
do yb1@(y0,_) <- f a0 b0
return (y0, yb1)) (a,b) ;
#-}
dropMarginRem :: Int -> Int -> T a -> (Int, T a)
dropMarginRem :: forall a. Int -> Int -> T a -> (Int, T a)
dropMarginRem Int
n Int
m =
[(Int, T a)] -> (Int, T a)
forall a. HasCallStack => [a] -> a
head ([(Int, T a)] -> (Int, T a))
-> (T a -> [(Int, T a)]) -> T a -> (Int, T a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Int -> [(Int, T a)] -> [(Int, T a)]
forall a. Int -> Int -> T a -> T a
dropMargin (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) Int
m ([(Int, T a)] -> [(Int, T a)])
-> (T a -> [(Int, T a)]) -> T a -> [(Int, T a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Int] -> [T a] -> [(Int, T a)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Int) -> Int -> [Int]
forall a. (a -> a) -> a -> [a]
iterate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
pred) Int
m) ([T a] -> [(Int, T a)]) -> (T a -> [T a]) -> T a -> [(Int, T a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
T a -> [T a]
forall a. [a] -> [[a]]
ListHT.tails
dropMargin :: Int -> Int -> T a -> T a
dropMargin :: forall a. Int -> Int -> T a -> T a
dropMargin Int
n Int
m T a
xs =
T a -> T a -> T a
forall b a. [b] -> [a] -> [a]
ListMatch.drop (Int -> T a -> T a
forall a. Int -> [a] -> [a]
take Int
m (Int -> T a -> T a
forall a. Int -> [a] -> [a]
drop Int
n T a
xs)) T a
xs
lengthAtLeast :: Int -> T a -> Bool
lengthAtLeast :: forall a. Int -> T a -> Bool
lengthAtLeast Int
n T a
xs =
Int
nInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=Int
0 Bool -> Bool -> Bool
|| Bool -> Bool
not (T a -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Int -> T a -> T a
forall a. Int -> [a] -> [a]
drop (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) T a
xs))
zipWithTails ::
(y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails :: forall y0 y1 y2. (y0 -> T y1 -> y2) -> T y0 -> T y1 -> T y2
zipWithTails y0 -> T y1 -> y2
f T y0
xs =
(y0 -> T y1 -> y2) -> T y0 -> [T y1] -> [y2]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith y0 -> T y1 -> y2
f T y0
xs ([T y1] -> [y2]) -> (T y1 -> [T y1]) -> T y1 -> [y2]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [T y1] -> [T y1]
forall a. HasCallStack => [a] -> [a]
init ([T y1] -> [T y1]) -> (T y1 -> [T y1]) -> T y1 -> [T y1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T y1 -> [T y1]
forall a. [a] -> [[a]]
ListHT.tails
zipWithRest ::
(y0 -> y0 -> y1) ->
T y0 -> T y0 ->
(T y1, (Bool, T y0))
zipWithRest :: forall y0 y1.
(y0 -> y0 -> y1) -> T y0 -> T y0 -> (T y1, (Bool, T y0))
zipWithRest y0 -> y0 -> y1
f T y0
xs T y0
ys =
let len :: T
len = T -> T -> T
forall a. Ord a => a -> a -> a
min (T y0 -> T
forall i a. Num i => [a] -> i
List.genericLength T y0
xs) (T y0 -> T
forall i a. Num i => [a] -> i
List.genericLength T y0
ys) :: Peano.T
(T y0
prefixX,T y0
suffixX) = T -> T y0 -> (T y0, T y0)
forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt T
len T y0
xs
(T y0
prefixY,T y0
suffixY) = T -> T y0 -> (T y0, T y0)
forall i a. Integral i => i -> [a] -> ([a], [a])
List.genericSplitAt T
len T y0
ys
second :: Bool
second = T y0 -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null T y0
suffixX
in ((y0 -> y0 -> y1) -> T y0 -> T y0 -> [y1]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith y0 -> y0 -> y1
f T y0
prefixX T y0
prefixY,
(Bool
second, if Bool
second then T y0
suffixY else T y0
suffixX))
zipWithRestRec ::
(y0 -> y0 -> y1) ->
T y0 -> T y0 ->
(T y1, (Bool, T y0))
zipWithRestRec :: forall y0 y1.
(y0 -> y0 -> y1) -> T y0 -> T y0 -> (T y1, (Bool, T y0))
zipWithRestRec y0 -> y0 -> y1
f =
let recourse :: [y0] -> [y0] -> ([y1], (Bool, [y0]))
recourse [y0]
xt [y0]
yt =
([y1], (Bool, [y0])) -> ([y1], (Bool, [y0]))
forall a b. (a, b) -> (a, b)
forcePair (([y1], (Bool, [y0])) -> ([y1], (Bool, [y0])))
-> ([y1], (Bool, [y0])) -> ([y1], (Bool, [y0]))
forall a b. (a -> b) -> a -> b
$
case ([y0]
xt,[y0]
yt) of
(y0
x:[y0]
xs, y0
y:[y0]
ys) -> ([y1] -> [y1]) -> ([y1], (Bool, [y0])) -> ([y1], (Bool, [y0]))
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst (y0 -> y0 -> y1
f y0
x y0
y y1 -> [y1] -> [y1]
forall a. a -> [a] -> [a]
:) ([y0] -> [y0] -> ([y1], (Bool, [y0]))
recourse [y0]
xs [y0]
ys)
([], [y0]
_) -> ([], (Bool
True, [y0]
yt))
([y0]
_, []) -> ([], (Bool
False, [y0]
xt))
in [y0] -> [y0] -> ([y1], (Bool, [y0]))
recourse
zipWithAppend ::
(y -> y -> y) ->
T y -> T y -> T y
zipWithAppend :: forall y. (y -> y -> y) -> T y -> T y -> T y
zipWithAppend y -> y -> y
f T y
xs T y
ys =
(T y -> T y -> T y) -> (T y, T y) -> T y
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T y -> T y -> T y
forall a. [a] -> [a] -> [a]
(++) ((T y, T y) -> T y) -> (T y, T y) -> T y
forall a b. (a -> b) -> a -> b
$ ((Bool, T y) -> T y) -> (T y, (Bool, T y)) -> (T y, T y)
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd (Bool, T y) -> T y
forall a b. (a, b) -> b
snd ((T y, (Bool, T y)) -> (T y, T y))
-> (T y, (Bool, T y)) -> (T y, T y)
forall a b. (a -> b) -> a -> b
$ (y -> y -> y) -> T y -> T y -> (T y, (Bool, T y))
forall y0 y1.
(y0 -> y0 -> y1) -> T y0 -> T y0 -> (T y1, (Bool, T y0))
zipWithRest y -> y -> y
f T y
xs T y
ys