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
> 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
> 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)