{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances #-}
module Synthesizer.Generic.LengthSignal where
import qualified Synthesizer.Generic.Signal as SigG
import qualified Synthesizer.Generic.Cut as CutG
import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup, (<>), )
import Data.Tuple.HT (mapSnd, )
import qualified Algebra.Additive as Additive
import NumericPrelude.Numeric as NP
import NumericPrelude.Base hiding (length, splitAt, )
data T sig = Cons {forall sig. T sig -> Int
length :: Int, forall sig. T sig -> sig
body :: sig}
deriving (Int -> T sig -> ShowS
[T sig] -> ShowS
T sig -> String
(Int -> T sig -> ShowS)
-> (T sig -> String) -> ([T sig] -> ShowS) -> Show (T sig)
forall sig. Show sig => Int -> T sig -> ShowS
forall sig. Show sig => [T sig] -> ShowS
forall sig. Show sig => T sig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall sig. Show sig => Int -> T sig -> ShowS
showsPrec :: Int -> T sig -> ShowS
$cshow :: forall sig. Show sig => T sig -> String
show :: T sig -> String
$cshowList :: forall sig. Show sig => [T sig] -> ShowS
showList :: [T sig] -> ShowS
Show)
fromSignal :: (CutG.Read sig) => sig -> T sig
fromSignal :: forall sig. Read sig => sig -> T sig
fromSignal sig
xs = Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (sig -> Int
forall sig. Read sig => sig -> Int
CutG.length sig
xs) sig
xs
toSignal :: T sig -> sig
toSignal :: forall sig. T sig -> sig
toSignal = T sig -> sig
forall sig. T sig -> sig
body
instance Functor T where
fmap :: forall a b. (a -> b) -> T a -> T b
fmap a -> b
f (Cons Int
xl a
xs) = Int -> b -> T b
forall sig. Int -> sig -> T sig
Cons Int
xl (a -> b
f a
xs)
instance (Additive.C a, SigG.Transform sig a) => Additive.C (T (sig a)) where
zero :: T (sig a)
zero = T (sig a)
forall a. Monoid a => a
mempty
negate :: T (sig a) -> T (sig a)
negate T (sig a)
xs = T (sig a)
xs{body = SigG.map negate (body xs)}
(Cons Int
xl sig a
xs) + :: T (sig a) -> T (sig a) -> T (sig a)
+ (Cons Int
yl sig a
ys) =
Int -> sig a -> T (sig a)
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
xl Int
yl) (sig a -> sig a -> sig a
forall y (sig :: * -> *).
(C y, Transform sig y) =>
sig y -> sig y -> sig y
SigG.mix sig a
xs sig a
ys)
instance (Semigroup sig) => Semigroup (T sig) where
Cons Int
xl sig
xs <> :: T sig -> T sig -> T sig
<> Cons Int
yl sig
ys = Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int
xlInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
yl) (sig
xs sig -> sig -> sig
forall a. Semigroup a => a -> a -> a
<> sig
ys)
instance (Monoid sig) => Monoid (T sig) where
mempty :: T sig
mempty = Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons Int
forall a. C a => a
zero sig
forall a. Monoid a => a
mempty
mappend :: T sig -> T sig -> T sig
mappend (Cons Int
xl sig
xs) (Cons Int
yl sig
ys) =
Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int
xlInt -> Int -> Int
forall a. C a => a -> a -> a
+Int
yl) (sig -> sig -> sig
forall a. Monoid a => a -> a -> a
mappend sig
xs sig
ys)
splitAt :: (CutG.Transform sig) => Int -> T sig -> (T sig, T sig)
splitAt :: forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
splitAt Int
n (Cons Int
xl sig
xs) =
let (sig
ys,sig
zs) = Int -> sig -> (sig, sig)
forall sig. Transform sig => Int -> sig -> (sig, sig)
SigG.splitAt Int
n sig
xs
in (Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
xl) sig
ys, Int -> sig -> T sig
forall sig. Int -> sig -> T sig
Cons (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
n Int
xl Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
n) sig
zs)
{-# INLINE addShiftedSimple #-}
addShiftedSimple ::
(Additive.C a, SigG.Transform sig a) =>
Int -> T (sig a) -> T (sig a) -> T (sig a)
addShiftedSimple :: forall a (sig :: * -> *).
(C a, Transform sig a) =>
Int -> T (sig a) -> T (sig a) -> T (sig a)
addShiftedSimple Int
del T (sig a)
a T (sig a)
b =
(T (sig a) -> T (sig a) -> T (sig a))
-> (T (sig a), T (sig a)) -> T (sig a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry T (sig a) -> T (sig a) -> T (sig a)
forall a. Monoid a => a -> a -> a
mappend ((T (sig a), T (sig a)) -> T (sig a))
-> (T (sig a), T (sig a)) -> T (sig a)
forall a b. (a -> b) -> a -> b
$
(T (sig a) -> T (sig a))
-> (T (sig a), T (sig a)) -> (T (sig a), T (sig a))
forall b c a. (b -> c) -> (a, b) -> (a, c)
mapSnd ((T (sig a) -> T (sig a) -> T (sig a))
-> T (sig a) -> T (sig a) -> T (sig a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip T (sig a) -> T (sig a) -> T (sig a)
forall a. C a => a -> a -> a
(+) T (sig a)
b) ((T (sig a), T (sig a)) -> (T (sig a), T (sig a)))
-> (T (sig a), T (sig a)) -> (T (sig a), T (sig a))
forall a b. (a -> b) -> a -> b
$
Int -> T (sig a) -> (T (sig a), T (sig a))
forall sig. Transform sig => Int -> T sig -> (T sig, T sig)
splitAt Int
del T (sig a)
a