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, AbsPitch)
fromMidi2 = Music Note1 -> Music (Pitch, AbsPitch)
forall a. ToMusic1 a => Music a -> Music (Pitch, AbsPitch)
restructure (Music Note1 -> Music (Pitch, AbsPitch))
-> (Midi -> Music Note1) -> Midi -> Music (Pitch, AbsPitch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi -> Music Note1
fromMidi

> restructure :: (ToMusic1 a) => Music a -> Music (Pitch, Volume)
> restructure :: forall a. ToMusic1 a => Music a -> Music (Pitch, AbsPitch)
restructure = Music a -> Music (Pitch, AbsPitch)
forall a. ToMusic1 a => Music a -> Music (Pitch, AbsPitch)
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
$c== :: Chunk -> Chunk -> Bool
== :: Chunk -> Chunk -> Bool
$c/= :: Chunk -> Chunk -> Bool
/= :: 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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Chunk
v [Chunk]
cChord) [Chunk]
cs
>     in  if [Chunk] -> Bool
forall a. [a] -> 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 -> PTime
chunkOnset Chunk
c PTime -> PTime -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk -> PTime
chunkOnset Chunk
c0 Bool -> Bool -> Bool
&& Chunk -> PTime
chunkDur Chunk
c PTime -> PTime -> Bool
forall a. Eq a => a -> a -> Bool
== Chunk -> PTime
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 = PTime -> [Chunk] -> [Chunk]
buildMelFrom (Chunk -> PTime
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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Chunk
v [Chunk]
cMel) [Chunk]
x
>     in  if [Chunk] -> Bool
forall a. [a] -> 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 :: PTime -> [Chunk] -> [Chunk]
buildMelFrom PTime
t [] = []
> buildMelFrom PTime
t (Chunk
c:[Chunk]
cs) = 
>     if Chunk -> PTime
chunkOnset Chunk
c PTime -> PTime -> Bool
forall a. Eq a => a -> a -> Bool
== PTime
t then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: PTime -> [Chunk] -> [Chunk]
buildMelFrom (PTime
t PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+ Chunk -> PTime
chunkDur Chunk
c) [Chunk]
cs
>     else PTime -> [Chunk] -> [Chunk]
buildMelFrom PTime
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 = PTime -> [Chunk] -> [Chunk]
seqWithRests (Chunk -> PTime
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 a. Eq a => a -> [a] -> 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 :: PTime -> [Chunk] -> [Chunk]
seqWithRests PTime
t [] = []
> seqWithRests PTime
t x :: [Chunk]
x@(Chunk
c:[Chunk]
cs) = 
>     let tc :: PTime
tc = Chunk -> PTime
chunkOnset Chunk
c
>         dt :: PTime
dt = PTime
tc PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
- PTime
t
>     in  if PTime
dt PTime -> PTime -> Bool
forall a. Eq a => a -> a -> Bool
== PTime
0 then Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: PTime -> [Chunk] -> [Chunk]
seqWithRests (PTime
tc PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+ Chunk -> PTime
chunkDur Chunk
c) [Chunk]
cs
>         else if PTime
dt PTime -> PTime -> Bool
forall a. Ord a => a -> a -> Bool
> PTime
0 then PTime -> PTime -> Chunk
R PTime
t PTime
dt Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: Chunk
c Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
: PTime -> [Chunk] -> [Chunk]
seqWithRests (PTime
tc PTime -> PTime -> PTime
forall a. Num a => a -> a -> a
+ Chunk -> PTime
chunkDur Chunk
c) [Chunk]
cs
>         else PTime -> [Chunk] -> [Chunk]
seqWithRests PTime
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, AbsPitch)
chunkToMusic (E MEvent
e) = PTime -> (Pitch, AbsPitch) -> Music (Pitch, AbsPitch)
forall a. PTime -> a -> Music a
note (MEvent -> PTime
eDur MEvent
e PTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/ PTime
2) (AbsPitch -> Pitch
pitch (AbsPitch -> Pitch) -> AbsPitch -> Pitch
forall a b. (a -> b) -> a -> b
$ MEvent -> AbsPitch
ePitch MEvent
e, MEvent -> AbsPitch
eVol MEvent
e)
> chunkToMusic (R PTime
o PTime
d) = PTime -> Music (Pitch, AbsPitch)
forall a. PTime -> Music a
rest (PTime
dPTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/PTime
2)
> chunkToMusic (Seq [Chunk]
x) = [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a. [Music a] -> Music a
line((Chunk -> Music (Pitch, AbsPitch))
-> [Chunk] -> [Music (Pitch, AbsPitch)]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Music (Pitch, AbsPitch)
chunkToMusic [Chunk]
x)
> chunkToMusic (Chord [Chunk]
x) = [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a. [Music a] -> Music a
chord((Chunk -> Music (Pitch, AbsPitch))
-> [Chunk] -> [Music (Pitch, AbsPitch)]
forall a b. (a -> b) -> [a] -> [b]
map Chunk -> Music (Pitch, AbsPitch)
chunkToMusic [Chunk]
x)
> chunkToMusic (Par [Chunk]
x) = [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a. [Music a] -> Music a
chord ([Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch))
-> [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a b. (a -> b) -> a -> b
$ (Chunk -> Music (Pitch, AbsPitch))
-> [Chunk] -> [Music (Pitch, AbsPitch)]
forall a b. (a -> b) -> [a] -> [b]
map (\Chunk
v -> PTime -> Music (Pitch, AbsPitch)
forall a. PTime -> Music a
rest (Chunk -> PTime
chunkOnset Chunk
v PTime -> PTime -> PTime
forall a. Fractional a => a -> a -> a
/ PTime
2) Music (Pitch, AbsPitch)
-> Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch)
forall a. Music a -> Music a -> Music a
:+: Chunk -> Music (Pitch, AbsPitch)
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 :: forall a. ToMusic1 a => Music a -> Music (Pitch, AbsPitch)
parseFeatures = Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch)
forall a. Music a -> Music a
removeZeros (Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch))
-> (Music a -> Music (Pitch, AbsPitch))
-> Music a
-> Music (Pitch, AbsPitch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Music (Pitch, AbsPitch)
chunkToMusic (Chunk -> Music (Pitch, AbsPitch))
-> (Music a -> Chunk) -> Music a -> Music (Pitch, AbsPitch)
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 :: forall a. ToMusic1 a => Music a -> Music (Pitch, AbsPitch)
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, AbsPitch)]
parsesI = ([MEvent] -> Music (Pitch, AbsPitch))
-> [[MEvent]] -> [Music (Pitch, AbsPitch)]
forall a b. (a -> b) -> [a] -> [b]
map (Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch)
forall a. Music a -> Music a
removeZeros (Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch))
-> ([MEvent] -> Music (Pitch, AbsPitch))
-> [MEvent]
-> Music (Pitch, AbsPitch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunk -> Music (Pitch, AbsPitch)
chunkToMusic (Chunk -> Music (Pitch, AbsPitch))
-> ([MEvent] -> Chunk) -> [MEvent] -> Music (Pitch, AbsPitch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [MEvent] -> Chunk
chunkEvents) [[MEvent]]
mevsI
>     in  [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a. [Music a] -> Music a
chord ([Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch))
-> [Music (Pitch, AbsPitch)] -> Music (Pitch, AbsPitch)
forall a b. (a -> b) -> a -> b
$ (InstrumentName
 -> Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch))
-> [InstrumentName]
-> [Music (Pitch, AbsPitch)]
-> [Music (Pitch, AbsPitch)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith InstrumentName
-> Music (Pitch, AbsPitch) -> Music (Pitch, AbsPitch)
forall a. InstrumentName -> Music a -> Music a
instrument [InstrumentName]
iList [Music (Pitch, AbsPitch)]
parsesI

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

Utility Functions and Type Class Instances

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

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

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

> listShow, listShowN :: (Show a) => [a] -> String
> listShow :: forall a. Show a => [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 :: forall a. Show a => [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 :: forall a. Show a => AbsPitch -> [a] -> String
listShowX AbsPitch
i [a]
x = let v :: String
v = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (AbsPitch -> [String] -> [String]
forall a. AbsPitch -> [a] -> [a]
take AbsPitch
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]
++PTime -> String
doubleShow (MEvent -> PTime
eTime MEvent
e)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++AbsPitch -> String
pcShow (MEvent -> AbsPitch
ePitch MEvent
e)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow (MEvent -> PTime
eDur MEvent
e)
>     show s :: Chunk
s@(Seq [Chunk]
x) = String
"S "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow (Chunk -> PTime
chunkOnset Chunk
s)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++AbsPitch -> [Chunk] -> String
forall a. Show a => AbsPitch -> [a] -> String
listShowX AbsPitch
4 [Chunk]
x
>     show c :: Chunk
c@(Chord [Chunk]
x) = String
"C "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow (Chunk -> PTime
chunkOnset Chunk
c)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++AbsPitch -> [Chunk] -> String
forall a. Show a => AbsPitch -> [a] -> String
listShowX AbsPitch
6 [Chunk]
x
>     show p :: Chunk
p@(Par [Chunk]
x) = String
"P "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow (Chunk -> PTime
chunkOnset Chunk
p)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++AbsPitch -> [Chunk] -> String
forall a. Show a => AbsPitch -> [a] -> String
listShowX AbsPitch
2 [Chunk]
x
>     show (R PTime
o PTime
d) = String
"R "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow PTime
oString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++PTime -> String
doubleShow PTime
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 = PTime -> PTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Chunk -> PTime
chunkOnset Chunk
x1) (Chunk -> PTime
chunkOnset Chunk
x2)

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

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

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

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

Special sorting function for MEvents.

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