{-
    Stepwise.hs - Functions that deal with stepwise manipulation of pattern
    Copyright (C) 2024, Alex McLean and contributors

    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/>.
-}

module Sound.Tidal.Stepwise where

import Data.List (sort, sortOn, transpose)
import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, mapMaybe)
import Sound.Tidal.Core (stack, timecat, zoom, zoompat)
import Sound.Tidal.Pattern
import Sound.Tidal.Utils (enumerate, nubOrd, pairs)

-- _lcmsteps :: [Pattern a] -> Maybe Time
-- _lcmsteps pats = foldl1 lcmr <$> (sequence $ map steps pats)

s_patternify :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
s_patternify :: forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify a -> Pattern b -> Pattern c
f (Pattern State -> [Event a]
_ Maybe Rational
_ (Just a
a)) Pattern b
b = a -> Pattern b -> Pattern c
f a
a Pattern b
b
s_patternify a -> Pattern b -> Pattern c
f Pattern a
pa Pattern b
p = Pattern (Pattern c) -> Pattern c
forall a. Pattern (Pattern a) -> Pattern a
stepJoin (Pattern (Pattern c) -> Pattern c)
-> Pattern (Pattern c) -> Pattern c
forall a b. (a -> b) -> a -> b
$ (a -> Pattern b -> Pattern c
`f` Pattern b
p) (a -> Pattern c) -> Pattern a -> Pattern (Pattern c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
pa

s_patternify2 :: (a -> b -> c -> Pattern d) -> Pattern a -> Pattern b -> c -> Pattern d
s_patternify2 :: forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
s_patternify2 a -> b -> c -> Pattern d
f Pattern a
a Pattern b
b c
p = Pattern (Pattern d) -> Pattern d
forall a. Pattern (Pattern a) -> Pattern a
stepJoin (Pattern (Pattern d) -> Pattern d)
-> Pattern (Pattern d) -> Pattern d
forall a b. (a -> b) -> a -> b
$ (\a
x b
y -> a -> b -> c -> Pattern d
f a
x b
y c
p) (a -> b -> Pattern d) -> Pattern a -> Pattern (b -> Pattern d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (b -> Pattern d) -> Pattern b -> Pattern (Pattern d)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern b
b

stepJoin :: Pattern (Pattern a) -> Pattern a
stepJoin :: forall a. Pattern (Pattern a) -> Pattern a
stepJoin Pattern (Pattern a)
pp = (State -> [Event a]) -> Maybe Rational -> Maybe a -> Pattern a
forall a.
(State -> [Event a]) -> Maybe Rational -> Maybe a -> Pattern a
Pattern State -> [Event a]
q Maybe Rational
first_t Maybe a
forall a. Maybe a
Nothing
  where
    q :: State -> [Event a]
q st :: State
st@(State Arc
a ValueMap
c) = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query ([(Rational, Pattern a)] -> Pattern a
forall a. [(Rational, Pattern a)] -> Pattern a
timecat ([(Rational, Pattern a)] -> Pattern a)
-> [(Rational, Pattern a)] -> Pattern a
forall a b. (a -> b) -> a -> b
$ [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a. [(Rational, Pattern a)] -> [(Rational, Pattern a)]
retime ([(Rational, Pattern a)] -> [(Rational, Pattern a)])
-> [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ [Event (Pattern a)] -> [(Rational, Pattern a)]
forall a. [Event (Pattern a)] -> [(Rational, Pattern a)]
slices ([Event (Pattern a)] -> [(Rational, Pattern a)])
-> [Event (Pattern a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ Pattern (Pattern a) -> State -> [Event (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query (Rational -> Pattern (Pattern a) -> Pattern (Pattern a)
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational -> Rational
sam (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start Arc
a) Pattern (Pattern a)
pp) (State
st {arc = Arc 0 1})) State
st
    first_t :: Maybe Rational
    first_t :: Maybe Rational
first_t = Pattern a -> Maybe Rational
forall a. Pattern a -> Maybe Rational
steps (Pattern a -> Maybe Rational) -> Pattern a -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ [(Rational, Pattern a)] -> Pattern a
forall a. [(Rational, Pattern a)] -> Pattern a
timecat ([(Rational, Pattern a)] -> Pattern a)
-> [(Rational, Pattern a)] -> Pattern a
forall a b. (a -> b) -> a -> b
$ [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a. [(Rational, Pattern a)] -> [(Rational, Pattern a)]
retime ([(Rational, Pattern a)] -> [(Rational, Pattern a)])
-> [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ [Event (Pattern a)] -> [(Rational, Pattern a)]
forall a. [Event (Pattern a)] -> [(Rational, Pattern a)]
slices ([Event (Pattern a)] -> [(Rational, Pattern a)])
-> [Event (Pattern a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ Pattern (Pattern a) -> Arc -> [Event (Pattern a)]
forall a. Pattern a -> Arc -> [Event a]
queryArc Pattern (Pattern a)
pp (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
0 Rational
1)
    retime :: [(Time, Pattern a)] -> [(Time, Pattern a)]
    retime :: forall a. [(Rational, Pattern a)] -> [(Rational, Pattern a)]
retime [(Rational, Pattern a)]
xs = ((Rational, Pattern a) -> (Rational, Pattern a))
-> [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> Pattern a -> (Rational, Pattern a))
-> (Rational, Pattern a) -> (Rational, Pattern a)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Rational -> Pattern a -> (Rational, Pattern a)
forall {a}. Rational -> Pattern a -> (Rational, Pattern a)
adjust) [(Rational, Pattern a)]
xs
      where
        occupied_perc :: Rational
occupied_perc = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Rational)
-> [(Rational, Pattern a)] -> [Rational]
forall a b. (a -> b) -> [a] -> [b]
map (Rational, Pattern a) -> Rational
forall a b. (a, b) -> a
fst ([(Rational, Pattern a)] -> [Rational])
-> [(Rational, Pattern a)] -> [Rational]
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Bool)
-> [(Rational, Pattern a)] -> [(Rational, Pattern a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe Rational -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Rational -> Bool)
-> ((Rational, Pattern a) -> Maybe Rational)
-> (Rational, Pattern a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Maybe Rational
forall a. Pattern a -> Maybe Rational
steps (Pattern a -> Maybe Rational)
-> ((Rational, Pattern a) -> Pattern a)
-> (Rational, Pattern a)
-> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, Pattern a) -> Pattern a
forall a b. (a, b) -> b
snd) [(Rational, Pattern a)]
xs
        occupied_tactus :: Rational
occupied_tactus = [Rational] -> Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Rational] -> Rational) -> [Rational] -> Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Maybe Rational)
-> [(Rational, Pattern a)] -> [Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pattern a -> Maybe Rational
forall a. Pattern a -> Maybe Rational
steps (Pattern a -> Maybe Rational)
-> ((Rational, Pattern a) -> Pattern a)
-> (Rational, Pattern a)
-> Maybe Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational, Pattern a) -> Pattern a
forall a b. (a, b) -> b
snd) [(Rational, Pattern a)]
xs
        total_tactus :: Rational
total_tactus = Rational
occupied_tactus Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
occupied_perc
        adjust :: Rational -> Pattern a -> (Rational, Pattern a)
adjust Rational
_ pat :: Pattern a
pat@(Pattern {steps :: forall a. Pattern a -> Maybe Rational
steps = Just Rational
t}) = (Rational
t, Pattern a
pat)
        adjust Rational
dur Pattern a
pat = (Rational
dur Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
total_tactus, Pattern a
pat)
    -- break up events at all start/end points, into groups, including empty ones.
    slices :: [Event (Pattern a)] -> [(Time, Pattern a)]
    slices :: forall a. [Event (Pattern a)] -> [(Rational, Pattern a)]
slices [Event (Pattern a)]
evs = ((Rational, Rational) -> (Rational, Pattern a))
-> [(Rational, Rational)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Rational, Rational)
s -> ((Rational, Rational) -> Rational
forall a b. (a, b) -> b
snd (Rational, Rational)
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Rational, Rational) -> Rational
forall a b. (a, b) -> a
fst (Rational, Rational)
s, [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stack ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Event (Pattern a) -> Pattern a)
-> [Event (Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\Event (Pattern a)
x -> (Context -> Context) -> Pattern a -> Pattern a
forall a. (Context -> Context) -> Pattern a -> Pattern a
withContext (\Context
c -> [Context] -> Context
combineContexts [Context
c, Event (Pattern a) -> Context
forall a b. EventF a b -> Context
context Event (Pattern a)
x]) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Event (Pattern a) -> Pattern a
forall a b. EventF a b -> b
value Event (Pattern a)
x) ([Event (Pattern a)] -> [Pattern a])
-> [Event (Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> [Event (Pattern a)] -> [Event (Pattern a)]
forall a.
(Rational, Rational) -> [Event (Pattern a)] -> [Event (Pattern a)]
fit (Rational, Rational)
s [Event (Pattern a)]
evs)) ([(Rational, Rational)] -> [(Rational, Pattern a)])
-> [(Rational, Rational)] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> a -> b
$ [Rational] -> [(Rational, Rational)]
forall a. [a] -> [(a, a)]
pairs ([Rational] -> [(Rational, Rational)])
-> [Rational] -> [(Rational, Rational)]
forall a b. (a -> b) -> a -> b
$ [Rational] -> [Rational]
forall a. Ord a => [a] -> [a]
sort ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ [Rational] -> [Rational]
forall a. Ord a => [a] -> [a]
nubOrd ([Rational] -> [Rational]) -> [Rational] -> [Rational]
forall a b. (a -> b) -> a -> b
$ Rational
0 Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Rational
1 Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: (Event (Pattern a) -> [Rational])
-> [Event (Pattern a)] -> [Rational]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Event (Pattern a)
ev -> Arc -> Rational
forall a. ArcF a -> a
start (Event (Pattern a) -> Arc
forall a b. EventF a b -> a
part Event (Pattern a)
ev) Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Arc -> Rational
forall a. ArcF a -> a
stop (Event (Pattern a) -> Arc
forall a b. EventF a b -> a
part Event (Pattern a)
ev) Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: []) [Event (Pattern a)]
evs
    -- list of slices of events within the given range
    fit :: (Rational, Rational) -> [Event (Pattern a)] -> [Event (Pattern a)]
    fit :: forall a.
(Rational, Rational) -> [Event (Pattern a)] -> [Event (Pattern a)]
fit (Rational
b, Rational
e) [Event (Pattern a)]
evs = (Event (Pattern a) -> Maybe (Event (Pattern a)))
-> [Event (Pattern a)] -> [Event (Pattern a)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ((Rational, Rational)
-> Event (Pattern a) -> Maybe (Event (Pattern a))
forall a.
(Rational, Rational)
-> Event (Pattern a) -> Maybe (Event (Pattern a))
match (Rational
b, Rational
e)) [Event (Pattern a)]
evs
    -- slice of event within the given range
    match :: (Rational, Rational) -> Event (Pattern a) -> Maybe (Event (Pattern a))
    match :: forall a.
(Rational, Rational)
-> Event (Pattern a) -> Maybe (Event (Pattern a))
match (Rational
b, Rational
e) Event (Pattern a)
ev = do
      Arc
a <- Arc -> Arc -> Maybe Arc
subArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
b Rational
e) (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Event (Pattern a) -> Arc
forall a b. EventF a b -> a
part Event (Pattern a)
ev
      Event (Pattern a) -> Maybe (Event (Pattern a))
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return Event (Pattern a)
ev {part = a}

-- stepcat :: [Pattern a] -> Pattern a
-- stepcat pats = innerJoin $ timecat . map snd . sortOn fst <$> tpat (epats pats)
--   where
--     -- enumerated patterns, ignoring those without steps
--     epats :: [Pattern a] -> [(Int, Pattern a)]
--     epats = enumerate . filter (isJust . steps)
--     --
--     tpat :: [(Int, Pattern a)] -> Pattern [(Int, (Time, Pattern a))]
--     tpat = mapM (\(i, pat) -> (\t -> (i, (t, pat))) <$> fromJust (steps pat))

stepcat :: [Pattern a] -> Pattern a
stepcat :: forall a. [Pattern a] -> Pattern a
stepcat [Pattern a]
pats = [(Rational, Pattern a)] -> Pattern a
forall a. [(Rational, Pattern a)] -> Pattern a
timecat ([(Rational, Pattern a)] -> Pattern a)
-> [(Rational, Pattern a)] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Pattern a -> (Rational, Pattern a))
-> [Pattern a] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map (\Pattern a
pat -> (Rational -> Maybe Rational -> Rational
forall a. a -> Maybe a -> a
fromMaybe Rational
1 (Maybe Rational -> Rational) -> Maybe Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Pattern a -> Maybe Rational
forall a. Pattern a -> Maybe Rational
steps Pattern a
pat, Pattern a
pat)) [Pattern a]
pats

_take :: Time -> Pattern a -> Pattern a
-- raise error?
_take :: forall a. Rational -> Pattern a -> Pattern a
_take Rational
_ pat :: Pattern a
pat@(Pattern State -> [Event a]
_ Maybe Rational
Nothing Maybe a
_) = Pattern a
pat
_take Rational
n pat :: Pattern a
pat@(Pattern State -> [Event a]
_ (Just Rational
t) Maybe a
_) = Maybe Rational -> Pattern a -> Pattern a
forall a. Maybe Rational -> Pattern a -> Pattern a
setSteps (Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
t') (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational, Rational) -> Pattern a -> Pattern a
forall a. (Rational, Rational) -> Pattern a -> Pattern a
zoom (Rational
b, Rational
e) Pattern a
pat
  where
    b :: Rational
b = if Rational
n Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 then Rational
0 else Rational
1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Rational -> Rational
forall a. Num a => a -> a
abs Rational
n Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
t)
    e :: Rational
e = if Rational
n Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 then Rational
n Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
t else Rational
1
    t' :: Rational
t' = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min (Rational -> Rational
forall a. Num a => a -> a
abs Rational
n) Rational
t

steptake :: Pattern Time -> Pattern a -> Pattern a
steptake :: forall a. Pattern Rational -> Pattern a -> Pattern a
steptake = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_take

_stepdrop :: Time -> Pattern a -> Pattern a
_stepdrop :: forall a. Rational -> Pattern a -> Pattern a
_stepdrop Rational
_ pat :: Pattern a
pat@(Pattern State -> [Event a]
_ Maybe Rational
Nothing Maybe a
_) = Pattern a
pat
_stepdrop Rational
n pat :: Pattern a
pat@(Pattern State -> [Event a]
_ (Just Rational
t) Maybe a
_) = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
steptake (Rational -> Pattern Rational
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Pattern Rational) -> Rational -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ Rational -> Rational
f Rational
t) Pattern a
pat
  where
    f :: Rational -> Rational
f Rational
t
      | Rational
n Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
0 = Rational
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
n
      | Bool
otherwise = Rational -> Rational
forall a. Num a => a -> a
negate (Rational
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
n)

stepdrop :: Pattern Time -> Pattern a -> Pattern a
stepdrop :: forall a. Pattern Rational -> Pattern a -> Pattern a
stepdrop = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_stepdrop

_expand :: Rational -> Pattern a -> Pattern a
_expand :: forall a. Rational -> Pattern a -> Pattern a
_expand Rational
factor Pattern a
pat = (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withSteps (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
factor) Pattern a
pat

_contract :: Rational -> Pattern a -> Pattern a
_contract :: forall a. Rational -> Pattern a -> Pattern a
_contract Rational
factor Pattern a
pat = (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withSteps (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
factor) Pattern a
pat

expand :: Pattern Rational -> Pattern a -> Pattern a
expand :: forall a. Pattern Rational -> Pattern a -> Pattern a
expand = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_expand

contract :: Pattern Rational -> Pattern a -> Pattern a
contract :: forall a. Pattern Rational -> Pattern a -> Pattern a
contract = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_contract

_extend :: Rational -> Pattern a -> Pattern a
_extend :: forall a. Rational -> Pattern a -> Pattern a
_extend Rational
factor Pattern a
pat = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_expand Rational
factor (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast Rational
factor Pattern a
pat

extend :: Pattern Rational -> Pattern a -> Pattern a
extend :: forall a. Pattern Rational -> Pattern a -> Pattern a
extend = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
s_patternify Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_extend

-- | Successively plays a pattern from each group in turn
stepalt :: [[Pattern a]] -> Pattern a
stepalt :: forall a. [[Pattern a]] -> Pattern a
stepalt [[Pattern a]]
groups = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
stepcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ [[Pattern a]] -> [Pattern a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pattern a]] -> [Pattern a]) -> [[Pattern a]] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ Int -> [[Pattern a]] -> [[Pattern a]]
forall a. Int -> [a] -> [a]
take (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
* [[Pattern a]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Pattern a]]
groups) ([[Pattern a]] -> [[Pattern a]]) -> [[Pattern a]] -> [[Pattern a]]
forall a b. (a -> b) -> a -> b
$ [[Pattern a]] -> [[Pattern a]]
forall a. [[a]] -> [[a]]
transpose ([[Pattern a]] -> [[Pattern a]]) -> [[Pattern a]] -> [[Pattern a]]
forall a b. (a -> b) -> a -> b
$ ([Pattern a] -> [Pattern a]) -> [[Pattern a]] -> [[Pattern a]]
forall a b. (a -> b) -> [a] -> [b]
map [Pattern a] -> [Pattern a]
forall a. HasCallStack => [a] -> [a]
cycle [[Pattern a]]
groups
  where
    c :: Int
c = (Int -> Int -> Int) -> [Int] -> Int
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Int -> Int -> Int
forall a. Integral a => a -> a -> a
lcm ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ([Pattern a] -> Int) -> [[Pattern a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Pattern a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Pattern a]]
groups

{-
s_while :: Pattern Bool -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_while patb f pat@(Pattern _ (Just t) _) = while (_steps t patb) f pat
-- TODO raise exception?
s_while _ _ pat = pat

_s_nth :: Bool -> Bool -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_s_nth lastone stepwise n f pat
  | n <= 1 = pat
  | otherwise = applyWhen stepwise (_fast t) $ s_cat $ applyWhen lastone reverse $ (f $ head cycles) : tail cycles
  where
    cycles = applyWhen lastone reverse $ separateCycles n $ applyWhen stepwise (_slow t) pat
    t = fromMaybe 1 $ steps pat

s_nthcycle :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_nthcycle (Pattern _ _ (Just i)) f pat = _s_nth True False i f pat
s_nthcycle tp f p = innerJoin $ (\t -> _s_nth True False t f p) <$> tp

s_nthcycle' :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_nthcycle' (Pattern _ _ (Just i)) f pat = _s_nth False False i f pat
s_nthcycle' tp f p = innerJoin $ (\t -> _s_nth False False t f p) <$> tp

s_nth :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_nth (Pattern _ _ (Just i)) f pat = _s_nth True True i f pat
s_nth tp f p = innerJoin $ (\t -> _s_nth True True t f p) <$> tp

s_nth' :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_nth' (Pattern _ _ (Just i)) f pat = _s_nth False True i f pat
s_nth' tp f p = innerJoin $ (\t -> _s_nth False True t f p) <$> tp

s_every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_every = s_nth'

s_everycycle :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
s_everycycle = s_nthcycle'

-- | Like @s_taper@, but returns a list of repetitions
s_taperlist :: Pattern a -> [Pattern a]
s_taperlist pat@(Pattern _ (Just t) _) = pat : map (\r -> _s_sub r pat) [1 .. t]
-- TODO exception?
s_taperlist pat = [pat]

s_taperlistBy :: Int -> Int -> Pattern a -> [Pattern a]
s_taperlistBy amount times pat@(Pattern _ (Just t) _)
  | times == 1 = [pat]
  | times <= 0 = []
  | amount == 0 = [pat]
  | backwards = reverse l
  | otherwise = l
  where
    backwards = amount > 0
    n = toRational $ abs amount
    start = t - toRational (max 0 $ n * toRational (times - 1))
    l = map (\i -> zoom (0, (start + (n * toRational i)) / t) pat) [0 .. times - 2] ++ [pat]
s_taperlistBy _ _ _ = []

-- | Plays one fewer step from the pattern each repetition, down to nothing
s_taper :: Pattern a -> Pattern a
s_taper = s_cat . s_taperlist

-- | Plays one fewer step from the pattern each repetition, down to nothing
_s_taperBy :: Int -> Int -> Pattern a -> Pattern a
_s_taperBy amount times pat = s_cat $ s_taperlistBy amount times pat

-- | Plays one fewer step from the pattern each repetition, down to nothing
s_taperBy :: Pattern Int -> Pattern Int -> Pattern a -> Pattern a
s_taperBy = s_patternify2 _s_taperBy
-}