```module Synthesizer.Zip where

import qualified Synthesizer.Generic.Cut as CutG

import qualified Control.Arrow as Arrow
import Control.Arrow (Arrow, (<<<), (^<<), (<<^), )

import Data.Monoid (Monoid, mempty, mappend, )
import Data.Semigroup (Semigroup, (<>), )

{- |
Parallel combination of two signals of equal length.
-}
data T a b = Cons {first :: a, second :: b}

{- |
Zip together two signals.
It is a checked error if their lengths differ.
-}
consChecked ::
String -> a -> b -> T a b
consChecked name a b =
let lenA = CutG.length a
lenB = CutG.length b
in  if lenA == lenB
then Cons a b
else error \$ "different lengths " ++
show lenA ++ " vs. " ++ show lenB ++ " in " ++ name

{- |
Zip together two signals
and shorten them to the length of the shorter one.
-}
consShorten ::
(CutG.Transform a, CutG.Transform b) =>
a -> b -> T a b
consShorten a b =
let len = min (CutG.length a) (CutG.length b)
in  Cons (CutG.take len a) (CutG.take len b)

arrowFirst ::
Arrow arrow =>
arrow a b -> arrow (T a c) (T b c)
arrowFirst arrow =
uncurry Cons
^<<
Arrow.first arrow
<<^
(\(Cons a b) -> (a,b))

arrowSecond ::
Arrow arrow =>
arrow a b -> arrow (T c a) (T c b)
arrowSecond arrow =
uncurry Cons
^<<
Arrow.second arrow
<<^
(\(Cons a b) -> (a,b))

arrowFirstShorten ::
(Arrow arrow, CutG.Transform b, CutG.Transform c) =>
arrow a b -> arrow (T a c) (T b c)
arrowFirstShorten arrow =
uncurry consShorten
^<<
Arrow.first arrow
<<^
(\(Cons a b) -> (a,b))

arrowSecondShorten ::
(Arrow arrow, CutG.Transform b, CutG.Transform c) =>
arrow a b -> arrow (T c a) (T c b)
arrowSecondShorten arrow =
uncurry consShorten
^<<
Arrow.second arrow
<<^
(\(Cons a b) -> (a,b))

arrowFanout ::
Arrow arrow =>
arrow a b -> arrow a c -> arrow a (T b c)
arrowFanout b c =
uncurry Cons  Arrow.^<<  b Arrow.&&& c

arrowSplit ::
Arrow arrow =>
arrow a c -> arrow b d -> arrow (T a b) (T c d)
arrowSplit x y =
uncurry Cons  Arrow.^<<  x Arrow.*** y  Arrow.<<^  (\(Cons a b) -> (a,b))

arrowFanoutShorten ::
(Arrow arrow, CutG.Transform a, CutG.Transform b, CutG.Transform c) =>
arrow a b -> arrow a c -> arrow a (T b c)
arrowFanoutShorten a b =
arrowSplitShorten a b <<^ (\x -> Cons x x)

arrowSplitShorten ::
(Arrow arrow,
CutG.Transform a, CutG.Transform b, CutG.Transform c, CutG.Transform d) =>
arrow a c -> arrow b d -> arrow (T a b) (T c d)
arrowSplitShorten a b =
arrowFirstShorten a <<< arrowSecondShorten b

instance (Semigroup a, Semigroup b) => Semigroup (T a b) where
Cons a0 b0 <> Cons a1 b1 = Cons (a0 <> a1) (b0 <> b1)

instance (Monoid a, Monoid b) => Monoid (T a b) where
mempty = Cons mempty mempty
mappend (Cons a0 b0) (Cons a1 b1) =
Cons (mappend a0 a1) (mappend b0 b1)

{-# INLINE null #-}
null (Cons a b) =
case (CutG.null a, CutG.null b) of
(False, False) -> False
(True, True) -> True
_ -> error "Zipped signals: one is empty and the other one is not"
{-# INLINE length #-}
length (Cons a b) =
let lenA = CutG.length a
lenB = CutG.length b
in  if lenA == lenB
then lenA
else error "Zipped signals: the lengths differ"

{-
Parallel combination of two signals
where the combined signal has the length of the shorter member.
This is like in zipWith.

null (Parallel a b) = CutG.null a || CutG.null b
length (Parallel a b) = min (CutG.length a) (CutG.length b)
-}

instance (CutG.NormalForm a, CutG.NormalForm b) => CutG.NormalForm (T a b) where
((), ()) -> ()

instance (CutG.Transform a, CutG.Transform b) => CutG.Transform (T a b) where
{-# INLINE take #-}
take n (Cons a b) =
Cons (CutG.take n a) (CutG.take n b)
{-# INLINE drop #-}
drop n (Cons a b) =
Cons (CutG.drop n a) (CutG.drop n b)
{-# INLINE splitAt #-}
splitAt n (Cons a b) =
let (a0,a1) = CutG.splitAt n a
(b0,b1) = CutG.splitAt n b
in  (Cons a0 b0, Cons a1 b1)
{-# INLINE dropMarginRem #-}
dropMarginRem n m (Cons a0 b0) =
let (ka,a1) = CutG.dropMarginRem n m a0
(kb,b1) = CutG.dropMarginRem n m b0
in  if ka==kb
then (ka, Cons a1 b1)
else error "Zip.dropMarginRem: margins differ"
{-# INLINE reverse #-}
reverse (Cons a b) =
Cons (CutG.reverse a) (CutG.reverse b)
```