Cord.hs

{-# LANGUAGE FlexibleInstances #-}

module Zwirn.Core.Cord where

{-
    Cord.hs - functions on parallel signals
    Copyright (C) 2025, Martin Gius

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

import Control.Monad (join)
import Data.Bifunctor (first, second)
import Zwirn.Core.Core
import Zwirn.Core.Query
import Zwirn.Core.Random
import Zwirn.Core.Time
import Zwirn.Core.Tree
import Zwirn.Core.Types

type Cord = ZwirnT Tree

liftList :: ([Tree (Value i a, st)] -> [Tree (Value i b, st)]) -> Cord st i a -> Cord st i b
liftList f = withInner g
  where
    g (Leaf x) = Branch $ f [Leaf x]
    g (Branch xs) = Branch $ f xs

liftListWithTimeState :: (Time -> st -> [Tree (Value i a, st)] -> [Tree (Value i b, st)]) -> Cord st i a -> Cord st i b
liftListWithTimeState f = withInnerTimeState g
  where
    g t st (Leaf x) = Branch $ f t st [Leaf x]
    g t st (Branch xs) = Branch $ f t st xs

instance HasSilence Tree where
  silence = zwirn $ const $ const $ Branch []

-- | get the current depth of the cord
depth :: Cord st i a -> Cord st i Int
depth = withInner (\t -> first (fmap (const $ topLength t)) <$> t)

-- | group a list of cords
stack :: [Cord st i a] -> Cord st i a
stack zs = zwirn $ \t st -> Branch $ map (\x -> unzwirn x t st) zs

-- | project cord on specific index
project :: Cord st i Int -> Cord st i a -> Cord st i a
project i x = withInner . look <$> i <$$> x

-- | layer functions over an input
layer :: Cord st i (Cord st i a -> Cord st i b) -> Cord st i a -> Cord st i b
layer fs x = zwirn q
  where
    q t st = squeezeJoin $ (\c -> unzwirn c t st) . ($ x) . value . fst <$> unzwirn fs t st

-- | insert cord a specific index
insert :: Cord st i Int -> Cord st i a -> Cord st i a -> Cord st i a
insert ic x y = (($ y) . ($ x)) . insert' =<< ic
  where
    insert' :: Int -> Cord st i a -> Cord st i a -> Cord st i a
    insert' i x ys = zwirn $ \t st -> insertT i (unzwirn x t st) (unzwirn ys t st)

-- | remove cord at specific index
remove :: Cord st i Int -> Cord st i a -> Cord st i a
remove i x = withInner . removeT <$> i <$$> x

-- | apply function to specific index
at :: Cord st i Int -> Cord st i (Cord st i a -> Cord st i a) -> Cord st i a -> Cord st i a
at i f x = insert i (innerApply f $ project i x) (remove i x)

arp :: Cord st i a -> Cord st i a
arp = withInner trans
  where
    trans :: Tree (Value i a, st) -> Tree (Value i a, st)
    trans (Leaf x) = Leaf x
    trans (Branch []) = Branch []
    trans (Branch xs) = Branch $ map (\i -> shif (length xs) i (xs !! i)) [0 .. length xs - 1]
      where
        shif :: Int -> Int -> Tree (Value i a, st) -> Tree (Value i a, st)
        shif total i x = first (\v -> v {time = time v - fromIntegral i / fromIntegral total}) <$> x

reverseC :: Cord st i a -> Cord st i a
reverseC = liftList reverse

rotateC :: Cord st i a -> Cord st i a
rotateC = liftList rotateList
  where
    rotateList (x : xs) = xs ++ [x]

invertC :: (Num a) => Cord st i a -> Cord st i a
invertC = liftList invertList
  where
    invertList (x : xs) = xs ++ [fmap (first $ fmap (+ 12)) x]

enumFromToStack :: (Ord a, Num a) => Cord st i a -> Cord st i a -> Cord st i a
enumFromToStack xz yz = join $ en <$> xz <*> yz
  where
    en x y = stack $ map pure $ enumerateFromTo x y

enumFromThenToStack :: (Ord a, Num a) => Cord st i a -> Cord st i a -> Cord st i a -> Cord st i a
enumFromThenToStack xz yz zz = join $ en <$> xz <*> yz <*> zz
  where
    en x y z = stack $ map pure $ enumerateFromThenTo x y z