Cord.hs

{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

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 Zwirn.Core.Core
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 []

-- | 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

-- | get the current depth of the cord
depth :: Cord st i a -> Cord st i Int
depth c = zwirn z
  where
    z t st = pure (Value l t [], st)
      where
        ts = unzwirn c t st
        l = topLength ts

-- | pick a certain layer out of a cord, wrapping around
_pick :: Int -> Cord st i a -> Cord st i a
_pick i = withInner (look i)

collect :: Cord st i a -> Cord st i [Cord st i a]
collect c = map (`_pick` c) . enumFromTo 0 . (\x -> x - 1) <$> depth c

_cordmap :: (Cord st i a -> Cord st i b) -> Cord st i a -> Cord st i b
_cordmap f x = (stack . map f) =<< collect x