{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Zwirn.Core.Map where

{-
    Map.hs - lifting functions on maps to signals, some adapted
    from https://github.com/tidalcycles/Tidal/blob/dev/src/Sound/Tidal/Control.hs
    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 Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.String (IsString)
import Zwirn.Core.Core
import Zwirn.Core.Modulate (fastcat, slow)
import Zwirn.Core.Structure (run)
import Zwirn.Core.Time (Time)
import Zwirn.Core.Types
import Prelude hiding ((*>))

-- | create a singleton map with specific key
singleton :: (MultiApplicative m) => ZwirnT m st i k -> ZwirnT m st i a -> ZwirnT m st i (Map k a)
singleton :: forall (m :: * -> *) st i k a.
MultiApplicative m =>
ZwirnT m st i k -> ZwirnT m st i a -> ZwirnT m st i (Map k a)
singleton = (k -> a -> Map k a)
-> ZwirnT m st i k -> ZwirnT m st i a -> ZwirnT m st i (Map k a)
forall a b c.
(a -> b -> c)
-> ZwirnT m st i a -> ZwirnT m st i b -> ZwirnT m st i c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right k -> a -> Map k a
forall k a. k -> a -> Map k a
Map.singleton

union :: (Applicative m, Ord k) => ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
union :: forall (m :: * -> *) k st i a.
(Applicative m, Ord k) =>
ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
union = (Map k a -> Map k a -> Map k a)
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
forall a b c.
(a -> b -> c)
-> ZwirnT m st i a -> ZwirnT m st i b -> ZwirnT m st i c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

-- | lookup a value via key
lookup :: (HasSilence m, MultiMonad m, Ord k) => ZwirnT m st i k -> ZwirnT m st i (Map k a) -> ZwirnT m st i a
lookup :: forall (m :: * -> *) k st i a.
(HasSilence m, MultiMonad m, Ord k) =>
ZwirnT m st i k -> ZwirnT m st i (Map k a) -> ZwirnT m st i a
lookup ZwirnT m st i k
tz ZwirnT m st i (Map k a)
xz = ZwirnT m st i (ZwirnT m st i a) -> ZwirnT m st i a
forall a. ZwirnT m st i (ZwirnT m st i a) -> ZwirnT m st i a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
outerJoin (ZwirnT m st i (ZwirnT m st i a) -> ZwirnT m st i a)
-> ZwirnT m st i (ZwirnT m st i a) -> ZwirnT m st i a
forall a b. (a -> b) -> a -> b
$ (k -> Map k a -> ZwirnT m st i a)
-> ZwirnT m st i k
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (ZwirnT m st i a)
forall a b c.
(a -> b -> c)
-> ZwirnT m st i a -> ZwirnT m st i b -> ZwirnT m st i c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right (\k
t Map k a
x -> Maybe a -> ZwirnT m st i a
forall {k :: * -> *} {a} {st} {i}.
(Applicative k, HasSilence k) =>
Maybe a -> ZwirnT k st i a
fromLookup (Maybe a -> ZwirnT m st i a) -> Maybe a -> ZwirnT m st i a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
t Map k a
x) ZwirnT m st i k
tz ZwirnT m st i (Map k a)
xz
  where
    fromLookup :: Maybe a -> ZwirnT k st i a
fromLookup (Just a
x) = a -> ZwirnT k st i a
forall a. a -> ZwirnT k st i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    fromLookup Maybe a
_ = ZwirnT k st i a
forall st i a. ZwirnT k st i a
forall (k :: * -> *) st i a. HasSilence k => ZwirnT k st i a
silence

insert :: (Applicative m, Ord k) => ZwirnT m st i k -> ZwirnT m st i a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
insert :: forall (m :: * -> *) k st i a.
(Applicative m, Ord k) =>
ZwirnT m st i k
-> ZwirnT m st i a
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
insert ZwirnT m st i k
k ZwirnT m st i a
a ZwirnT m st i (Map k a)
m = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (k -> a -> Map k a -> Map k a)
-> ZwirnT m st i k -> ZwirnT m st i (a -> Map k a -> Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i k
k ZwirnT m st i (a -> Map k a -> Map k a)
-> ZwirnT m st i a -> ZwirnT m st i (Map k a -> Map k a)
forall a b.
ZwirnT m st i (a -> b) -> ZwirnT m st i a -> ZwirnT m st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT m st i a
a ZwirnT m st i (Map k a -> Map k a)
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall a b.
ZwirnT m st i (a -> b) -> ZwirnT m st i a -> ZwirnT m st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT m st i (Map k a)
m

-- | apply a function to a specific key, if key is absent, return the original map
fix :: (HasSilence m, MultiMonad m, Ord k) => ZwirnT m st i k -> ZwirnT m st i (ZwirnT m st i a -> ZwirnT m st i a) -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
fix :: forall (m :: * -> *) k st i a.
(HasSilence m, MultiMonad m, Ord k) =>
ZwirnT m st i k
-> ZwirnT m st i (ZwirnT m st i a -> ZwirnT m st i a)
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
fix ZwirnT m st i k
kz ZwirnT m st i (ZwirnT m st i a -> ZwirnT m st i a)
fz ZwirnT m st i (Map k a)
mz = ZwirnT m st i (ZwirnT m st i (Map k a)) -> ZwirnT m st i (Map k a)
forall a. ZwirnT m st i (ZwirnT m st i a) -> ZwirnT m st i a
forall (m :: * -> *) a. MultiMonad m => m (m a) -> m a
outerJoin (ZwirnT m st i (ZwirnT m st i (Map k a))
 -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> ZwirnT m st i (Map k a)
fromLookup (Maybe a -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Maybe a)
-> ZwirnT m st i (ZwirnT m st i (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i k
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Maybe a)
forall {a}.
ZwirnT m st i k
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Maybe a)
lookupMaybe ZwirnT m st i k
kz ZwirnT m st i (Map k a)
mz
  where
    fromLookup :: Maybe a -> ZwirnT m st i (Map k a)
fromLookup (Just a
x) = ZwirnT m st i k
-> ZwirnT m st i a
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
forall (m :: * -> *) k st i a.
(Applicative m, Ord k) =>
ZwirnT m st i k
-> ZwirnT m st i a
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
insert ZwirnT m st i k
kz (ZwirnT m st i (ZwirnT m st i a -> ZwirnT m st i a)
-> ZwirnT m st i a -> ZwirnT m st i a
forall (m :: * -> *) a b.
MultiMonad m =>
m (m a -> m b) -> m a -> m b
squeezeApply ZwirnT m st i (ZwirnT m st i a -> ZwirnT m st i a)
fz (a -> ZwirnT m st i a
forall a. a -> ZwirnT m st i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)) ZwirnT m st i (Map k a)
mz
    fromLookup Maybe a
Nothing = ZwirnT m st i (Map k a)
mz
    lookupMaybe :: ZwirnT m st i k
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Maybe a)
lookupMaybe = (k -> Map k a -> Maybe a)
-> ZwirnT m st i k
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Maybe a)
forall a b c.
(a -> b -> c)
-> ZwirnT m st i a -> ZwirnT m st i b -> ZwirnT m st i c
forall (f :: * -> *) a b c.
MultiApplicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2Right k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup

chop :: (Fractional a, MultiMonad m, HasSilence m, Ord k, IsString k) => ZwirnT m st i Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
chop :: forall a (m :: * -> *) k st i.
(Fractional a, MultiMonad m, HasSilence m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
chop ZwirnT m st i Int
nz = (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall (m :: * -> *) a b.
MultiMonad m =>
(m a -> m b) -> m a -> m b
squeezeMap (ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
forall a (m :: * -> *) k st i.
(Fractional a, MultiMonad m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
quickslice ZwirnT m st i Int
nz (ZwirnT m st i Int -> ZwirnT m st i Int
forall (k :: * -> *) st i.
(Monad k, HasSilence k) =>
ZwirnT k st i Int -> ZwirnT k st i Int
run ZwirnT m st i Int
nz))

quickslice :: (Fractional a, MultiMonad m, Ord k, IsString k) => ZwirnT m st i Int -> ZwirnT m st i Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
quickslice :: forall a (m :: * -> *) k st i.
(Fractional a, MultiMonad m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
quickslice ZwirnT m st i Int
nz ZwirnT m st i Int
iz = (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall (m :: * -> *) a b.
MultiMonad m =>
(m a -> m b) -> m a -> m b
squeezeMap (ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
forall a (m :: * -> *) k st i.
(Fractional a, MultiApplicative m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
slice ZwirnT m st i Int
nz ZwirnT m st i Int
iz)

loopAt :: (Fractional a, IsString a, HasSilence m, Monad m, Ord k, IsString k) => ZwirnT m st i Time -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
loopAt :: forall a (m :: * -> *) k st i.
(Fractional a, IsString a, HasSilence m, Monad m, Ord k,
 IsString k) =>
ZwirnT m st i Time
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
loopAt ZwirnT m st i Time
zt ZwirnT m st i (Map k a)
zx = Time -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall {k :: * -> *} {k} {a} {st} {i}.
(HasSilence k, Ord k, Fractional a, IsString k, IsString a,
 Monad k) =>
Time -> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
_loopAt (Time -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i Time
-> ZwirnT
     m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i Time
zt ZwirnT m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
<$$> ZwirnT m st i (Map k a)
zx
  where
    _loopAt :: Time -> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
_loopAt Time
0 ZwirnT k st i (Map k a)
_ = ZwirnT k st i (Map k a)
forall st i a. ZwirnT k st i a
forall (k :: * -> *) st i a. HasSilence k => ZwirnT k st i a
silence
    _loopAt Time
t ZwirnT k st i (Map k a)
x = (Maybe a -> Maybe a) -> k -> Map k a -> Map k a
forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe a -> Maybe a
forall {a}. Fractional a => Maybe a -> Maybe a
a k
"speed" (Map k a -> Map k a) -> (Map k a -> Map k a) -> Map k a -> Map k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
"unit" a
"c" (Map k a -> Map k a)
-> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i Time
-> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
forall (k :: * -> *) st i a.
Monad k =>
ZwirnT k st i Time -> ZwirnT k st i a -> ZwirnT k st i a
slow (Time -> ZwirnT k st i Time
forall a. a -> ZwirnT k st i a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Time
t) ZwirnT k st i (Map k a)
x
      where
        a :: Maybe a -> Maybe a
a (Just a
s) = a -> Maybe a
forall a. a -> Maybe a
Just (a
s a -> a -> a
forall a. Fractional a => a -> a -> a
/ Time -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
t)
        a Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just (a
1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ Time -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Time
t)

slice :: (Fractional a, MultiApplicative m, Ord k, IsString k) => ZwirnT m st i Int -> ZwirnT m st i Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
slice :: forall a (m :: * -> *) k st i.
(Fractional a, MultiApplicative m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i Int
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
slice ZwirnT m st i Int
nz ZwirnT m st i Int
iz ZwirnT m st i (Map k a)
zm = Int -> Int -> Map k a -> Map k a
forall {k} {a} {p}.
(IsString k, Fractional a, Integral p, Ord k) =>
p -> p -> Map k a -> Map k a
_slice (Int -> Int -> Map k a -> Map k a)
-> ZwirnT m st i Int -> ZwirnT m st i (Int -> Map k a -> Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i Int
nz ZwirnT m st i (Int -> Map k a -> Map k a)
-> ZwirnT m st i Int -> ZwirnT m st i (Map k a -> Map k a)
forall a b.
ZwirnT m st i (a -> b) -> ZwirnT m st i a -> ZwirnT m st i b
forall (f :: * -> *) a b.
MultiApplicative f =>
f (a -> b) -> f a -> f b
*> ZwirnT m st i Int
iz ZwirnT m st i (Map k a -> Map k a)
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall a b.
ZwirnT m st i (a -> b) -> ZwirnT m st i a -> ZwirnT m st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT m st i (Map k a)
zm
  where
    _slice :: p -> p -> Map k a -> Map k a
_slice p
n p
i Map k a
m = [Map k a] -> Map k a
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions [k -> a -> Map k a
forall k a. k -> a -> Map k a
Map.singleton k
"begin" a
newb, k -> a -> Map k a
forall k a. k -> a -> Map k a
Map.singleton k
"end" a
newe, Map k a
m]
      where
        b :: a
b = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"begin" Map k a
m
        e :: a
e = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"end" Map k a
m
        newrange :: a -> a
newrange a
x = a
e a -> a -> a
forall a. Num a => a -> a -> a
* a
x a -> a -> a
forall a. Num a => a -> a -> a
+ (a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
x) a -> a -> a
forall a. Num a => a -> a -> a
* a
b
        newb :: a
newb = a -> a
newrange (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ p -> p -> a
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' p
i p
n
        newe :: a
newe = a -> a
newrange (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ p -> p -> a
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' p
i p
n a -> a -> a
forall a. Num a => a -> a -> a
+ p -> p -> a
forall {a} {a}. (Fractional a, Integral a) => a -> a -> a
div' p
1 p
n
        div' :: a -> a -> a
div' a
num a
den = a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
num a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
den) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
den

striateBy :: (Fractional a, Monad m, HasSilence m, Ord k, IsString k) => ZwirnT m st i Int -> ZwirnT m st i a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
striateBy :: forall a (m :: * -> *) k st i.
(Fractional a, Monad m, HasSilence m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i a
-> ZwirnT m st i (Map k a)
-> ZwirnT m st i (Map k a)
striateBy ZwirnT m st i Int
i ZwirnT m st i a
f ZwirnT m st i (Map k a)
x = Int -> a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall {k :: * -> *} {a} {b} {k} {st} {i}.
(HasSilence k, Integral a, Functor k, Fractional b, Ord k,
 IsString k) =>
a -> b -> ZwirnT k st i (Map k b) -> ZwirnT k st i (Map k b)
_striateBy (Int -> a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i Int
-> ZwirnT
     m st i (a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i Int
i ZwirnT
  m st i (a -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i a
-> ZwirnT
     m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
forall a b.
ZwirnT m st i (a -> b) -> ZwirnT m st i a -> ZwirnT m st i b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ZwirnT m st i a
f ZwirnT m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
<$$> ZwirnT m st i (Map k a)
x
  where
    _striateBy :: a -> b -> ZwirnT k st i (Map k b) -> ZwirnT k st i (Map k b)
_striateBy a
n b
f ZwirnT k st i (Map k b)
mz = [ZwirnT k st i (Map k b)] -> ZwirnT k st i (Map k b)
forall (k :: * -> *) st i a.
HasSilence k =>
[ZwirnT k st i a] -> ZwirnT k st i a
fastcat ([ZwirnT k st i (Map k b)] -> ZwirnT k st i (Map k b))
-> [ZwirnT k st i (Map k b)] -> ZwirnT k st i (Map k b)
forall a b. (a -> b) -> a -> b
$ (a -> ZwirnT k st i (Map k b)) -> [a] -> [ZwirnT k st i (Map k b)]
forall a b. (a -> b) -> [a] -> [b]
map (b -> ZwirnT k st i (Map k b)
offset (b -> ZwirnT k st i (Map k b))
-> (a -> b) -> a -> ZwirnT k st i (Map k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [a
0 .. a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1]
      where
        offset :: b -> ZwirnT k st i (Map k b)
offset b
i = (b, b) -> Map k b -> Map k b
forall a k.
(Fractional a, Ord k, IsString k) =>
(a, a) -> Map k a -> Map k a
mergePlayRange (b
slot b -> b -> b
forall a. Num a => a -> a -> a
* b
i, (b
slot b -> b -> b
forall a. Num a => a -> a -> a
* b
i) b -> b -> b
forall a. Num a => a -> a -> a
+ b
f) (Map k b -> Map k b)
-> ZwirnT k st i (Map k b) -> ZwirnT k st i (Map k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i (Map k b)
mz
        slot :: b
slot = (b
1 b -> b -> b
forall a. Num a => a -> a -> a
- b
f) b -> b -> b
forall a. Fractional a => a -> a -> a
/ a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1)

striate :: (Fractional a, Monad m, HasSilence m, Ord k, IsString k) => ZwirnT m st i Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
striate :: forall a (m :: * -> *) k st i.
(Fractional a, Monad m, HasSilence m, Ord k, IsString k) =>
ZwirnT m st i Int
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
striate ZwirnT m st i Int
i ZwirnT m st i (Map k a)
x = Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall {k :: * -> *} {a} {k} {a} {st} {i}.
(HasSilence k, Functor k, Fractional a, IsString k, Integral a,
 Ord k) =>
a -> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
_striate (Int -> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i Int
-> ZwirnT
     m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT m st i Int
i ZwirnT m st i (ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a))
-> ZwirnT m st i (Map k a) -> ZwirnT m st i (Map k a)
forall (m :: * -> *) a b. Monad m => m (m a -> m b) -> m a -> m b
<$$> ZwirnT m st i (Map k a)
x
  where
    _striate :: a -> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
_striate a
n ZwirnT k st i (Map k a)
z = [ZwirnT k st i (Map k a)] -> ZwirnT k st i (Map k a)
forall (k :: * -> *) st i a.
HasSilence k =>
[ZwirnT k st i a] -> ZwirnT k st i a
fastcat ([ZwirnT k st i (Map k a)] -> ZwirnT k st i (Map k a))
-> [ZwirnT k st i (Map k a)] -> ZwirnT k st i (Map k a)
forall a b. (a -> b) -> a -> b
$ (a -> ZwirnT k st i (Map k a)) -> [a] -> [ZwirnT k st i (Map k a)]
forall a b. (a -> b) -> [a] -> [b]
map a -> ZwirnT k st i (Map k a)
forall {a}. Integral a => a -> ZwirnT k st i (Map k a)
offset [a
0 .. a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1]
      where
        offset :: a -> ZwirnT k st i (Map k a)
offset a
i = (a, a) -> Map k a -> Map k a
forall a k.
(Fractional a, Ord k, IsString k) =>
(a, a) -> Map k a -> Map k a
mergePlayRange (a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n, a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
i a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ a -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n) (Map k a -> Map k a)
-> ZwirnT k st i (Map k a) -> ZwirnT k st i (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZwirnT k st i (Map k a)
z

mergePlayRange :: (Fractional a, Ord k, IsString k) => (a, a) -> Map k a -> Map k a
mergePlayRange :: forall a k.
(Fractional a, Ord k, IsString k) =>
(a, a) -> Map k a -> Map k a
mergePlayRange (a
b, a
e) Map k a
cm = k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
"begin" ((a
b a -> a -> a
forall a. Num a => a -> a -> a
* a
d') a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') (Map k a -> Map k a) -> Map k a -> Map k a
forall a b. (a -> b) -> a -> b
$ k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
"end" ((a
e a -> a -> a
forall a. Num a => a -> a -> a
* a
d') a -> a -> a
forall a. Num a => a -> a -> a
+ a
b') Map k a
cm
  where
    b' :: a
b' = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
0 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"begin" Map k a
cm
    e' :: a
e' = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
1 (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
"end" Map k a
cm
    d' :: a
d' = a
e' a -> a -> a
forall a. Num a => a -> a -> a
- a
b'