{- | A sequence structure, courtesy <https://github.com/nosuchtim/keykit>.

A /note/ has a time, a duration and a value.
A /phrase/ is a time-ascending sequence of notes and a /length/.
The length of a phrase is independent of the contents.
The sequence operator, /phrase_append/, sums phrase lengths.
The parallel operator, /phrase_merge/, selects the longer length.

Operations are ordinarily on phrases, notes are operated on indirectly.
The phrase indexing operation, /phrase_at/ returns a phrase of degree one.
-}
module Music.Theory.Time.KeyKit where

import Data.List {- base -}

import qualified Data.List.Ordered as O {- data-ordlist -}

import qualified Music.Theory.Time.Seq as Seq {- hmt -}

-- * Time

type Time = Rational
type Duration = Time
type Length = Time

-- * Note

data Note t =
  Note { forall t. Note t -> Time
note_start_time :: Time, forall t. Note t -> Time
note_duration :: Duration, forall t. Note t -> t
note_value :: t }
  deriving (Note t -> Note t -> Bool
forall t. Eq t => Note t -> Note t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note t -> Note t -> Bool
$c/= :: forall t. Eq t => Note t -> Note t -> Bool
== :: Note t -> Note t -> Bool
$c== :: forall t. Eq t => Note t -> Note t -> Bool
Eq, Note t -> Note t -> Bool
Note t -> Note t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t}. Ord t => Eq (Note t)
forall t. Ord t => Note t -> Note t -> Bool
forall t. Ord t => Note t -> Note t -> Ordering
forall t. Ord t => Note t -> Note t -> Note t
min :: Note t -> Note t -> Note t
$cmin :: forall t. Ord t => Note t -> Note t -> Note t
max :: Note t -> Note t -> Note t
$cmax :: forall t. Ord t => Note t -> Note t -> Note t
>= :: Note t -> Note t -> Bool
$c>= :: forall t. Ord t => Note t -> Note t -> Bool
> :: Note t -> Note t -> Bool
$c> :: forall t. Ord t => Note t -> Note t -> Bool
<= :: Note t -> Note t -> Bool
$c<= :: forall t. Ord t => Note t -> Note t -> Bool
< :: Note t -> Note t -> Bool
$c< :: forall t. Ord t => Note t -> Note t -> Bool
compare :: Note t -> Note t -> Ordering
$ccompare :: forall t. Ord t => Note t -> Note t -> Ordering
Ord, Int -> Note t -> ShowS
forall t. Show t => Int -> Note t -> ShowS
forall t. Show t => [Note t] -> ShowS
forall t. Show t => Note t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note t] -> ShowS
$cshowList :: forall t. Show t => [Note t] -> ShowS
show :: Note t -> String
$cshow :: forall t. Show t => Note t -> String
showsPrec :: Int -> Note t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Note t -> ShowS
Show)

note_end_time :: Note t -> Time
note_end_time :: forall t. Note t -> Time
note_end_time Note t
n = forall t. Note t -> Time
note_start_time Note t
n forall a. Num a => a -> a -> a
+ forall t. Note t -> Time
note_duration Note t
n

note_region :: Note t -> (Time, Time)
note_region :: forall t. Note t -> (Time, Time)
note_region Note t
n = (forall t. Note t -> Time
note_start_time Note t
n, forall t. Note t -> Time
note_end_time Note t
n)

note_shift_time :: Time -> Note t -> Note t
note_shift_time :: forall t. Time -> Note t -> Note t
note_shift_time Time
k (Note Time
t Time
d t
e) = forall t. Time -> Time -> t -> Note t
Note (Time
t forall a. Num a => a -> a -> a
+ Time
k) Time
d t
e

note_scale_duration :: Time -> Note t -> Note t
note_scale_duration :: forall t. Time -> Note t -> Note t
note_scale_duration Time
m (Note Time
t Time
d t
e) = forall t. Time -> Time -> t -> Note t
Note Time
t (Time
d forall a. Num a => a -> a -> a
* Time
m) t
e

note_scale_duration_and_time :: Time -> Note t -> Note t
note_scale_duration_and_time :: forall t. Time -> Note t -> Note t
note_scale_duration_and_time Time
m (Note Time
t Time
d t
e) = forall t. Time -> Time -> t -> Note t
Note (Time
t forall a. Num a => a -> a -> a
* Time
m) (Time
d forall a. Num a => a -> a -> a
* Time
m) t
e

note_is_start_in_region :: (Time, Time) -> Note t -> Bool
note_is_start_in_region :: forall t. (Time, Time) -> Note t -> Bool
note_is_start_in_region (Time
t1, Time
t2) (Note Time
t Time
_ t
_) = Time
t forall a. Ord a => a -> a -> Bool
>= Time
t1 Bool -> Bool -> Bool
&& Time
t forall a. Ord a => a -> a -> Bool
< Time
t2

note_is_entirely_in_region :: (Time, Time) -> Note t -> Bool
note_is_entirely_in_region :: forall t. (Time, Time) -> Note t -> Bool
note_is_entirely_in_region (Time
t1, Time
t2) (Note Time
t Time
d t
_) = Time
t forall a. Ord a => a -> a -> Bool
>= Time
t1 Bool -> Bool -> Bool
&& (Time
t forall a. Num a => a -> a -> a
+ Time
d) forall a. Ord a => a -> a -> Bool
< Time
t2

-- * Phrase

-- | It is an un-checked invariant that the note list is in ascending order.
data Phrase t =
  Phrase { forall t. Phrase t -> [Note t]
phrase_notes :: [Note t], forall t. Phrase t -> Time
phrase_length :: Length }
  deriving (Phrase t -> Phrase t -> Bool
forall t. Eq t => Phrase t -> Phrase t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Phrase t -> Phrase t -> Bool
$c/= :: forall t. Eq t => Phrase t -> Phrase t -> Bool
== :: Phrase t -> Phrase t -> Bool
$c== :: forall t. Eq t => Phrase t -> Phrase t -> Bool
Eq, Phrase t -> Phrase t -> Bool
Phrase t -> Phrase t -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {t}. Ord t => Eq (Phrase t)
forall t. Ord t => Phrase t -> Phrase t -> Bool
forall t. Ord t => Phrase t -> Phrase t -> Ordering
forall t. Ord t => Phrase t -> Phrase t -> Phrase t
min :: Phrase t -> Phrase t -> Phrase t
$cmin :: forall t. Ord t => Phrase t -> Phrase t -> Phrase t
max :: Phrase t -> Phrase t -> Phrase t
$cmax :: forall t. Ord t => Phrase t -> Phrase t -> Phrase t
>= :: Phrase t -> Phrase t -> Bool
$c>= :: forall t. Ord t => Phrase t -> Phrase t -> Bool
> :: Phrase t -> Phrase t -> Bool
$c> :: forall t. Ord t => Phrase t -> Phrase t -> Bool
<= :: Phrase t -> Phrase t -> Bool
$c<= :: forall t. Ord t => Phrase t -> Phrase t -> Bool
< :: Phrase t -> Phrase t -> Bool
$c< :: forall t. Ord t => Phrase t -> Phrase t -> Bool
compare :: Phrase t -> Phrase t -> Ordering
$ccompare :: forall t. Ord t => Phrase t -> Phrase t -> Ordering
Ord, Int -> Phrase t -> ShowS
forall t. Show t => Int -> Phrase t -> ShowS
forall t. Show t => [Phrase t] -> ShowS
forall t. Show t => Phrase t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Phrase t] -> ShowS
$cshowList :: forall t. Show t => [Phrase t] -> ShowS
show :: Phrase t -> String
$cshow :: forall t. Show t => Phrase t -> String
showsPrec :: Int -> Phrase t -> ShowS
$cshowsPrec :: forall t. Show t => Int -> Phrase t -> ShowS
Show)

phrase_values :: Phrase t -> [t]
phrase_values :: forall t. Phrase t -> [t]
phrase_values = forall a b. (a -> b) -> [a] -> [b]
map forall t. Note t -> t
note_value forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Phrase t -> [Note t]
phrase_notes

phrase_set_length :: Phrase t -> Length -> Phrase t
phrase_set_length :: forall t. Phrase t -> Time -> Phrase t
phrase_set_length (Phrase [Note t]
n Time
_) Time
l = forall t. [Note t] -> Time -> Phrase t
Phrase [Note t]
n Time
l

phrase_degree :: Phrase t -> Int
phrase_degree :: forall t. Phrase t -> Int
phrase_degree (Phrase [Note t]
n Time
_) = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Note t]
n

phrase_start_time :: Phrase t -> Time
phrase_start_time :: forall t. Phrase t -> Time
phrase_start_time (Phrase [Note t]
n Time
_) =
  case [Note t]
n of
    [] -> Time
0
    Note t
n1 : [Note t]
_ -> forall t. Note t -> Time
note_start_time Note t
n1

phrase_end_time :: Phrase t -> Time
phrase_end_time :: forall t. Phrase t -> Time
phrase_end_time (Phrase [Note t]
n Time
_) =
  case [Note t]
n of
    [] -> Time
0
    [Note t]
_ -> forall t. Note t -> Time
note_start_time (forall a. [a] -> a
last [Note t]
n)

phrase_duration :: Phrase t -> Duration
phrase_duration :: forall t. Phrase t -> Time
phrase_duration Phrase t
p = forall t. Phrase t -> Time
phrase_end_time Phrase t
p forall a. Num a => a -> a -> a
- forall t. Phrase t -> Time
phrase_start_time Phrase t
p

phrase_maximum :: Ord t => Phrase t -> Note t
phrase_maximum :: forall t. Ord t => Phrase t -> Note t
phrase_maximum (Phrase [Note t]
n Time
_) = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Note t]
n

phrase_minimum :: Ord t => Phrase t -> Note t
phrase_minimum :: forall t. Ord t => Phrase t -> Note t
phrase_minimum (Phrase [Note t]
n Time
_) = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Note t]
n

-- | Keykit sets the length to the duration, i.e. ('c,e,g'%2).length is 192.
phrase_at :: Phrase t -> Int -> Phrase t
phrase_at :: forall t. Phrase t -> Int -> Phrase t
phrase_at (Phrase [Note t]
n Time
_) Int
k =
  let nt :: Note t
nt = [Note t]
n forall a. [a] -> Int -> a
!! (Int
k forall a. Num a => a -> a -> a
- Int
1)
  in forall t. [Note t] -> Time -> Phrase t
Phrase [Note t
nt] (forall t. Note t -> Time
note_start_time Note t
nt forall a. Num a => a -> a -> a
+ forall t. Note t -> Time
note_duration Note t
nt)

phrase_time_at :: Phrase t -> Int -> Time
phrase_time_at :: forall t. Phrase t -> Int -> Time
phrase_time_at (Phrase [Note t]
n Time
_) Int
k = forall t. Note t -> Time
note_start_time ([Note t]
n forall a. [a] -> Int -> a
!! (Int
k forall a. Num a => a -> a -> a
- Int
1))

phrase_clear_at :: Phrase t -> Int -> Phrase t
phrase_clear_at :: forall t. Phrase t -> Int -> Phrase t
phrase_clear_at (Phrase [Note t]
n Time
l) Int
k =
  let remove_ix :: Int -> [a] -> [a]
remove_ix Int
ix [a]
list = let ([a]
p,[a]
q) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
ix [a]
list in [a]
p forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail [a]
q
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall {a}. Int -> [a] -> [a]
remove_ix (Int
k forall a. Num a => a -> a -> a
- Int
1) [Note t]
n) Time
l

phrase_at_put :: Ord t => Phrase t -> Int -> Phrase t -> Phrase t
phrase_at_put :: forall t. Ord t => Phrase t -> Int -> Phrase t -> Phrase t
phrase_at_put (Phrase [Note t]
n1 Time
l1) Int
k (Phrase [Note t]
n2 Time
_) =
  let nt :: Note t
nt = [Note t]
n1 forall a. [a] -> Int -> a
!! (Int
k forall a. Num a => a -> a -> a
- Int
1)
      remove_ix :: Int -> [a] -> [a]
remove_ix Int
ix [a]
list = let ([a]
p,[a]
q) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
ix [a]
list in [a]
p forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail [a]
q
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. Ord a => [a] -> [a] -> [a]
O.merge (forall {a}. Int -> [a] -> [a]
remove_ix (Int
k forall a. Num a => a -> a -> a
- Int
1) [Note t]
n1) (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Time -> Note t -> Note t
note_shift_time (forall t. Note t -> Time
note_start_time Note t
nt)) [Note t]
n2)) Time
l1

phrase_is_empty :: Phrase t -> Bool
phrase_is_empty :: forall t. Phrase t -> Bool
phrase_is_empty (Phrase [Note t]
n Time
_) = forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Note t]
n

-- | KeyKits p+q
phrase_append :: Ord t => Phrase t -> Phrase t -> Phrase t
phrase_append :: forall t. Ord t => Phrase t -> Phrase t -> Phrase t
phrase_append (Phrase [Note t]
n1 Time
l1) (Phrase [Note t]
n2 Time
l2) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. Ord a => [a] -> [a] -> [a]
O.merge [Note t]
n1 (forall a b. (a -> b) -> [a] -> [b]
map (forall t. Time -> Note t -> Note t
note_shift_time Time
l1) [Note t]
n2)) (Time
l1 forall a. Num a => a -> a -> a
+ Time
l2)

phrase_append_list :: Ord t => [Phrase t] -> Phrase t
phrase_append_list :: forall t. Ord t => [Phrase t] -> Phrase t
phrase_append_list = forall a. (a -> a -> a) -> [a] -> a
foldl1' forall t. Ord t => Phrase t -> Phrase t -> Phrase t
phrase_append

-- | KeyKits p|q
phrase_merge :: Ord t => Phrase t -> Phrase t -> Phrase t
phrase_merge :: forall t. Ord t => Phrase t -> Phrase t -> Phrase t
phrase_merge (Phrase [Note t]
n1 Time
l1) (Phrase [Note t]
n2 Time
l2) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. Ord a => [a] -> [a] -> [a]
O.merge [Note t]
n1 [Note t]
n2) (forall a. Ord a => a -> a -> a
max Time
l1 Time
l2)

phrase_merge_list :: Ord t => [Phrase t] -> Phrase t
phrase_merge_list :: forall t. Ord t => [Phrase t] -> Phrase t
phrase_merge_list [Phrase t]
p =
  let l :: Time
l = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall t. Phrase t -> Time
phrase_length [Phrase t]
p)
      n :: [Note t]
n = forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall t. Phrase t -> [Note t]
phrase_notes [Phrase t]
p)
  in forall t. [Note t] -> Time -> Phrase t
Phrase [Note t]
n Time
l

phrase_select :: Phrase t -> (Note t -> Bool) -> Phrase t
phrase_select :: forall t. Phrase t -> (Note t -> Bool) -> Phrase t
phrase_select (Phrase [Note t]
n Time
l) Note t -> Bool
f = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. (a -> Bool) -> [a] -> [a]
filter Note t -> Bool
f [Note t]
n) Time
l

phrase_partition :: Phrase t -> (Note t -> Bool) -> (Phrase t, Phrase t)
phrase_partition :: forall t. Phrase t -> (Note t -> Bool) -> (Phrase t, Phrase t)
phrase_partition (Phrase [Note t]
n Time
l) Note t -> Bool
f =
  let ([Note t]
n1, [Note t]
n2) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Note t -> Bool
f [Note t]
n
  in (forall t. [Note t] -> Time -> Phrase t
Phrase [Note t]
n1 Time
l, forall t. [Note t] -> Time -> Phrase t
Phrase [Note t]
n2 Time
l)

phrase_select_region :: Phrase t -> (Time, Time) -> Phrase t
phrase_select_region :: forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_select_region Phrase t
p (Time, Time)
r = forall t. Phrase t -> (Note t -> Bool) -> Phrase t
phrase_select Phrase t
p (forall t. (Time, Time) -> Note t -> Bool
note_is_start_in_region (Time, Time)
r)

phrase_clear_region :: Phrase t -> (Time, Time) -> Phrase t
phrase_clear_region :: forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_clear_region Phrase t
p (Time, Time)
r = forall t. Phrase t -> (Note t -> Bool) -> Phrase t
phrase_select Phrase t
p (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. (Time, Time) -> Note t -> Bool
note_is_start_in_region (Time, Time)
r)

phrase_select_indices :: Phrase t -> (Int, Int) -> Phrase t
phrase_select_indices :: forall t. Phrase t -> (Int, Int) -> Phrase t
phrase_select_indices (Phrase [Note t]
n Time
l) (Int
i, Int
j) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall {a}. Int -> [a] -> [a]
take (Int
j forall a. Num a => a -> a -> a
- Int
i forall a. Num a => a -> a -> a
+ Int
1) (forall {a}. Int -> [a] -> [a]
drop (Int
i forall a. Num a => a -> a -> a
- Int
1) [Note t]
n)) Time
l

phrase_clear_indices :: Phrase t -> (Int, Int) -> Phrase t
phrase_clear_indices :: forall t. Phrase t -> (Int, Int) -> Phrase t
phrase_clear_indices (Phrase [Note t]
n Time
l) (Int
i, Int
j) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall {a}. Int -> [a] -> [a]
take (Int
i forall a. Num a => a -> a -> a
- Int
1) [Note t]
n forall a. [a] -> [a] -> [a]
++ forall {a}. Int -> [a] -> [a]
drop Int
j [Note t]
n) Time
l

phrase_extract_region :: Phrase t -> (Time, Time) -> Phrase t
phrase_extract_region :: forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_extract_region Phrase t
p (Time
t1, Time
t2) =
  let p' :: Phrase t
p' = forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_select_region Phrase t
p (Time
t1, Time
t2)
  in forall t. Phrase t -> Time -> Phrase t
phrase_set_length (forall t. Phrase t -> Time -> Phrase t
phrase_shift Phrase t
p' (Time
0 forall a. Num a => a -> a -> a
- Time
t1)) (Time
t2 forall a. Num a => a -> a -> a
- Time
t1)

phrase_delete_region :: Ord t => Phrase t -> (Time, Time) -> Phrase t
phrase_delete_region :: forall t. Ord t => Phrase t -> (Time, Time) -> Phrase t
phrase_delete_region Phrase t
p (Time
t1, Time
t2) =
  forall t. Ord t => Phrase t -> Phrase t -> Phrase t
phrase_append
  (forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_extract_region Phrase t
p (Time
0, Time
t1))
  (forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_extract_region Phrase t
p (Time
t2, forall t. Phrase t -> Time
phrase_length Phrase t
p))

phrase_separate :: Phrase t -> Time -> (Phrase t, Phrase t)
phrase_separate :: forall t. Phrase t -> Time -> (Phrase t, Phrase t)
phrase_separate Phrase t
p Time
t =
  let (Phrase t
p1, Phrase t
p2) = forall t. Phrase t -> (Note t -> Bool) -> (Phrase t, Phrase t)
phrase_partition Phrase t
p (forall t. (Time, Time) -> Note t -> Bool
note_is_start_in_region (Time
0, Time
t))
      p1' :: Phrase t
p1' = forall t. Phrase t -> Time -> Phrase t
phrase_set_length Phrase t
p1 Time
t
      p2' :: Phrase t
p2' = forall t. Phrase t -> Time -> Phrase t
phrase_set_length (forall t. Phrase t -> Time -> Phrase t
phrase_shift Phrase t
p2 (Time
0 forall a. Num a => a -> a -> a
- Time
t)) (forall t. Phrase t -> Time
phrase_length Phrase t
p forall a. Num a => a -> a -> a
- Time
t)
  in (Phrase t
p1', Phrase t
p2')

phrase_reverse :: Phrase t -> Phrase t
phrase_reverse :: forall t. Phrase t -> Phrase t
phrase_reverse (Phrase [Note t]
n Time
l) =
  let f :: Note t -> Note t
f (Note Time
t Time
d t
e) = forall t. Time -> Time -> t -> Note t
Note (Time
l forall a. Num a => a -> a -> a
- Time
t forall a. Num a => a -> a -> a
- Time
d) Time
d t
e
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. [a] -> [a]
reverse (forall a b. (a -> b) -> [a] -> [b]
map forall {t}. Note t -> Note t
f [Note t]
n)) Time
l

phrase_reorder :: Phrase t -> [Int] -> Phrase t
phrase_reorder :: forall t. Phrase t -> [Int] -> Phrase t
phrase_reorder (Phrase [Note t]
n Time
l) [Int]
p =
  let f :: Note t -> Int -> Note t
f (Note Time
t Time
d t
_) Int
i = forall t. Time -> Time -> t -> Note t
Note Time
t Time
d (forall t. Note t -> t
note_value ([Note t]
n forall a. [a] -> Int -> a
!! (Int
i forall a. Num a => a -> a -> a
- Int
1)))
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {t}. Note t -> Int -> Note t
f [Note t]
n [Int]
p) Time
l

phrase_truncate :: Phrase t -> Phrase t
phrase_truncate :: forall t. Phrase t -> Phrase t
phrase_truncate Phrase t
p = forall t. Phrase t -> Time -> Phrase t
phrase_set_length Phrase t
p (forall t. Phrase t -> Time
phrase_end_time Phrase t
p)

phrase_trim :: Phrase t -> Phrase t
phrase_trim :: forall t. Phrase t -> Phrase t
phrase_trim Phrase t
p =
  let t :: Time
t = forall t. Phrase t -> Time
phrase_start_time Phrase t
p
  in forall t. Phrase t -> Phrase t
phrase_truncate (forall t. Phrase t -> Time -> Phrase t
phrase_shift Phrase t
p (Time
0 forall a. Num a => a -> a -> a
- Time
t))

-- * Functor

note_map :: (t -> u) -> Note t -> Note u
note_map :: forall t u. (t -> u) -> Note t -> Note u
note_map t -> u
f (Note Time
t Time
d t
e) = forall t. Time -> Time -> t -> Note t
Note Time
t Time
d (t -> u
f t
e)

phrase_value_map :: (t -> u) -> Phrase t -> Phrase u
phrase_value_map :: forall t u. (t -> u) -> Phrase t -> Phrase u
phrase_value_map t -> u
f (Phrase [Note t]
n Time
l) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a b. (a -> b) -> [a] -> [b]
map (forall t u. (t -> u) -> Note t -> Note u
note_map t -> u
f) [Note t]
n) Time
l

phrase_note_map :: (Note t -> Note u) -> Phrase t -> Phrase u
phrase_note_map :: forall t u. (Note t -> Note u) -> Phrase t -> Phrase u
phrase_note_map Note t -> Note u
f (Phrase [Note t]
n Time
l) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a b. (a -> b) -> [a] -> [b]
map Note t -> Note u
f [Note t]
n) Time
l

phrase_phrase_map :: Ord u => (Phrase t -> Phrase u) -> Phrase t -> Phrase u
phrase_phrase_map :: forall u t. Ord u => (Phrase t -> Phrase u) -> Phrase t -> Phrase u
phrase_phrase_map Phrase t -> Phrase u
f (Phrase [Note t]
n Time
l) =
  let g :: Note t -> Phrase u
g (Note Time
t Time
d t
e) = Phrase t -> Phrase u
f (forall t. [Note t] -> Time -> Phrase t
Phrase [forall t. Time -> Time -> t -> Note t
Note Time
t Time
d t
e] (Time
t forall a. Num a => a -> a -> a
+ Time
d))
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall t. Phrase t -> [Note t]
phrase_notes (forall a b. (a -> b) -> [a] -> [b]
map Note t -> Phrase u
g [Note t]
n))) Time
l

phrase_map :: Ord u => (Note t -> Phrase u) -> Phrase t -> Phrase u
phrase_map :: forall u t. Ord u => (Note t -> Phrase u) -> Phrase t -> Phrase u
phrase_map Note t -> Phrase u
f (Phrase [Note t]
n Time
l) = forall t. [Note t] -> Time -> Phrase t
Phrase (forall a. Ord a => [a] -> [a]
sort (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall t. Phrase t -> [Note t]
phrase_notes (forall a b. (a -> b) -> [a] -> [b]
map Note t -> Phrase u
f [Note t]
n))) Time
l

phrase_shift :: Phrase t -> Time -> Phrase t
phrase_shift :: forall t. Phrase t -> Time -> Phrase t
phrase_shift Phrase t
p Time
t = forall t u. (Note t -> Note u) -> Phrase t -> Phrase u
phrase_note_map (forall t. Time -> Note t -> Note t
note_shift_time Time
t) Phrase t
p

phrase_scale_duration :: Phrase t -> Time -> Phrase t
phrase_scale_duration :: forall t. Phrase t -> Time -> Phrase t
phrase_scale_duration Phrase t
p Time
m = forall t u. (Note t -> Note u) -> Phrase t -> Phrase u
phrase_note_map (forall t. Time -> Note t -> Note t
note_scale_duration Time
m) Phrase t
p

phrase_scale_duration_and_time :: Phrase t -> Time -> Phrase t
phrase_scale_duration_and_time :: forall t. Phrase t -> Time -> Phrase t
phrase_scale_duration_and_time Phrase t
p Time
m = forall t u. (Note t -> Note u) -> Phrase t -> Phrase u
phrase_note_map (forall t. Time -> Note t -> Note t
note_scale_duration_and_time Time
m) Phrase t
p

phrase_scale_to_duration :: Phrase t -> Duration -> Phrase t
phrase_scale_to_duration :: forall t. Phrase t -> Time -> Phrase t
phrase_scale_to_duration Phrase t
p Time
d = forall t. Phrase t -> Time -> Phrase t
phrase_scale_duration_and_time Phrase t
p (Time
d forall a. Fractional a => a -> a -> a
/ forall t. Phrase t -> Time
phrase_length Phrase t
p)

phrase_scale_to_region :: Phrase t -> (Time, Duration) -> Phrase t
phrase_scale_to_region :: forall t. Phrase t -> (Time, Time) -> Phrase t
phrase_scale_to_region Phrase t
p (Time
t1, Time
t2) = forall t. Phrase t -> Time -> Phrase t
phrase_shift (forall t. Phrase t -> Time -> Phrase t
phrase_scale_to_duration Phrase t
p (Time
t2 forall a. Num a => a -> a -> a
- Time
t1)) Time
t1

-- * Seq

phrase_to_wseq :: Phrase t -> Seq.Wseq Time t
phrase_to_wseq :: forall t. Phrase t -> Wseq Time t
phrase_to_wseq (Phrase [Note t]
n Time
_) =
  let f :: Note b -> ((Time, Time), b)
f (Note Time
tm Time
dur b
e) = ((Time
tm, Time
dur), b
e)
  in forall a b. (a -> b) -> [a] -> [b]
map forall {b}. Note b -> ((Time, Time), b)
f [Note t]
n

useq_to_phrase :: Seq.Useq Time t -> Phrase t
useq_to_phrase :: forall t. Useq Time t -> Phrase t
useq_to_phrase = forall t. Dseq Time t -> Phrase t
dseq_to_phrase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Useq t a -> Dseq t a
Seq.useq_to_dseq

dseq_to_phrase :: Seq.Dseq Time t -> Phrase t
dseq_to_phrase :: forall t. Dseq Time t -> Phrase t
dseq_to_phrase = forall t. Wseq Time t -> Phrase t
wseq_to_phrase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t a. Num t => t -> Dseq t a -> Wseq t a
Seq.dseq_to_wseq Time
0

wseq_to_phrase :: Seq.Wseq Time t -> Phrase t
wseq_to_phrase :: forall t. Wseq Time t -> Phrase t
wseq_to_phrase Wseq Time t
sq =
  let f :: ((Time, Time), t) -> Note t
f ((Time
t, Time
d), t
e) = forall t. Time -> Time -> t -> Note t
Note Time
t Time
d t
e
  in forall t. [Note t] -> Time -> Phrase t
Phrase (forall a b. (a -> b) -> [a] -> [b]
map forall {t}. ((Time, Time), t) -> Note t
f Wseq Time t
sq) (forall t a. Num t => Wseq t a -> t
Seq.wseq_dur Wseq Time t
sq)