{-
    Tactus.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)
import Data.Maybe (fromJust, isJust, mapMaybe)
import Sound.Tidal.Core (stack, timecat, zoompat)
import Sound.Tidal.Pattern
import Sound.Tidal.Utils (enumerate, nubOrd, pairs)

-- _lcmtactus :: [Pattern a] -> Maybe Time
-- _lcmtactus pats = foldl1 lcmr <$> (sequence $ map tactus 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 (Pattern 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

-- Breaks up pattern of patterns at event boundaries, then timecats them all together
stepJoin :: Pattern (Pattern a) -> Pattern a
stepJoin :: forall a. Pattern (Pattern a) -> Pattern a
stepJoin Pattern (Pattern a)
pp = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (State -> [Event a])
-> Maybe (Pattern Rational) -> Maybe a -> Pattern a
forall a.
(State -> [Event a])
-> Maybe (Pattern Rational) -> Maybe a -> Pattern a
Pattern State -> [Event a]
q Maybe (Pattern Rational)
t Maybe a
forall a. Maybe a
Nothing
  where
    q :: State -> [Event a]
q st :: State
st@(State Arc
a ValueMap
_) =
      Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query
        ( [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
$
            [(Rational, Pattern a)] -> [Pattern a]
forall a. [(Rational, Pattern a)] -> [Pattern a]
retime ([(Rational, Pattern a)] -> [Pattern a])
-> [(Rational, Pattern a)] -> [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
    -- TODO what's the tactus of the tactus and does it matter?
    t :: Maybe (Pattern Rational)
    t :: Maybe (Pattern Rational)
t = Pattern Rational -> Maybe (Pattern Rational)
forall a. a -> Maybe a
Just (Pattern Rational -> Maybe (Pattern Rational))
-> Pattern Rational -> Maybe (Pattern Rational)
forall a b. (a -> b) -> a -> b
$ (State -> [Event Rational])
-> Maybe (Pattern Rational) -> Maybe Rational -> Pattern Rational
forall a.
(State -> [Event a])
-> Maybe (Pattern Rational) -> Maybe a -> Pattern a
Pattern State -> [Event Rational]
t_q Maybe (Pattern Rational)
forall a. Maybe a
Nothing Maybe Rational
forall a. Maybe a
Nothing
    t_q :: State -> [Event Rational]
    t_q :: State -> [Event Rational]
t_q st :: State
st@(State Arc
a' ValueMap
_) = [Event Rational]
-> (Pattern Rational -> [Event Rational])
-> Maybe (Pattern Rational)
-> [Event Rational]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Pattern Rational -> State -> [Event Rational]
forall a. Pattern a -> State -> [Event a]
`query` State
st) (Pattern a -> Maybe (Pattern Rational)
forall a. Pattern a -> Maybe (Pattern Rational)
tactus ([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
$ [(Rational, Pattern a)] -> [Pattern a]
forall a. [(Rational, Pattern a)] -> [Pattern a]
retime ([(Rational, Pattern a)] -> [Pattern a])
-> [(Rational, Pattern a)] -> [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})))
    -- retime each pattern slice
    retime :: [(Time, Pattern a)] -> [Pattern a]
    retime :: forall a. [(Rational, Pattern a)] -> [Pattern a]
retime [(Rational, Pattern a)]
xs = ((Rational, Pattern a) -> Pattern a)
-> [(Rational, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map ((Rational -> Pattern a -> Pattern a)
-> (Rational, Pattern a) -> Pattern a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> 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 (Pattern Rational) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Pattern Rational) -> Bool)
-> ((Rational, Pattern a) -> Maybe (Pattern Rational))
-> (Rational, Pattern a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Maybe (Pattern Rational)
forall a. Pattern a -> Maybe (Pattern Rational)
tactus (Pattern a -> Maybe (Pattern Rational))
-> ((Rational, Pattern a) -> Pattern a)
-> (Rational, Pattern a)
-> Maybe (Pattern 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 :: Pattern Rational
occupied_tactus = [Pattern Rational] -> Pattern Rational
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Pattern Rational] -> Pattern Rational)
-> [Pattern Rational] -> Pattern Rational
forall a b. (a -> b) -> a -> b
$ ((Rational, Pattern a) -> Maybe (Pattern Rational))
-> [(Rational, Pattern a)] -> [Pattern Rational]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Pattern a -> Maybe (Pattern Rational)
forall a. Pattern a -> Maybe (Pattern Rational)
tactus (Pattern a -> Maybe (Pattern Rational))
-> ((Rational, Pattern a) -> Pattern a)
-> (Rational, Pattern a)
-> Maybe (Pattern 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 :: Pattern Rational
total_tactus = (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
occupied_perc) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
occupied_tactus
        adjust :: Rational -> Pattern a -> Pattern a
adjust Rational
_ pat :: Pattern a
pat@(Pattern {tactus :: forall a. Pattern a -> Maybe (Pattern Rational)
tactus = Just Pattern Rational
_}) = Pattern a
pat
        adjust Rational
dur Pattern a
pat = Maybe (Pattern Rational) -> Pattern a -> Pattern a
forall a. Maybe (Pattern Rational) -> Pattern a -> Pattern a
setTactus (Pattern Rational -> Maybe (Pattern Rational)
forall a. a -> Maybe a
Just (Pattern Rational -> Maybe (Pattern Rational))
-> Pattern Rational -> Maybe (Pattern Rational)
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
dur) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
total_tactus) Pattern a
pat
    -- break up events at all start/end points, into groups
    -- stacked into single patterns, with duration. Some patterns
    -- will be have no events.
    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 :: forall a. [Pattern a] -> Pattern a
stepcat [Pattern a]
pats = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
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)
-> ([(Int, (Rational, Pattern a))] -> [(Rational, Pattern a)])
-> [(Int, (Rational, Pattern a))]
-> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (Rational, Pattern a)) -> (Rational, Pattern a))
-> [(Int, (Rational, Pattern a))] -> [(Rational, Pattern a)]
forall a b. (a -> b) -> [a] -> [b]
map (Int, (Rational, Pattern a)) -> (Rational, Pattern a)
forall a b. (a, b) -> b
snd ([(Int, (Rational, Pattern a))] -> [(Rational, Pattern a)])
-> ([(Int, (Rational, Pattern a))]
    -> [(Int, (Rational, Pattern a))])
-> [(Int, (Rational, Pattern a))]
-> [(Rational, Pattern a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, (Rational, Pattern a)) -> Int)
-> [(Int, (Rational, Pattern a))] -> [(Int, (Rational, Pattern a))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Int, (Rational, Pattern a)) -> Int
forall a b. (a, b) -> a
fst) ([(Int, (Rational, Pattern a))] -> Pattern a)
-> Pattern [(Int, (Rational, Pattern a))] -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))]
forall a.
[(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))]
tpat ([(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))])
-> [(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))]
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> [(Int, Pattern a)]
forall a. [Pattern a] -> [(Int, Pattern a)]
epats [Pattern a]
pats)
  where
    -- enumerated patterns, ignoring those without tactus
    epats :: [Pattern a] -> [(Int, Pattern a)]
    epats :: forall a. [Pattern a] -> [(Int, Pattern a)]
epats = [Pattern a] -> [(Int, Pattern a)]
forall a. [a] -> [(Int, a)]
enumerate ([Pattern a] -> [(Int, Pattern a)])
-> ([Pattern a] -> [Pattern a])
-> [Pattern a]
-> [(Int, Pattern a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pattern a -> Bool) -> [Pattern a] -> [Pattern a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe (Pattern Rational) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Pattern Rational) -> Bool)
-> (Pattern a -> Maybe (Pattern Rational)) -> Pattern a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Maybe (Pattern Rational)
forall a. Pattern a -> Maybe (Pattern Rational)
tactus)
    --
    tpat :: [(Int, Pattern a)] -> Pattern [(Int, (Time, Pattern a))]
    tpat :: forall a.
[(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))]
tpat = ((Int, Pattern a) -> Pattern (Int, (Rational, Pattern a)))
-> [(Int, Pattern a)] -> Pattern [(Int, (Rational, Pattern a))]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Int
i, Pattern a
pat) -> (\Rational
t -> (Int
i, (Rational
t, Pattern a
pat))) (Rational -> (Int, (Rational, Pattern a)))
-> Pattern Rational -> Pattern (Int, (Rational, Pattern a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Pattern Rational) -> Pattern Rational
forall a. HasCallStack => Maybe a -> a
fromJust (Pattern a -> Maybe (Pattern Rational)
forall a. Pattern a -> Maybe (Pattern Rational)
tactus Pattern a
pat))

_steptake :: Time -> Pattern a -> Pattern a
-- raise error?
_steptake :: forall a. Rational -> Pattern a -> Pattern a
_steptake Rational
_ pat :: Pattern a
pat@(Pattern State -> [Event a]
_ Maybe (Pattern Rational)
Nothing Maybe a
_) = Pattern a
pat
_steptake Rational
n pat :: Pattern a
pat@(Pattern State -> [Event a]
_ (Just Pattern Rational
tpat) Maybe a
_) = Maybe (Pattern Rational) -> Pattern a -> Pattern a
forall a. Maybe (Pattern Rational) -> Pattern a -> Pattern a
setTactus (Pattern Rational -> Maybe (Pattern Rational)
forall a. a -> Maybe a
Just Pattern Rational
tpat') (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
forall a.
Pattern Rational -> Pattern Rational -> Pattern a -> Pattern a
zoompat Pattern Rational
b Pattern Rational
e Pattern a
pat
  where
    b :: Pattern Rational
b = (\Rational
t -> 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)) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
tpat
    e :: Pattern Rational
e = (\Rational
t -> 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) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
tpat
    tpat' :: Pattern Rational
tpat' = (\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) (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
tpat

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
_steptake

_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 (Pattern Rational)
Nothing Maybe a
_) = Pattern a
pat
_stepdrop Rational
n pat :: Pattern a
pat@(Pattern State -> [Event a]
_ (Just Pattern Rational
tpat) Maybe a
_) = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
steptake (Rational -> Rational
f (Rational -> Rational) -> Pattern Rational -> Pattern Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
tpat) 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
0 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (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
withTactus (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
withTactus (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

{-
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 $ tactus 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

-- | Successively plays a pattern from each group in turn
s_alt :: [[Pattern a]] -> Pattern a
s_alt groups = s_cat $ concat $ take (c * length groups) $ transpose $ map cycle groups
  where
    c = foldl1 lcm $ map length groups

-}