FromMidi2: an alternative Midi-to-Music conversion algorithm.
Author: Donya Quick
Last modified: 28-Dec-2016

The goal of this module is to provide a more intelligent
parse from MIDI files to Music structures. The fromMidi
function will convert Midi into Music, but the resulting
structure is one big parallel composition with no other 
relationships between the notes. The fromMidi2 function
here is an attempt to provide a parse of musical features
that is more in line with how a human might write them
in Euterpea or perceive them by ear. It works best on 
MIDI files that are very close to paper score in terms 
of how the events are structured. The functions here are
not intended for use with "messy" MIDI files that have 
been recorded from a live performance without quantization.

You can use fromMidi2 as an alternative to fromMidi to 
parse a Midi value into a Music value with a better 
method of grouping events together. The same algorithm 
can be applied directly to a Music value with the 
restructure function. 

Examples of how to use fromMidi2 and restructure:

testMidi file = do
    x <- importFile file
    case x of Left err -> error err
              Right m -> do
                  let v = fromMidi2 m
                  putStrLn $ show v
                  play v
                  
myMusic :: Music (Pitch, Volume)                  
myMusic = ...
newMusic :: Music (Pitch, Volume)
newMusic = restructure myMusic

Restructuring is done from the MEvent level. Importantly, 
this means that there are no tempo changes or other Modify 
nodes in the resulting Music value! A global tempo of 
120BPM is assumed. If your MIDI file has a different BPM,
you can use fromMidi in combination with restructure and
then apply a tempo modifier afterwards.

The method for organizing events is:
(1) Identify and group chords where every note 
    has the same start time and duration.
(2) Identify and group sequential patterns where items
    are back-to-back. Note that this may include a mix of
    single notes and chords from step 1.
(3) Greedily group any patterns with gaps between 
    them into a sequence with rests.


> module Euterpea.IO.MIDI.FromMidi2 (fromMidi2, restructure, Chunk, chunkEvents, chunkToMusic)where
> import Euterpea.Music hiding (E)
> import Euterpea.IO.MIDI.ToMidi
> import Euterpea.IO.MIDI.GeneralMidi
> import Euterpea.IO.MIDI.MEvent
> import Euterpea.IO.MIDI.FromMidi
> import Data.List
> import Codec.Midi

The primary exported functions for this module are:

> fromMidi2 :: Midi -> Music (Pitch, Volume)
> fromMidi2 :: Midi -> Music (Pitch, Volume)
fromMidi2 = Music Note1 -> Music (Pitch, Volume)
forall a. ToMusic1 a => Music a -> Music (Pitch, Volume)
restructure (Music Note1 -> Music (Pitch, Volume))
-> (Midi -> Music Note1) -> Midi -> Music (Pitch, Volume)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi -> Music Note1
fromMidi

> restructure :: (ToMusic1 a) => Music a -> Music (Pitch, Volume)
> restructure :: Music a -> Music (Pitch, Volume)
restructure = Music a -> Music (Pitch, Volume)
forall a. ToMusic1 a => Music a -> Music (Pitch, Volume)
parseFeaturesI

Other exported features are related to the Chunk datatype.

A Chunk is the data structure used to group events by the algorithm 
described at the top of this file. Par and Chord correspond to features
that will be composed in parallel (:=:) at different levels, and Seq 
corresponds to features that will be composed in sequence (:+:). E is 
a wrapper for single events and R is a rest place-holder.

> type Onset = Dur -- to clarify some type signatures


> data Chunk = Par [Chunk] | Seq [Chunk] | Chord [Chunk] | E MEvent | R Onset Dur
>     deriving Chunk -> Chunk -> Bool
(Chunk -> Chunk -> Bool) -> (Chunk -> Chunk -> Bool) -> Eq Chunk
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c== :: Chunk -> Chunk -> Bool
Eq

Initially, each MEvent is placed in its own chunk.

> initChunk :: [MEvent] -> [Chunk]
> initChunk :: [MEvent] -> [Chunk]
initChunk [MEvent]
mevs = 
>     let mevs' :: [MEvent]
mevs' = (MEvent -> MEvent -> Ordering) -> [MEvent] -> [MEvent]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy MEvent -> MEvent -> Ordering
sortFun [MEvent]
mevs
>     in  (MEvent -> Chunk) -> [MEvent] -> [Chunk]
forall a b. (a -> b) -> [a] -> [b]
map MEvent -> Chunk
E [MEvent]
mevs'

The chunkChord function looks for chunks that share the same
onset and duration and places them together in Chord chunks.

> chunkChord :: [Chunk] -> [Chunk]
> chunkChord :: [Chunk] -> [Chunk]
chunkChord [] = []
> chunkChord (Chunk
c:[Chunk]
cs) = 
>     let cChord :: [Chunk]
cChord = (Chunk -> Bool) -> [Chunk] -> [Chunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (Chunk -> Chunk -> Bool
chordWith Chunk
c) [Chunk]
cs
>         notInChord :: [Chunk]
notInChord = (Chunk -> Bool) -> [Chunk] -> [Chunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Chunk
v -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Chunk -> [Chunk] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Chunk
v [Chunk]
cChord) [Chunk]
cs
>     in  if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
cChord then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkChord [Chunk]
cs
>         else [Chunk] -> Chunk
Chord (Chunk
cChunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:[Chunk]
cChord) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkChord [Chunk]
notInChord

> chordWith :: Chunk -> Chunk -> Bool
> chordWith :: Chunk -> Chunk -> Bool
chordWith Chunk
c0 Chunk
c = Chunk -> Onset
chunkOnset Chunk
c Onset -> Onset -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk -> Onset
chunkOnset Chunk
c0 Bool -> Bool -> Bool
&& Chunk -> Onset
chunkDur Chunk
c Onset -> Onset -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk -> Onset
chunkDur Chunk
c0

The chunkMel function looks for sequences of chunks (which need
not be adjacent in the input list) where the end time of one chunk
is equal to the start time of the next chunk. There are no gaps 
permitted, so notes separated by rests will not be grouped here.

> chunkMel :: [Chunk] -> [Chunk]
> chunkMel :: [Chunk] -> [Chunk]
chunkMel [] = []
> chunkMel x :: [Chunk]
x@(Chunk
c:[Chunk]
cs) = 
>     let cMel :: [Chunk]
cMel = Onset -> [Chunk] -> [Chunk]
buildMelFrom (Chunk -> Onset
chunkOnset Chunk
c) [Chunk]
x -- get ALL possible melody elements

>         notInMel :: [Chunk]
notInMel = (Chunk -> Bool) -> [Chunk] -> [Chunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Chunk
v -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Chunk -> [Chunk] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Chunk
v [Chunk]
cMel) [Chunk]
x
>     in  if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
cMel then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkMel [Chunk]
cs
>         else [Chunk] -> Chunk
Seq [Chunk]
cMel Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkMel [Chunk]
notInMel

> buildMelFrom :: Onset -> [Chunk] -> [Chunk]
> buildMelFrom :: Onset -> [Chunk] -> [Chunk]
buildMelFrom Onset
t [] = []
> buildMelFrom Onset
t (Chunk
c:[Chunk]
cs) = 
>     if Chunk -> Onset
chunkOnset Chunk
c Onset -> Onset -> Bool
forall a. Eq a => a -> a -> Bool
== Onset
t then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Onset -> [Chunk] -> [Chunk]
buildMelFrom (Onset
t Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
+ Chunk -> Onset
chunkDur Chunk
c) [Chunk]
cs
>     else Onset -> [Chunk] -> [Chunk]
buildMelFrom Onset
t [Chunk]
cs

The chunkSeqs function is more general and will look for anything 
that can be grouped together linearly in time, even if it requires
inserting a rest. This will group together all non-overlapping 
chunks in a greedy fashion.

> chunkSeqs :: [Chunk] -> [Chunk]
> chunkSeqs :: [Chunk] -> [Chunk]
chunkSeqs [] = []
> chunkSeqs x :: [Chunk]
x@(Chunk
c:[Chunk]
cs) = 
>     let s :: [Chunk]
s = Onset -> [Chunk] -> [Chunk]
seqWithRests (Chunk -> Onset
chunkOnset Chunk
c) [Chunk]
x
>         notInS :: [Chunk]
notInS = (Chunk -> Bool) -> [Chunk] -> [Chunk]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Chunk
v -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Chunk -> [Chunk] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Chunk
v [Chunk]
s) [Chunk]
x
>     in  if [Chunk]
s [Chunk] -> [Chunk] -> Bool
forall a. Eq a => a -> a -> Bool
== [Chunk
c] then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkSeqs [Chunk]
cs 
>         else [Chunk] -> Chunk
Seq [Chunk]
s Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: [Chunk] -> [Chunk]
chunkSeqs [Chunk]
notInS

> seqWithRests :: Onset -> [Chunk] -> [Chunk]
> seqWithRests :: Onset -> [Chunk] -> [Chunk]
seqWithRests Onset
t [] = []
> seqWithRests Onset
t x :: [Chunk]
x@(Chunk
c:[Chunk]
cs) = 
>     let tc :: Onset
tc = Chunk -> Onset
chunkOnset Chunk
c
>         dt :: Onset
dt = Onset
tc Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
- Onset
t
>     in  if Onset
dt Onset -> Onset -> Bool
forall a. Eq a => a -> a -> Bool
== Onset
0 then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Onset -> [Chunk] -> [Chunk]
seqWithRests (Onset
tc Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
+ Chunk -> Onset
chunkDur Chunk
c) [Chunk]
cs
>         else if Onset
dt Onset -> Onset -> Bool
forall a. Ord a => a -> a -> Bool
> Onset
0 then Onset -> Onset -> Chunk
R Onset
t Onset
dt Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Onset -> [Chunk] -> [Chunk]
seqWithRests (Onset
tc Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
+ Chunk -> Onset
chunkDur Chunk
c) [Chunk]
cs
>         else Onset -> [Chunk] -> [Chunk]
seqWithRests Onset
t [Chunk]
cs

Finally, chunkEvents combines all of these methods in a particular
order that establishes preference for chords first, then melodies
(which may include chords), and then sequences including rests. 
Anything left over will be handled by an outer Par.

> chunkEvents :: [MEvent] -> Chunk
> chunkEvents :: [MEvent] -> Chunk
chunkEvents = [Chunk] -> Chunk
Par ([Chunk] -> Chunk) -> ([MEvent] -> [Chunk]) -> [MEvent] -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [Chunk]
chunkSeqs ([Chunk] -> [Chunk])
-> ([MEvent] -> [Chunk]) -> [MEvent] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [Chunk]
chunkMel ([Chunk] -> [Chunk])
-> ([MEvent] -> [Chunk]) -> [MEvent] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Chunk] -> [Chunk]
chunkChord([Chunk] -> [Chunk])
-> ([MEvent] -> [Chunk]) -> [MEvent] -> [Chunk]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MEvent] -> [Chunk]
initChunk

Chunks can be converted directly to Music. Durations have to be 
divided in half because MEvents deal with seconds, while Music 
deals with duration as whole notes (1 whole note = 2 seconds).

> chunkToMusic :: Chunk -> Music (Pitch, Volume)
> chunkToMusic :: Chunk -> Music (Pitch, Volume)
chunkToMusic (E MEvent
e) = Onset -> (Pitch, Volume) -> Music (Pitch, Volume)
forall a. Onset -> a -> Music a
note (MEvent -> Onset
eDur MEvent
e Onset -> Onset -> Onset
forall a. Fractional a => a -> a -> a
/ Onset
2) (Volume -> Pitch
pitch (Volume -> Pitch) -> Volume -> Pitch
forall a b. (a -> b) -> a -> b
$ MEvent -> Volume
ePitch MEvent
e, MEvent -> Volume
eVol MEvent
e)
> chunkToMusic (R Onset
o Onset
d) = Onset -> Music (Pitch, Volume)
forall a. Onset -> Music a
rest (Onset
dOnset -> Onset -> Onset
forall a. Fractional a => a -> a -> a
/Onset
2)
> chunkToMusic (Seq [Chunk]
x) = [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a. [Music a] -> Music a
line((Chunk -> Music (Pitch, Volume))
-> [Chunk] -> [Music (Pitch, Volume)]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Music (Pitch, Volume)
chunkToMusic [Chunk]
x)
> chunkToMusic (Chord [Chunk]
x) = [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a. [Music a] -> Music a
chord((Chunk -> Music (Pitch, Volume))
-> [Chunk] -> [Music (Pitch, Volume)]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Music (Pitch, Volume)
chunkToMusic [Chunk]
x)
> chunkToMusic (Par [Chunk]
x) = [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a. [Music a] -> Music a
chord ([Music (Pitch, Volume)] -> Music (Pitch, Volume))
-> [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a b. (a -> b) -> a -> b
$ (Chunk -> Music (Pitch, Volume))
-> [Chunk] -> [Music (Pitch, Volume)]
forall a b. (a -> b) -> [a] -> [b]
map (\Chunk
v -> Onset -> Music (Pitch, Volume)
forall a. Onset -> Music a
rest (Chunk -> Onset
chunkOnset Chunk
v Onset -> Onset -> Onset
forall a. Fractional a => a -> a -> a
/ Onset
2) Music (Pitch, Volume)
-> Music (Pitch, Volume) -> Music (Pitch, Volume)
forall a. Music a -> Music a -> Music a
:+: Chunk -> Music (Pitch, Volume)
chunkToMusic Chunk
v) [Chunk]
x

The parseFeatures function will take an existing Music value, such
as one returned by fromMidi, and use the algorithms above to identify
musical features (chords and melodies) and construct a new Music 
tree that is performance-equivalent to the original.

> parseFeatures :: (ToMusic1 a) => Music a -> Music (Pitch, Volume)
> parseFeatures :: Music a -> Music (Pitch, Volume)
parseFeatures = Music (Pitch, Volume) -> Music (Pitch, Volume)
forall a. Music a -> Music a
removeZeros (Music (Pitch, Volume) -> Music (Pitch, Volume))
-> (Music a -> Music (Pitch, Volume))
-> Music a
-> Music (Pitch, Volume)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Music (Pitch, Volume)
chunkToMusic (Chunk -> Music (Pitch, Volume))
-> (Music a -> Chunk) -> Music a -> Music (Pitch, Volume)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MEvent] -> Chunk
chunkEvents ([MEvent] -> Chunk) -> (Music a -> [MEvent]) -> Music a -> Chunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Music a -> [MEvent]
forall a. ToMusic1 a => Music a -> [MEvent]
perform

> parseFeaturesI :: (ToMusic1 a) => Music a -> Music (Pitch, Volume)
> parseFeaturesI :: Music a -> Music (Pitch, Volume)
parseFeaturesI Music a
m = 
>     let mevs :: [MEvent]
mevs = Music a -> [MEvent]
forall a. ToMusic1 a => Music a -> [MEvent]
perform Music a
m
>         ([InstrumentName]
iList, [[MEvent]]
mevsI) = [(InstrumentName, [MEvent])] -> ([InstrumentName], [[MEvent]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(InstrumentName, [MEvent])] -> ([InstrumentName], [[MEvent]]))
-> [(InstrumentName, [MEvent])] -> ([InstrumentName], [[MEvent]])
forall a b. (a -> b) -> a -> b
$ [MEvent] -> [(InstrumentName, [MEvent])]
splitByInst [MEvent]
mevs
>         parsesI :: [Music (Pitch, Volume)]
parsesI = ([MEvent] -> Music (Pitch, Volume))
-> [[MEvent]] -> [Music (Pitch, Volume)]
forall a b. (a -> b) -> [a] -> [b]
map (Music (Pitch, Volume) -> Music (Pitch, Volume)
forall a. Music a -> Music a
removeZeros (Music (Pitch, Volume) -> Music (Pitch, Volume))
-> ([MEvent] -> Music (Pitch, Volume))
-> [MEvent]
-> Music (Pitch, Volume)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Music (Pitch, Volume)
chunkToMusic (Chunk -> Music (Pitch, Volume))
-> ([MEvent] -> Chunk) -> [MEvent] -> Music (Pitch, Volume)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MEvent] -> Chunk
chunkEvents) [[MEvent]]
mevsI
>     in  [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a. [Music a] -> Music a
chord ([Music (Pitch, Volume)] -> Music (Pitch, Volume))
-> [Music (Pitch, Volume)] -> Music (Pitch, Volume)
forall a b. (a -> b) -> a -> b
$ (InstrumentName -> Music (Pitch, Volume) -> Music (Pitch, Volume))
-> [InstrumentName]
-> [Music (Pitch, Volume)]
-> [Music (Pitch, Volume)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith InstrumentName -> Music (Pitch, Volume) -> Music (Pitch, Volume)
forall a. InstrumentName -> Music a -> Music a
instrument [InstrumentName]
iList [Music (Pitch, Volume)]
parsesI

================

Utility Functions and Type Class Instances

First, some functions to pretty-up printing of things for debugging purposes

> doubleShow :: Rational -> String
> doubleShow :: Onset -> String
doubleShow Onset
x = Double -> String
forall a. Show a => a -> String
show (Onset -> Double
forall a. Fractional a => Onset -> a
fromRational Onset
x :: Double)

> pcShow :: AbsPitch -> String
> pcShow :: Volume -> String
pcShow = PitchClass -> String
forall a. Show a => a -> String
show (PitchClass -> String)
-> (Volume -> PitchClass) -> Volume -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> PitchClass
forall a b. (a, b) -> a
fst (Pitch -> PitchClass) -> (Volume -> Pitch) -> Volume -> PitchClass
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Volume -> Pitch
pitch

> listShow, listShowN :: (Show a) => [a] -> String
> listShow :: [a] -> String
listShow [a]
x = String
"["String -> String -> String
forall a. [a] -> [a] -> [a]
++([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
", " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
x)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]"
> listShowN :: [a] -> String
listShowN [a]
x = String
"[\n    "String -> String -> String
forall a. [a] -> [a] -> [a]
++([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
",\n    " ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
x)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n]"

> listShowX :: (Show a) => Int -> [a] -> String
> listShowX :: Volume -> [a] -> String
listShowX Volume
i [a]
x = let v :: String
v = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Volume -> [String] -> [String]
forall a. Volume -> [a] -> [a]
take Volume
i (String -> [String]
forall a. a -> [a]
repeat String
" ")) in
>     String
"[\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
vString -> String -> String
forall a. [a] -> [a] -> [a]
++([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse (String
",\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
v) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (a -> String) -> [a] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map a -> String
forall a. Show a => a -> String
show [a]
x)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
vString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"]"

> instance Show Chunk where
>     show :: Chunk -> String
show (E MEvent
e) = String
"E "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow (MEvent -> Onset
eTime MEvent
e)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Volume -> String
pcShow (MEvent -> Volume
ePitch MEvent
e)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow (MEvent -> Onset
eDur MEvent
e)
>     show s :: Chunk
s@(Seq [Chunk]
x) = String
"S "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow (Chunk -> Onset
chunkOnset Chunk
s)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Volume -> [Chunk] -> String
forall a. Show a => Volume -> [a] -> String
listShowX Volume
4 [Chunk]
x
>     show c :: Chunk
c@(Chord [Chunk]
x) = String
"C "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow (Chunk -> Onset
chunkOnset Chunk
c)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Volume -> [Chunk] -> String
forall a. Show a => Volume -> [a] -> String
listShowX Volume
6 [Chunk]
x
>     show p :: Chunk
p@(Par [Chunk]
x) = String
"P "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow (Chunk -> Onset
chunkOnset Chunk
p)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Volume -> [Chunk] -> String
forall a. Show a => Volume -> [a] -> String
listShowX Volume
2 [Chunk]
x
>     show (R Onset
o Onset
d) = String
"R "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow Onset
oString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++Onset -> String
doubleShow Onset
d

An Ord instance for Chunk that enforces sorting based on onset time. No
other features are considered.

> instance Ord Chunk where
>     compare :: Chunk -> Chunk -> Ordering
compare Chunk
x1 Chunk
x2 = Onset -> Onset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Chunk -> Onset
chunkOnset Chunk
x1) (Chunk -> Onset
chunkOnset Chunk
x2)

Functions to determine the start time (onset) and duration of a Chunk.

> chunkOnset :: Chunk -> Onset
> chunkOnset :: Chunk -> Onset
chunkOnset (Seq [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Seq!" else Chunk -> Onset
chunkOnset ([Chunk] -> Chunk
forall a. [a] -> a
head [Chunk]
x)
> chunkOnset (Chord [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Chord!" else Chunk -> Onset
chunkOnset ([Chunk] -> Chunk
forall a. [a] -> a
head [Chunk]
x)
> chunkOnset (Par [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then Onset
0 else [Onset] -> Onset
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Onset] -> Onset) -> [Onset] -> Onset
forall a b. (a -> b) -> a -> b
$ (Chunk -> Onset) -> [Chunk] -> [Onset]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Onset
chunkOnset [Chunk]
x
> chunkOnset (E MEvent
e) = MEvent -> Onset
eTime MEvent
e
> chunkOnset (R Onset
o Onset
d) = Onset
o

> chunkEnd :: Chunk -> Onset
> chunkEnd :: Chunk -> Onset
chunkEnd (Seq [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Seq!" else Chunk -> Onset
chunkEnd ([Chunk] -> Chunk
forall a. [a] -> a
last [Chunk]
x)
> chunkEnd (Chord [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Chord!" else Chunk -> Onset
chunkEnd ([Chunk] -> Chunk
forall a. [a] -> a
head [Chunk]
x)
> chunkEnd (Par [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then Onset
0 else [Onset] -> Onset
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Onset] -> Onset) -> [Onset] -> Onset
forall a b. (a -> b) -> a -> b
$ (Chunk -> Onset) -> [Chunk] -> [Onset]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Onset
chunkEnd [Chunk]
x
> chunkEnd (E MEvent
e) = MEvent -> Onset
eTime MEvent
e Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
+ MEvent -> Onset
eDur MEvent
e
> chunkEnd (R Onset
o Onset
d) = Onset
o Onset -> Onset -> Onset
forall a. Num a => a -> a -> a
+ Onset
d

> chunkDur :: Chunk -> Dur
> chunkDur :: Chunk -> Onset
chunkDur (Seq [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Seq!" else [Onset] -> Onset
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Onset] -> Onset) -> [Onset] -> Onset
forall a b. (a -> b) -> a -> b
$ (Chunk -> Onset) -> [Chunk] -> [Onset]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Onset
chunkDur [Chunk]
x
> chunkDur (Chord [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then String -> Onset
forall a. HasCallStack => String -> a
error String
"Empty Chord!" else Chunk -> Onset
chunkDur ([Chunk] -> Chunk
forall a. [a] -> a
head [Chunk]
x)
> chunkDur c :: Chunk
c@(Par [Chunk]
x) = if [Chunk] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Chunk]
x then Onset
0 else 
>     let o :: Onset
o = Chunk -> Onset
chunkOnset Chunk
c
>         e :: Onset
e = Chunk -> Onset
chunkEnd Chunk
c
>     in  Onset
eOnset -> Onset -> Onset
forall a. Num a => a -> a -> a
-Onset
o
> chunkDur (E MEvent
e) = MEvent -> Onset
eDur MEvent
e
> chunkDur (R Onset
o Onset
d) = Onset
d

Special sorting function for MEvents.

> sortFun :: MEvent -> MEvent -> Ordering
> sortFun :: MEvent -> MEvent -> Ordering
sortFun MEvent
e1 MEvent
e2 = 
>     if MEvent -> Onset
eTime MEvent
e1 Onset -> Onset -> Bool
forall a. Eq a => a -> a -> Bool
== MEvent -> Onset
eTime MEvent
e2 then Volume -> Volume -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MEvent -> Volume
ePitch MEvent
e1) (MEvent -> Volume
ePitch MEvent
e2)
>     else Onset -> Onset -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (MEvent -> Onset
eTime MEvent
e1) (MEvent -> Onset
eTime MEvent
e2)