{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, BangPatterns #-}

module Sound.Tidal.Core where

import           Prelude hiding ((<*), (*>))

import           Data.Fixed (mod')
import qualified Data.Map.Strict as Map

import           Sound.Tidal.Pattern

-- ** Elemental patterns

-- | An empty pattern
silence :: Pattern a
silence :: Pattern a
silence = Pattern a
forall a. Pattern a
empty

-- | Takes a function from time to values, and turns it into a 'Pattern'.
sig :: (Time -> a) -> Pattern a
sig :: (Time -> a) -> Pattern a
sig f :: Time -> a
f = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern Query a
q
  where q :: Query a
q (State (Arc s :: Time
s e :: Time
e) _)
          | Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
e = []
          | Bool
otherwise = [Context
-> Maybe (ArcF Time) -> ArcF Time -> a -> EventF (ArcF Time) a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) Maybe (ArcF Time)
forall a. Maybe a
Nothing (Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc Time
s Time
e) (Time -> a
f (Time
sTime -> Time -> Time
forall a. Num a => a -> a -> a
+((Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s)Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/2)))]

-- | @sine@ returns a 'Pattern' of continuous 'Fractional' values following a
-- sinewave with frequency of one cycle, and amplitude from 0 to 1.
sine :: Fractional a => Pattern a
sine :: Pattern a
sine = (Time -> a) -> Pattern a
forall a. (Time -> a) -> Pattern a
sig ((Time -> a) -> Pattern a) -> (Time -> a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \t :: Time
t -> (Double -> a
sin_rat ((Double
forall a. Floating a => a
pi :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
t) a -> a -> a
forall a. Num a => a -> a -> a
+ 1) a -> a -> a
forall a. Fractional a => a -> a -> a
/ 2
  where sin_rat :: Double -> a
sin_rat = Time -> a
forall a. Fractional a => Time -> a
fromRational (Time -> a) -> (Double -> Time) -> Double -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Time
forall a. Real a => a -> Time
toRational (Double -> Time) -> (Double -> Double) -> Double -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall a. Floating a => a -> a
sin

-- | @cosine@ is a synonym for @0.25 ~> sine@.
cosine :: Fractional a => Pattern a
cosine :: Pattern a
cosine = 0.25 Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
`rotR` Pattern a
forall a. Fractional a => Pattern a
sine

-- | @saw@ is the equivalent of 'sine' for (ascending) sawtooth waves.
saw :: (Fractional a, Real a) => Pattern a
saw :: Pattern a
saw = (Time -> a) -> Pattern a
forall a. (Time -> a) -> Pattern a
sig ((Time -> a) -> Pattern a) -> (Time -> a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \t :: Time
t -> a -> a -> a
forall a. Real a => a -> a -> a
mod' (Time -> a
forall a. Fractional a => Time -> a
fromRational Time
t) 1

-- | @isaw@ is the equivalent of 'sine' for inverse (descending) sawtooth waves.
isaw :: (Fractional a, Real a) => Pattern a
isaw :: Pattern a
isaw = (1a -> a -> a
forall a. Num a => a -> a -> a
-) (a -> a) -> Pattern a -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
forall a. (Fractional a, Real a) => Pattern a
saw

-- | @tri@ is the equivalent of 'sine' for triangular waves.
tri :: (Fractional a, Real a) => Pattern a
tri :: Pattern a
tri = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
fastAppend Pattern a
forall a. (Fractional a, Real a) => Pattern a
saw Pattern a
forall a. (Fractional a, Real a) => Pattern a
isaw

-- | @square@ is the equivalent of 'sine' for square waves.
square :: (Fractional a) => Pattern a
square :: Pattern a
square = (Time -> a) -> Pattern a
forall a. (Time -> a) -> Pattern a
sig ((Time -> a) -> Pattern a) -> (Time -> a) -> Pattern a
forall a b. (a -> b) -> a -> b
$
       \t :: Time
t -> Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Real a => a -> a -> a
mod' (Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
t :: Double) 1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* 2) :: Integer)

-- | @envL@ is a 'Pattern' of continuous 'Double' values, representing
-- a linear interpolation between 0 and 1 during the first cycle, then
-- staying constant at 1 for all following cycles. Possibly only
-- useful if you're using something like the retrig function defined
-- in tidal.el.
envL :: Pattern Double
envL :: Pattern Double
envL = (Time -> Double) -> Pattern Double
forall a. (Time -> a) -> Pattern a
sig ((Time -> Double) -> Pattern Double)
-> (Time -> Double) -> Pattern Double
forall a b. (a -> b) -> a -> b
$ \t :: Time
t -> Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
t) 1

-- | like 'envL' but reversed.
envLR :: Pattern Double
envLR :: Pattern Double
envLR = (1Double -> Double -> Double
forall a. Num a => a -> a -> a
-) (Double -> Double) -> Pattern Double -> Pattern Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Double
envL

-- | 'Equal power' version of 'env', for gain-based transitions
envEq :: Pattern Double
envEq :: Pattern Double
envEq = (Time -> Double) -> Pattern Double
forall a. (Time -> a) -> Pattern a
sig ((Time -> Double) -> Pattern Double)
-> (Time -> Double) -> Pattern Double
forall a b. (a -> b) -> a -> b
$ \t :: Time
t -> Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double
forall a. Floating a => a -> a
sin (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Time -> Double
forall a. Fractional a => Time -> a
fromRational (1Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
t)) 1)))

-- | Equal power reversed
envEqR :: Pattern Double
envEqR :: Pattern Double
envEqR = (Time -> Double) -> Pattern Double
forall a. (Time -> a) -> Pattern a
sig ((Time -> Double) -> Pattern Double)
-> (Time -> Double) -> Pattern Double
forall a b. (a -> b) -> a -> b
$ \t :: Time
t -> Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double
forall a. Floating a => a -> a
cos (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
max 0 (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Time -> Double
forall a. Fractional a => Time -> a
fromRational (1Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
t)) 1)))

-- ** Pattern algebra

-- class for types that support a left-biased union
class Unionable a where
  union :: a -> a -> a

-- default union is just to take the left hand side..
instance Unionable a where
  union :: a -> a -> a
union = a -> a -> a
forall a b. a -> b -> a
const

instance {-# OVERLAPPING #-} Unionable ControlMap where
  union :: ControlMap -> ControlMap -> ControlMap
union = ControlMap -> ControlMap -> ControlMap
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union

(|+|) :: (Applicative a, Num b) => a b -> a b -> a b
a :: a b
a |+| :: a b -> a b -> a b
|+| b :: a b
b = b -> b -> b
forall a. Num a => a -> a -> a
(+) (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|+ ) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |+ :: Pattern a -> Pattern a -> Pattern a
|+  b :: Pattern a
b = a -> a -> a
forall a. Num a => a -> a -> a
(+) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( +|) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  +| :: Pattern a -> Pattern a -> Pattern a
+| b :: Pattern a
b = a -> a -> a
forall a. Num a => a -> a -> a
(+) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|++|) :: Applicative a => a String -> a String -> a String
a :: a String
a |++| :: a String -> a String -> a String
|++| b :: a String
b = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String) -> a String -> a (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a String
a a (String -> String) -> a String -> a String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a String
b
(|++ ) :: Pattern String -> Pattern String -> Pattern String
a :: Pattern String
a |++ :: Pattern String -> Pattern String -> Pattern String
|++  b :: Pattern String
b = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> Pattern String -> Pattern (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
a Pattern (String -> String) -> Pattern String -> Pattern String
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern String
b
( ++|) :: Pattern String -> Pattern String -> Pattern String
a :: Pattern String
a  ++| :: Pattern String -> Pattern String -> Pattern String
++| b :: Pattern String
b = String -> String -> String
forall a. [a] -> [a] -> [a]
(++) (String -> String -> String)
-> Pattern String -> Pattern (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern String
a Pattern (String -> String) -> Pattern String -> Pattern String
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern String
b

(|/|) :: (Applicative a, Fractional b) => a b -> a b -> a b
a :: a b
a |/| :: a b -> a b -> a b
|/| b :: a b
b = b -> b -> b
forall a. Fractional a => a -> a -> a
(/) (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|/ ) :: Fractional a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |/ :: Pattern a -> Pattern a -> Pattern a
|/  b :: Pattern a
b = a -> a -> a
forall a. Fractional a => a -> a -> a
(/) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( /|) :: Fractional a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  /| :: Pattern a -> Pattern a -> Pattern a
/| b :: Pattern a
b = a -> a -> a
forall a. Fractional a => a -> a -> a
(/) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|*|) :: (Applicative a, Num b) => a b -> a b -> a b
a :: a b
a |*| :: a b -> a b -> a b
|*| b :: a b
b = b -> b -> b
forall a. Num a => a -> a -> a
(*) (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|* ) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |* :: Pattern a -> Pattern a -> Pattern a
|*  b :: Pattern a
b = a -> a -> a
forall a. Num a => a -> a -> a
(*) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( *|) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  *| :: Pattern a -> Pattern a -> Pattern a
*| b :: Pattern a
b = a -> a -> a
forall a. Num a => a -> a -> a
(*) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|-|) :: (Applicative a, Num b) => a b -> a b -> a b
a :: a b
a |-| :: a b -> a b -> a b
|-| b :: a b
b = (-) (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|- ) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |- :: Pattern a -> Pattern a -> Pattern a
|-  b :: Pattern a
b = (-) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( -|) :: Num a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  -| :: Pattern a -> Pattern a -> Pattern a
-| b :: Pattern a
b = (-) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|%|) :: (Applicative a, Real b) => a b -> a b -> a b
a :: a b
a |%| :: a b -> a b -> a b
|%| b :: a b
b = b -> b -> b
forall a. Real a => a -> a -> a
mod' (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|% ) :: Real a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |% :: Pattern a -> Pattern a -> Pattern a
|%  b :: Pattern a
b = a -> a -> a
forall a. Real a => a -> a -> a
mod' (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( %|) :: Real a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  %| :: Pattern a -> Pattern a -> Pattern a
%| b :: Pattern a
b = a -> a -> a
forall a. Real a => a -> a -> a
mod' (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|**|) :: (Applicative a, Floating b) => a b -> a b -> a b
a :: a b
a |**| :: a b -> a b -> a b
|**| b :: a b
b = b -> b -> b
forall a. Floating a => a -> a -> a
(**) (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|** ) :: Floating a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |** :: Pattern a -> Pattern a -> Pattern a
|**  b :: Pattern a
b = a -> a -> a
forall a. Floating a => a -> a -> a
(**) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( **|) :: Floating a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  **| :: Pattern a -> Pattern a -> Pattern a
**| b :: Pattern a
b = a -> a -> a
forall a. Floating a => a -> a -> a
(**) (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|>|) :: (Applicative a, Unionable b) => a b -> a b -> a b
a :: a b
a |>| :: a b -> a b -> a b
|>| b :: a b
b = (b -> b -> b) -> b -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> b -> b
forall a. Unionable a => a -> a -> a
union (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|> ) :: Unionable a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |> :: Pattern a -> Pattern a -> Pattern a
|>  b :: Pattern a
b = (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Unionable a => a -> a -> a
union (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( >|) :: Unionable a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  >| :: Pattern a -> Pattern a -> Pattern a
>| b :: Pattern a
b = (a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Unionable a => a -> a -> a
union (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

(|<|) :: (Applicative a, Unionable b) => a b -> a b -> a b
a :: a b
a |<| :: a b -> a b -> a b
|<| b :: a b
b = b -> b -> b
forall a. Unionable a => a -> a -> a
union (b -> b -> b) -> a b -> a (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a b
a a (b -> b) -> a b -> a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a b
b
(|< ) :: Unionable a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a |< :: Pattern a -> Pattern a -> Pattern a
|<  b :: Pattern a
b = a -> a -> a
forall a. Unionable a => a -> a -> a
union (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
<* Pattern a
b
( <|) :: Unionable a => Pattern a -> Pattern a -> Pattern a
a :: Pattern a
a  <| :: Pattern a -> Pattern a -> Pattern a
<| b :: Pattern a
b = a -> a -> a
forall a. Unionable a => a -> a -> a
union (a -> a -> a) -> Pattern a -> Pattern (a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (a -> a) -> Pattern a -> Pattern a
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
*> Pattern a
b

-- Backward compatibility - structure from left, values from right.
(#) :: Unionable b => Pattern b -> Pattern b -> Pattern b
# :: Pattern b -> Pattern b -> Pattern b
(#) = Pattern b -> Pattern b -> Pattern b
forall a. Unionable a => Pattern a -> Pattern a -> Pattern a
(|>)



-- ** Constructing patterns

-- | Turns a list of values into a pattern, playing one of them per cycle.
fromList :: [a] -> Pattern a
fromList :: [a] -> Pattern a
fromList = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat ([Pattern a] -> Pattern a)
-> ([a] -> [Pattern a]) -> [a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pattern a) -> [a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Turns a list of values into a pattern, playing one of them per cycle.
fastFromList :: [a] -> Pattern a
fastFromList :: [a] -> Pattern a
fastFromList = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a)
-> ([a] -> [Pattern a]) -> [a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Pattern a) -> [a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | A synonym for 'fastFromList'
listToPat :: [a] -> Pattern a
listToPat :: [a] -> Pattern a
listToPat = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList

-- | 'fromMaybes; is similar to 'fromList', but allows values to
-- be optional using the 'Maybe' type, so that 'Nothing' results in
-- gaps in the pattern.
fromMaybes :: [Maybe a] -> Pattern a
fromMaybes :: [Maybe a] -> Pattern a
fromMaybes = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastcat ([Pattern a] -> Pattern a)
-> ([Maybe a] -> [Pattern a]) -> [Maybe a] -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Pattern a) -> [Maybe a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map Maybe a -> Pattern a
forall a. Maybe a -> Pattern a
f
  where f :: Maybe a -> Pattern a
f Nothing = Pattern a
forall a. Pattern a
silence
        f (Just x :: a
x) = a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | A pattern of whole numbers from 0 to the given number, in a single cycle.
run :: (Enum a, Num a) => Pattern a -> Pattern a
run :: Pattern a -> Pattern a
run = (Pattern a -> (a -> Pattern a) -> Pattern a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Pattern a
forall a. (Enum a, Num a) => a -> Pattern a
_run)

_run :: (Enum a, Num a) => a -> Pattern a
_run :: a -> Pattern a
_run n :: a
n = [a] -> Pattern a
forall a. [a] -> Pattern a
fastFromList [0 .. a
na -> a -> a
forall a. Num a => a -> a -> a
-1]

-- | From @1@ for the first cycle, successively adds a number until it gets up to @n@
scan :: (Enum a, Num a) => Pattern a -> Pattern a
scan :: Pattern a -> Pattern a
scan = (Pattern a -> (a -> Pattern a) -> Pattern a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Pattern a
forall a. (Enum a, Num a) => a -> Pattern a
_scan)

_scan :: (Enum a, Num a) => a -> Pattern a
_scan :: a -> Pattern a
_scan n :: a
n = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
slowcat ([Pattern a] -> Pattern a) -> [Pattern a] -> Pattern a
forall a b. (a -> b) -> a -> b
$ (a -> Pattern a) -> [a] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Pattern a
forall a. (Enum a, Num a) => a -> Pattern a
_run [1 .. a
n]

-- ** Combining patterns

-- | Alternate between cycles of the two given patterns
append :: Pattern a -> Pattern a -> Pattern a
append :: Pattern a -> Pattern a -> Pattern a
append a :: Pattern a
a b :: Pattern a
b = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat [Pattern a
a,Pattern a
b]

-- | Like 'append', but for a list of patterns. Interlaces them, playing the first cycle from each
-- in turn, then the second cycle from each, and so on.
cat :: [Pattern a] -> Pattern a
cat :: [Pattern a] -> Pattern a
cat [] = Pattern a
forall a. Pattern a
silence
cat ps :: [Pattern a]
ps = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (Query a -> Pattern a) -> Query a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Query a
q
  where n :: Int
n = [Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps
        q :: Query a
q st :: State
st = (ArcF Time -> [Event a]) -> [ArcF Time] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (State -> ArcF Time -> [Event a]
f State
st) ([ArcF Time] -> [Event a]) -> [ArcF Time] -> [Event a]
forall a b. (a -> b) -> a -> b
$ ArcF Time -> [ArcF Time]
arcCyclesZW (State -> ArcF Time
arc State
st)
        f :: State -> ArcF Time -> [Event a]
f st :: State
st a :: ArcF Time
a = Pattern a -> Query a
forall a. Pattern a -> Query a
query ((Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
withResultTime (Time -> Time -> Time
forall a. Num a => a -> a -> a
+Time
offset) Pattern a
p) Query a -> Query a
forall a b. (a -> b) -> a -> b
$ State
st {arc :: ArcF Time
arc = Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc (Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract Time
offset (ArcF Time -> Time
forall a. ArcF a -> a
start ArcF Time
a)) (Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract Time
offset (ArcF Time -> Time
forall a. ArcF a -> a
stop ArcF Time
a))}
          where p :: Pattern a
p = [Pattern a]
ps [Pattern a] -> Int -> Pattern a
forall a. [a] -> Int -> a
!! Int
i
                cyc :: Int
cyc = (Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Time -> Int) -> Time -> Int
forall a b. (a -> b) -> a -> b
$ ArcF Time -> Time
forall a. ArcF a -> a
start ArcF Time
a) :: Int
                i :: Int
i = Int
cyc Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n
                offset :: Time
offset = (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Time) -> Int -> Time
forall a b. (a -> b) -> a -> b
$ Int
cyc Int -> Int -> Int
forall a. Num a => a -> a -> a
- ((Int
cyc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
i) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
n)) :: Time

-- | Alias for 'cat'
slowCat :: [Pattern a] -> Pattern a
slowCat :: [Pattern a] -> Pattern a
slowCat = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat
slowcat :: [Pattern a] -> Pattern a
slowcat :: [Pattern a] -> Pattern a
slowcat = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
slowCat

-- | Alias for 'append'
slowAppend :: Pattern a -> Pattern a -> Pattern a
slowAppend :: Pattern a -> Pattern a -> Pattern a
slowAppend = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
append
slowappend :: Pattern a -> Pattern a -> Pattern a
slowappend :: Pattern a -> Pattern a -> Pattern a
slowappend = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
append

-- | Like 'append', but twice as fast
fastAppend :: Pattern a -> Pattern a -> Pattern a
fastAppend :: Pattern a -> Pattern a -> Pattern a
fastAppend a :: Pattern a
a b :: Pattern a
b = Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast 2 (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
append Pattern a
a Pattern a
b
fastappend :: Pattern a -> Pattern a -> Pattern a
fastappend :: Pattern a -> Pattern a -> Pattern a
fastappend = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
fastAppend

-- | The same as 'cat', but speeds up the result by the number of
-- patterns there are, so the cycles from each are squashed to fit a
-- single cycle.
fastCat :: [Pattern a] -> Pattern a
fastCat :: [Pattern a] -> Pattern a
fastCat ps :: [Pattern a]
ps = Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast (Int -> Time
forall a. Real a => a -> Time
toTime (Int -> Time) -> Int -> Time
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Pattern a]
ps) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat [Pattern a]
ps

fastcat :: [Pattern a] -> Pattern a
fastcat :: [Pattern a] -> Pattern a
fastcat = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
fastCat

-- | Similar to @fastCat@, but each pattern is given a relative duration
timeCat :: [(Time, Pattern a)] -> Pattern a
timeCat :: [(Time, Pattern a)] -> Pattern a
timeCat tps :: [(Time, Pattern a)]
tps = [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
$ ((Time, Time, Pattern a) -> Pattern a)
-> [(Time, Time, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Time
s,e :: Time
e,p :: Pattern a
p) -> ArcF Time -> Pattern a -> Pattern a
forall a. ArcF Time -> Pattern a -> Pattern a
compressArc (Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc (Time
sTime -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
total) (Time
eTime -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
total)) Pattern a
p) ([(Time, Time, Pattern a)] -> [Pattern a])
-> [(Time, Time, Pattern a)] -> [Pattern a]
forall a b. (a -> b) -> a -> b
$ Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
forall a. Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
arrange 0 [(Time, Pattern a)]
tps
    where total :: Time
total = [Time] -> Time
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Time] -> Time) -> [Time] -> Time
forall a b. (a -> b) -> a -> b
$ ((Time, Pattern a) -> Time) -> [(Time, Pattern a)] -> [Time]
forall a b. (a -> b) -> [a] -> [b]
map (Time, Pattern a) -> Time
forall a b. (a, b) -> a
fst [(Time, Pattern a)]
tps
          arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
          arrange :: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
arrange _ [] = []
          arrange t :: Time
t ((t' :: Time
t',p :: Pattern a
p):tps' :: [(Time, Pattern a)]
tps') = (Time
t,Time
tTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
t',Pattern a
p) (Time, Time, Pattern a)
-> [(Time, Time, Pattern a)] -> [(Time, Time, Pattern a)]
forall a. a -> [a] -> [a]
: Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
forall a. Time -> [(Time, Pattern a)] -> [(Time, Time, Pattern a)]
arrange (Time
tTime -> Time -> Time
forall a. Num a => a -> a -> a
+Time
t') [(Time, Pattern a)]
tps'

-- | 'overlay' combines two 'Pattern's into a new pattern, so that
-- their events are combined over time. 
overlay :: Pattern a -> Pattern a -> Pattern a
overlay :: Pattern a -> Pattern a -> Pattern a
overlay !Pattern a
p !Pattern a
p' = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (Query a -> Pattern a) -> Query a -> Pattern a
forall a b. (a -> b) -> a -> b
$ \st :: State
st -> Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p State
st [Event a] -> [Event a] -> [Event a]
forall a. [a] -> [a] -> [a]
++ Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p' State
st

-- | An infix alias of @overlay@
(<>) :: Pattern a -> Pattern a -> Pattern a
<> :: Pattern a -> Pattern a -> Pattern a
(<>) = Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay

-- | 'stack' combines a list of 'Pattern's into a new pattern, so that
-- their events are combined over time.
stack :: [Pattern a] -> Pattern a
stack :: [Pattern a] -> Pattern a
stack = (Pattern a -> Pattern a -> Pattern a)
-> Pattern a -> [Pattern a] -> Pattern a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Pattern a -> Pattern a -> Pattern a
forall a. Pattern a -> Pattern a -> Pattern a
overlay Pattern a
forall a. Pattern a
silence



-- ** Manipulating time

-- | Shifts a pattern back in time by the given amount, expressed in cycles
(<~) :: Pattern Time -> Pattern a -> Pattern a
<~ :: Pattern Time -> Pattern a -> Pattern a
(<~) = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
rotL

-- | Shifts a pattern forward in time by the given amount, expressed in cycles
(~>) :: Pattern Time -> Pattern a -> Pattern a
~> :: Pattern Time -> Pattern a -> Pattern a
(~>) = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
rotR

-- | Speed up a pattern by the given time pattern
fast :: Pattern Time -> Pattern a -> Pattern a
fast :: Pattern Time -> Pattern a -> Pattern a
fast = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast

-- | Slow down a pattern by the factors in the given time pattern, 'squeezing'
-- the pattern to fit the slot given in the time pattern
fastSqueeze :: Pattern Time -> Pattern a -> Pattern a
fastSqueeze :: Pattern Time -> Pattern a -> Pattern a
fastSqueeze = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
tParamSqueeze Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast

-- | An alias for @fast@
density :: Pattern Time -> Pattern a -> Pattern a
density :: Pattern Time -> Pattern a -> Pattern a
density = Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
fast

_fast :: Time -> Pattern a -> Pattern a
_fast :: Time -> Pattern a -> Pattern a
_fast r :: Time
r p :: Pattern a
p | Time
r Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Pattern a
forall a. Pattern a
silence
          | Time
r Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
rev (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast (Time -> Time
forall a. Num a => a -> a
negate Time
r) Pattern a
p
          | Bool
otherwise = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
withResultTime (Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/ Time
r) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
withQueryTime (Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time
r) Pattern a
p

-- | Slow down a pattern by the given time pattern
slow :: Pattern Time -> Pattern a -> Pattern a
slow :: Pattern Time -> Pattern a -> Pattern a
slow = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_slow
_slow :: Time -> Pattern a -> Pattern a
_slow :: Time -> Pattern a -> Pattern a
_slow 0 _ = Pattern a
forall a. Pattern a
silence
_slow r :: Time
r p :: Pattern a
p = Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fast (1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
r) Pattern a
p

-- | Slow down a pattern by the factors in the given time pattern, 'squeezing'
-- the pattern to fit the slot given in the time pattern
slowSqueeze :: Pattern Time -> Pattern a -> Pattern a
slowSqueeze :: Pattern Time -> Pattern a -> Pattern a
slowSqueeze = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
tParamSqueeze Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_slow

-- | An alias for @slow@
sparsity :: Pattern Time -> Pattern a -> Pattern a
sparsity :: Pattern Time -> Pattern a -> Pattern a
sparsity = Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
slow

-- | @rev p@ returns @p@ with the event positions in each cycle
-- reversed (or mirrored).
rev :: Pattern a -> Pattern a
rev :: Pattern a -> Pattern a
rev p :: Pattern a
p =
  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
$ Pattern a
p {
    query :: Query a
query = \st :: State
st -> (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Event a
forall a. Event a -> Event a
makeWholeAbsolute ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$
      (ArcF Time -> ArcF Time) -> [Event a] -> [Event a]
forall a. (ArcF Time -> ArcF Time) -> [Event a] -> [Event a]
mapParts (Time -> ArcF Time -> ArcF Time
mirrorArc (ArcF Time -> Time
midCycle (ArcF Time -> Time) -> ArcF Time -> Time
forall a b. (a -> b) -> a -> b
$ State -> ArcF Time
arc State
st)) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$
      (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Event a
forall a. Event a -> Event a
makeWholeRelative
      (Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p State
st
        {arc :: ArcF Time
arc = Time -> ArcF Time -> ArcF Time
mirrorArc (ArcF Time -> Time
midCycle (ArcF Time -> Time) -> ArcF Time -> Time
forall a b. (a -> b) -> a -> b
$ State -> ArcF Time
arc State
st) (State -> ArcF Time
arc State
st)
        })
    }
  where makeWholeRelative :: Event a -> Event a
        makeWholeRelative :: Event a -> Event a
makeWholeRelative (e :: Event a
e@(Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe (ArcF Time)
Nothing})) = Event a
e
        makeWholeRelative (Event c :: Context
c (Just (Arc s :: Time
s e :: Time
e)) p' :: ArcF Time
p'@(Arc s' :: Time
s' e' :: Time
e') v :: a
v) =
          Context -> Maybe (ArcF Time) -> ArcF Time -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (ArcF Time -> Maybe (ArcF Time)
forall a. a -> Maybe a
Just (ArcF Time -> Maybe (ArcF Time)) -> ArcF Time -> Maybe (ArcF Time)
forall a b. (a -> b) -> a -> b
$ Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc (Time
s'Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s) (Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
e')) ArcF Time
p' a
v
        makeWholeAbsolute :: Event a -> Event a
        makeWholeAbsolute :: Event a -> Event a
makeWholeAbsolute (e :: Event a
e@(Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe (ArcF Time)
Nothing})) = Event a
e
        makeWholeAbsolute (Event c :: Context
c (Just (Arc s :: Time
s e :: Time
e)) p' :: ArcF Time
p'@(Arc s' :: Time
s' e' :: Time
e') v :: a
v) =
          Context -> Maybe (ArcF Time) -> ArcF Time -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (ArcF Time -> Maybe (ArcF Time)
forall a. a -> Maybe a
Just (ArcF Time -> Maybe (ArcF Time)) -> ArcF Time -> Maybe (ArcF Time)
forall a b. (a -> b) -> a -> b
$ Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc (Time
s'Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
e) (Time
e'Time -> Time -> Time
forall a. Num a => a -> a -> a
+Time
s)) ArcF Time
p' a
v
        midCycle :: Arc -> Time
        midCycle :: ArcF Time -> Time
midCycle (Arc s :: Time
s _) = Time -> Time
sam Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ 0.5
        mapParts :: (Arc -> Arc) -> [Event a] -> [Event a]
        mapParts :: (ArcF Time -> ArcF Time) -> [Event a] -> [Event a]
mapParts f :: ArcF Time -> ArcF Time
f es :: [Event a]
es = (\(Event c :: Context
c w :: Maybe (ArcF Time)
w p' :: ArcF Time
p' v :: a
v) -> Context -> Maybe (ArcF Time) -> ArcF Time -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c Maybe (ArcF Time)
w (ArcF Time -> ArcF Time
f ArcF Time
p') a
v) (Event a -> Event a) -> [Event a] -> [Event a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Event a]
es
        -- | Returns the `mirror image' of a 'Arc' around the given point in time
        mirrorArc :: Time -> Arc -> Arc
        mirrorArc :: Time -> ArcF Time -> ArcF Time
mirrorArc mid' :: Time
mid' (Arc s :: Time
s e :: Time
e) = Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc (Time
mid' Time -> Time -> Time
forall a. Num a => a -> a -> a
- (Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
mid')) (Time
mid'Time -> Time -> Time
forall a. Num a => a -> a -> a
+(Time
mid'Time -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s))

{- | Plays a portion of a pattern, specified by a time arc (start and end time).
The new resulting pattern is played over the time period of the original pattern:

@
d1 $ zoom (0.25, 0.75) $ sound "bd*2 hh*3 [sn bd]*2 drum"
@

In the pattern above, `zoom` is used with an arc from 25% to 75%. It is equivalent to this pattern:

@
d1 $ sound "hh*3 [sn bd]*2"
@
-}
zoom :: (Time, Time) -> Pattern a -> Pattern a
zoom :: (Time, Time) -> Pattern a -> Pattern a
zoom (s :: Time
s,e :: Time
e) = ArcF Time -> Pattern a -> Pattern a
forall a. ArcF Time -> Pattern a -> Pattern a
zoomArc (Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc Time
s Time
e)

zoomArc :: Arc -> Pattern a -> Pattern a
zoomArc :: ArcF Time -> Pattern a -> Pattern a
zoomArc (Arc s :: Time
s e :: Time
e) p :: Pattern a
p = 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
$
  (ArcF Time -> ArcF Time) -> Pattern a -> Pattern a
forall a. (ArcF Time -> ArcF Time) -> Pattern a -> Pattern a
withResultArc ((Time -> Time) -> ArcF Time -> ArcF Time
mapCycle ((Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
d) (Time -> Time) -> (Time -> Time) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract Time
s)) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (ArcF Time -> ArcF Time) -> Pattern a -> Pattern a
forall a. (ArcF Time -> ArcF Time) -> Pattern a -> Pattern a
withQueryArc ((Time -> Time) -> ArcF Time -> ArcF Time
mapCycle ((Time -> Time -> Time
forall a. Num a => a -> a -> a
+Time
s) (Time -> Time) -> (Time -> Time) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time -> Time -> Time
forall a. Num a => a -> a -> a
*Time
d))) Pattern a
p
     where d :: Time
d = Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s

-- | @fastGap@ is similar to 'fast' but maintains its cyclic
-- alignment. For example, @fastGap 2 p@ would squash the events in
-- pattern @p@ into the first half of each cycle (and the second
-- halves would be empty). The factor should be at least 1
fastGap :: Pattern Time -> Pattern a -> Pattern a
fastGap :: Pattern Time -> Pattern a -> Pattern a
fastGap = (Time -> Pattern a -> Pattern a)
-> Pattern Time -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fastGap

-- | An alias for @fastGap@
densityGap :: Pattern Time -> Pattern a -> Pattern a
densityGap :: Pattern Time -> Pattern a -> Pattern a
densityGap = Pattern Time -> Pattern a -> Pattern a
forall a. Pattern Time -> Pattern a -> Pattern a
fastGap

compress :: (Time,Time) -> Pattern a -> Pattern a
compress :: (Time, Time) -> Pattern a -> Pattern a
compress (s :: Time
s,e :: Time
e) = ArcF Time -> Pattern a -> Pattern a
forall a. ArcF Time -> Pattern a -> Pattern a
compressArc (Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc Time
s Time
e)

compressTo :: (Time,Time) -> Pattern a -> Pattern a
compressTo :: (Time, Time) -> Pattern a -> Pattern a
compressTo (s :: Time
s,e :: Time
e) = ArcF Time -> Pattern a -> Pattern a
forall a. ArcF Time -> Pattern a -> Pattern a
compressArcTo (Time -> Time -> ArcF Time
forall a. a -> a -> ArcF a
Arc Time
s Time
e)

repeatCycles :: Int -> Pattern a -> Pattern a
repeatCycles :: Int -> Pattern a -> Pattern a
repeatCycles n :: Int
n p :: Pattern a
p = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat (Int -> Pattern a -> [Pattern a]
forall a. Int -> a -> [a]
replicate Int
n Pattern a
p)

fastRepeatCycles :: Int -> Pattern a -> Pattern a
fastRepeatCycles :: Int -> Pattern a -> Pattern a
fastRepeatCycles n :: Int
n p :: Pattern a
p = [Pattern a] -> Pattern a
forall a. [Pattern a] -> Pattern a
cat (Int -> Pattern a -> [Pattern a]
forall a. Int -> a -> [a]
replicate Int
n Pattern a
p)

-- | * Higher order functions

-- | Functions which work on other functions (higher order functions)

-- | @every n f p@ applies the function @f@ to @p@, but only affects
-- every @n@ cycles.
every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every :: Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every tp :: Pattern Int
tp f :: Pattern a -> Pattern a
f p :: Pattern a
p = 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
$ (\t :: Int
t -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every Int
t Pattern a -> Pattern a
f Pattern a
p) (Int -> Pattern a) -> Pattern Int -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Int
tp

_every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every :: Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every 0 _ p :: Pattern a
p = Pattern a
p
_every n :: Int
n f :: Pattern a -> Pattern a
f p :: Pattern a
p = (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n)) Pattern a -> Pattern a
f Pattern a
p

-- | @every n o f'@ is like @every n f@ with an offset of @o@ cycles
every' :: Pattern Int -> Pattern Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
every' :: Pattern Int
-> Pattern Int
-> (Pattern a -> Pattern a)
-> Pattern a
-> Pattern a
every' np :: Pattern Int
np op :: Pattern Int
op f :: Pattern a -> Pattern a
f p :: Pattern a
p = do { Int
n <- Pattern Int
np; Int
o <- Pattern Int
op; Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every' Int
n Int
o Pattern a -> Pattern a
f Pattern a
p }

_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every' :: Int -> Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
_every' n :: Int
n o :: Int
o = (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a.
(Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
o) (Int -> Bool) -> (Int -> Int) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
n))

-- | @foldEvery ns f p@ applies the function @f@ to @p@, and is applied for
-- each cycle in @ns@.
foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
foldEvery :: [Int] -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
foldEvery ns :: [Int]
ns f :: Pattern a -> Pattern a
f p :: Pattern a
p = (Int -> Pattern a -> Pattern a) -> Pattern a -> [Int] -> Pattern a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a. Int -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
`_every` Pattern a -> Pattern a
f) Pattern a
p [Int]
ns

{-|
Only `when` the given test function returns `True` the given pattern
transformation is applied. The test function will be called with the
current cycle as a number.

@
d1 $ when ((elem '4').show)
  (striate 4)
  $ sound "hh hc"
@

The above will only apply `striate 4` to the pattern if the current
cycle number contains the number 4. So the fourth cycle will be
striated and the fourteenth and so on. Expect lots of striates after
cycle number 399.
-}
when :: (Int -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a
when :: (Int -> Bool) -> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
when test :: Int -> Bool
test f :: Pattern a -> Pattern a
f p :: Pattern a
p = 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
$ Pattern a
p {query :: Query a
query = Query a
apply}
  where apply :: Query a
apply st :: State
st | Int -> Bool
test (Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Time -> Int) -> Time -> Int
forall a b. (a -> b) -> a -> b
$ ArcF Time -> Time
forall a. ArcF a -> a
start (ArcF Time -> Time) -> ArcF Time -> Time
forall a b. (a -> b) -> a -> b
$ State -> ArcF Time
arc State
st) = Pattern a -> Query a
forall a. Pattern a -> Query a
query (Pattern a -> Pattern a
f Pattern a
p) State
st
                 | Bool
otherwise = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p State
st

-- | Like 'when', but works on continuous time values rather than cycle numbers.
whenT :: (Time -> Bool) -> (Pattern a -> Pattern a) ->  Pattern a -> Pattern a
whenT :: (Time -> Bool)
-> (Pattern a -> Pattern a) -> Pattern a -> Pattern a
whenT test :: Time -> Bool
test f :: Pattern a -> Pattern a
f p :: Pattern a
p = 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
$ Pattern a
p {query :: Query a
query = Query a
apply}
  where apply :: Query a
apply st :: State
st | Time -> Bool
test (ArcF Time -> Time
forall a. ArcF a -> a
start (ArcF Time -> Time) -> ArcF Time -> Time
forall a b. (a -> b) -> a -> b
$ State -> ArcF Time
arc State
st) = Pattern a -> Query a
forall a. Pattern a -> Query a
query (Pattern a -> Pattern a
f Pattern a
p) State
st
                 | Bool
otherwise = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p State
st