MIDI File-writing module for use with Euterpea
Donya Quick
Last modified: 19-June-2013

This file fixes some file-writing bugs in Codec.Midi that 
prevent some multi-instrument output from showing up correctly. 
It defines the function exportMidiFile, which can be used like
Codec.Midi's exportFile function. Additionally, it defines two
functions for writing MIDI files, writeMidi and writeMidiA that
are like test and testA respectively but with an additional file
path argument.

NOTE #1: some of the binary handling should be redone at some 
point. Currently, parts of it are using conversion to a String 
type, and although it works, it should not be necessary (or at 
least a cleaner way should be found).

NOTE #2: many MIDI messages are currently unsupported. The set 
of supported messages is limited to those that can be produced by 
Euterpea.

> module Euterpea.IO.MIDI.ExportMidiFile
>     (exportMidiFile)  where
> import Codec.Midi
> import Numeric
> import Data.Char
> import qualified Data.ByteString as Byte 

A standard MIDI file has two main sections: a header and a 
series of track chunks. Track chunks each have a track header
section and end with an end-of-track marker. Detailed infomation
on the file format can be found here:

http://faydoc.tripod.com/formats/mid.htm


> makeFile :: Midi -> Byte.ByteString
> makeFile :: Midi -> ByteString
makeFile (Midi FileType
ft TimeDiv
td [Track Ticks]
trs) = 
>     let ticksPerQn :: Ticks
ticksPerQn = 
>             case TimeDiv
td of TicksPerBeat Ticks
x -> Ticks
x
>                        TicksPerSecond Ticks
x Ticks
y -> 
>                            [Char] -> Ticks
forall a. HasCallStack => [Char] -> a
error ([Char]
"(makeFile) Don't know how "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>                            [Char]
"to handle TicksPerSecond yet.")
>         header :: ByteString
header = FileType -> Ticks -> Ticks -> ByteString
makeHeader FileType
ft ([Track Ticks] -> Ticks
forall (t :: * -> *) a. Foldable t => t a -> Ticks
length [Track Ticks]
trs) Ticks
ticksPerQn
>         body :: [ByteString]
body = (Track Ticks -> ByteString) -> [Track Ticks] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Track Ticks -> ByteString
makeTrack [Track Ticks]
trs
>     in  [ByteString] -> ByteString
Byte.concat (ByteString
headerByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
body)

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

BUILD FILE HEADER

The standard MIDI file header starts with the following value:
4D 54 68 00 00 00 06 ff ff nn nn dd dd

ff ff is the format of the file: single-track, multi-track, or 
multi-track/multi-pattern. Only the first two cases are addressed 
here.

nn nn is the number of tracks in the file.

dd dd is the delta-time in ticks for a quarternote or beat.

> midiHeaderConst :: Byte.ByteString
> midiHeaderConst :: ByteString
midiHeaderConst = 
>     [Word8] -> ByteString
Byte.pack [Word8
0x4D, Word8
0x54, Word8
0x68, Word8
0x64, Word8
0x00, Word8
0x00, Word8
0x00, Word8
0x06] 

> type TrackCount = Int
> type TicksPerQN = Int


The MIDI file header is built as described above. 

> makeHeader :: FileType -> TrackCount -> TicksPerQN -> Byte.ByteString
> makeHeader :: FileType -> Ticks -> Ticks -> ByteString
makeHeader FileType
ft Ticks
numTracks Ticks
ticksPerQn = 
>     let 
>         ft' :: [Word8]
ft' = case FileType
ft of FileType
SingleTrack -> [Word8
0x00, Word8
0x00]
>                          FileType
MultiTrack -> [Word8
0x00, Word8
0x01]
>                          FileType
MultiPattern -> [Char] -> [Word8]
forall a. HasCallStack => [Char] -> a
error ([Char]
"(makeHeader) Don't know "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>                                          [Char]
"how to handle multi-pattern yet.")
>         numTracks' :: ByteString
numTracks' = Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
2 Ticks
numTracks
>         ticksPerQn' :: ByteString
ticksPerQn' = Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
2 Ticks
ticksPerQn
>     in  if Ticks
numTracks Ticks -> Ticks -> Bool
forall a. Ord a => a -> a -> Bool
> Ticks
16 then [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"(makeHeader) Don't know how to "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
>                                [Char]
"handle >16 tracks!")
>         else [ByteString] -> ByteString
Byte.concat [ByteString
midiHeaderConst, [Word8] -> ByteString
Byte.pack [Word8]
ft', ByteString
numTracks', ByteString
ticksPerQn']

> padByte :: Integral a => Int -> a -> Byte.ByteString
> padByte :: Ticks -> a -> ByteString
padByte Ticks
byteCount a
i = 
>   let b :: ByteString
b = [Word8] -> ByteString
Byte.pack [a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i] 
>       n :: Ticks
n = ByteString -> Ticks
Byte.length ByteString
b
>       padding :: ByteString
padding = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Ticks -> [Word8] -> [Word8]
forall a. Ticks -> [a] -> [a]
take (Ticks
byteCount Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
- Ticks
n) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Word8 -> [Word8]
forall a. a -> [a]
repeat Word8
0x00
>   in  if Ticks
n Ticks -> Ticks -> Bool
forall a. Ord a => a -> a -> Bool
< Ticks
byteCount then [ByteString] -> ByteString
Byte.concat [ByteString
padding, ByteString
b] else ByteString
b

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

BUILDING TRACKS

A track consists of a track header, event information, and an 
end-of-track marker. The track header has the format:

4D 54 72 6B xx xx xx xx

xx xx xx xx is the total number of BYTES in the track that 
follows the header. This includes the end marker! This value
is obtained by generating the track first and then generating
its header.

> makeTrack :: Track Ticks -> Byte.ByteString
> makeTrack :: Track Ticks -> ByteString
makeTrack Track Ticks
t = 
>     let body :: ByteString
body = Track Ticks -> ByteString
makeTrackBody Track Ticks
t
>         header :: ByteString
header = ByteString -> ByteString
makeTrackHeader ByteString
body
>     in  [ByteString] -> ByteString
Byte.concat [ByteString
header, ByteString
body]

> trackHeaderConst :: Byte.ByteString
> trackHeaderConst :: ByteString
trackHeaderConst = [Word8] -> ByteString
Byte.pack [Word8
0x4D, Word8
0x54, Word8
0x72, Word8
0x6B] 

> makeTrackHeader :: Byte.ByteString -> Byte.ByteString
> makeTrackHeader :: ByteString -> ByteString
makeTrackHeader ByteString
tbody = 
>     let len :: Ticks
len = ByteString -> Ticks
Byte.length ByteString
tbody
>         f :: Ticks -> ByteString
f = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString)
-> (Ticks -> [Word8]) -> Ticks -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ticks -> Word8) -> ([Char] -> Ticks) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Ticks
binStrToNum ([Char] -> Ticks) -> ([Char] -> [Char]) -> [Char] -> Ticks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse) ([[Char]] -> [Word8]) -> (Ticks -> [[Char]]) -> Ticks -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
>             Ticks -> [Char] -> [[Char]]
breakBinStrs Ticks
8 ([Char] -> [[Char]]) -> (Ticks -> [Char]) -> Ticks -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticks -> Char -> [Char] -> [Char]
forall a. Ticks -> a -> [a] -> [a]
pad (Ticks
8Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
*Ticks
4) Char
'0' ([Char] -> [Char]) -> (Ticks -> [Char]) -> Ticks -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticks -> [Char]
forall a. (Integral a, Show a) => a -> [Char]
numToBinStr
>     in  [ByteString] -> ByteString
Byte.concat [ByteString
trackHeaderConst, Ticks -> ByteString
f Ticks
len]

Track events have two components: a variable-length delta-time and
a message. The delta-time is the number of ticks between the last 
message and the next one. The format will be: time message time message ...

However, delta-times are tricky things. The fact that they can be 
any length requires that they be encoded in a special way. The binary
value of the number is split into 7-bit sections. This splitting 
goes from RIGHT TO LEFT (this is not in any documentation I have read,
but was the only way that worked). For n sections, the first start 
with a 1 and the last starts with a 0 - thereby indicating the last 
byte of the number. The following is an example of the conversion:

192 track ticks = C0 (hex) = 1100 0000 (bin) 
==> converts to 8140 (hex)

Split into 7-bit groups:        [1]  [100 0000]
Apply padding:           [000 0001]  [100 0000]
Add flags:              [1000 0001] [0100 0000]
Result as hex               8    1      4    0

> makeTrackBody :: Track Ticks -> Byte.ByteString 
> makeTrackBody :: Track Ticks -> ByteString
makeTrackBody [] = ByteString
endOfTrack -- end marker, very important!

> makeTrackBody ((Ticks
ticks, Message
msg):Track Ticks
rest) = 
>     let b :: ByteString
b = Message -> ByteString
msgToBytes Message
msg
>         b' :: [ByteString]
b' = [Ticks -> ByteString
forall a. (Integral a, Show a) => a -> ByteString
to7Bits Ticks
ticks, Message -> ByteString
msgToBytes Message
msg, Track Ticks -> ByteString
makeTrackBody Track Ticks
rest]
>     in  if ByteString -> Ticks
Byte.length ByteString
b Ticks -> Ticks -> Bool
forall a. Ord a => a -> a -> Bool
> Ticks
0 then [ByteString] -> ByteString
Byte.concat [ByteString]
b'             
>         else Track Ticks -> ByteString
makeTrackBody Track Ticks
rest

The end of track marker is set 96 ticks after the last event in the 
track. This offset is arbitrary, but it helps avoid clipping the notes
at the end of a file during playback in a program like Winamp or
Quicktime.

> endOfTrack :: ByteString
endOfTrack = [ByteString] -> ByteString
Byte.concat [Integer -> ByteString
forall a. (Integral a, Show a) => a -> ByteString
to7Bits Integer
96, [Word8] -> ByteString
Byte.pack [Word8
0xFF, Word8
0x2F, Word8
0x00]]

Splitting numbers into 7-bit sections and applying flags is done
by the following process:
- convert to a binary string representation
- pad the number to be full bytes
- split from right to left into groups of 7 and apply flags
- convert each 8-bit chunk back to a byte representation

> to7Bits :: (Integral a, Show a) => a -> Byte.ByteString
> to7Bits :: a -> ByteString
to7Bits =  [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString) -> (a -> [Word8]) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ticks -> Word8) -> ([Char] -> Ticks) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Ticks
binStrToNum ([Char] -> Ticks) -> ([Char] -> [Char]) -> [Char] -> Ticks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse) ([[Char]] -> [Word8]) -> (a -> [[Char]]) -> a -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
>            [[Char]] -> [[Char]]
fixBinStrs ([[Char]] -> [[Char]]) -> (a -> [[Char]]) -> a -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Ticks -> [Char] -> [Char]
padTo Ticks
7 ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse)([[Char]] -> [[Char]]) -> (a -> [[Char]]) -> a -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. [a] -> [a]
reverse ([[Char]] -> [[Char]]) -> (a -> [[Char]]) -> a -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
>            Ticks -> [Char] -> [[Char]]
breakBinStrs Ticks
7 ([Char] -> [[Char]]) -> (a -> [Char]) -> a -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticks -> [Char] -> [Char]
padTo Ticks
7 ([Char] -> [Char]) -> (a -> [Char]) -> a -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [Char]
forall a. (Integral a, Show a) => a -> [Char]
numToBinStr

Pad a binary string to be a multiple of i bits:

> padTo :: Int -> String -> String
> padTo :: Ticks -> [Char] -> [Char]
padTo Ticks
i [Char]
xs = if [Char] -> Ticks
forall (t :: * -> *) a. Foldable t => t a -> Ticks
length [Char]
xs Ticks -> Ticks -> Ticks
forall a. Integral a => a -> a -> a
`mod` Ticks
i Ticks -> Ticks -> Bool
forall a. Eq a => a -> a -> Bool
== Ticks
0 then [Char]
xs else Ticks -> [Char] -> [Char]
padTo Ticks
i (Char
'0'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:[Char]
xs)

Break a string into chunks of length i:

> breakBinStrs :: Int -> String -> [String]
> breakBinStrs :: Ticks -> [Char] -> [[Char]]
breakBinStrs Ticks
i [Char]
s = if [Char] -> Ticks
forall (t :: * -> *) a. Foldable t => t a -> Ticks
length [Char]
s Ticks -> Ticks -> Bool
forall a. Ord a => a -> a -> Bool
<= Ticks
i then [[Char]
s] else Ticks -> [Char] -> [Char]
forall a. Ticks -> [a] -> [a]
take Ticks
i [Char]
s [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Ticks -> [Char] -> [[Char]]
breakBinStrs Ticks
i (Ticks -> [Char] -> [Char]
forall a. Ticks -> [a] -> [a]
drop Ticks
i [Char]
s)

Convert a number to a binary string:

> numToBinStr :: (Integral a, Show a) => a -> String
> numToBinStr :: a -> [Char]
numToBinStr a
i = a -> (Ticks -> Char) -> a -> [Char] -> [Char]
forall a.
(Integral a, Show a) =>
a -> (Ticks -> Char) -> a -> [Char] -> [Char]
showIntAtBase a
2 Ticks -> Char
intToDigit a
i [Char]
""

Convert a binary string to an integer:

> binStrToNum :: String -> Int
> binStrToNum :: [Char] -> Ticks
binStrToNum [] = Ticks
0
> binStrToNum (Char
'0':[Char]
xs) = Ticks
2Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
* [Char] -> Ticks
binStrToNum [Char]
xs
> binStrToNum (Char
'1':[Char]
xs) = Ticks
1 Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
+ Ticks
2Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
*[Char] -> Ticks
binStrToNum [Char]
xs
> binStrToNum [Char]
_ = [Char] -> Ticks
forall a. HasCallStack => [Char] -> a
error [Char]
"bad data."

Append flags to a string (note, the string must be BACKWARDS):

> fixBinStrs :: [String] -> [String]
> fixBinStrs :: [[Char]] -> [[Char]]
fixBinStrs [[Char]]
xs = 
>     let n :: Ticks
n = [[Char]] -> Ticks
forall (t :: * -> *) a. Foldable t => t a -> Ticks
length [[Char]]
xs
>         bits :: [Char]
bits = Ticks -> [Char] -> [Char]
forall a. Ticks -> [a] -> [a]
take (Ticks
nTicks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
-Ticks
1) (Char -> [Char]
forall a. a -> [a]
repeat Char
'1') [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"0"
>     in  (Char -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
Prelude.zipWith (:) [Char]
bits [[Char]]
xs

Pad a list from the left until it is a fixed length:

> pad :: Int -> a -> [a] -> [a]
> pad :: Ticks -> a -> [a] -> [a]
pad Ticks
b a
x [a]
xs = if [a] -> Ticks
forall (t :: * -> *) a. Foldable t => t a -> Ticks
length [a]
xs Ticks -> Ticks -> Bool
forall a. Ord a => a -> a -> Bool
>= Ticks
b then [a]
xs else Ticks -> a -> [a] -> [a]
forall a. Ticks -> a -> [a] -> [a]
pad Ticks
b a
x (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)

Messages have the following encodings:

8x nn vv	Note Off for pitch nn at velocity vv, channel x
9x nn vv	Note On for pitch nn at velocity vv, channel x
Ax nn vv	Key aftertouch for pitch nn at velocity vv, channel x
Bx cc vv	Control Change for controller cc with value vv, channel x
Cx pp		Program Change to patch pp for channel x
Dx cc 		Channel after-touch to cc on channel x
Ex bb tt 	Pitch wheel to value ttbb, channel x (2000 hex is "normal") 
            (note: bb are least significant bits, tt are most significant)

Currently, only note on/off, control change, and program change are supported.

There are also META -EVENTS. This are events that have no channel number.
All meta-events have the format

FF xx nn nn dd dd ...

where xx is the command code, and nnnn is the number of bytes in the data (dd).

FF 00 nn ssss		Set track sequence number
FF 01 nn tt...		Text event
FF 02 nn tt...		Copyright info
FF 03 nn tt...		Track name
FF 04 nn tt...		Track instrument name
FF 05 nn tt...		Lyric
FF 06 nn tt...		Marker
FF 07 nn tt...		Cue point
FF 2F 00			END OF TRACK MARKER
FF 51 03 tttttt		Tempo change marker, where tttttt is the microseconds per qn
FF 48 04 nnddccbb	Time signature nn/dd with cc ticks per beat and bb 32nds/qn
FF 59 02 sfmi		Key signature with sf sharps/flats and mi mode in {0,1}

Of these, only the end of track and tempo marker are implemented.

> msgToBytes :: Message -> Byte.ByteString
> msgToBytes :: Message -> ByteString
msgToBytes (NoteOn Ticks
c Ticks
k Ticks
v) = 
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0x90 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ticks
c], Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
k, Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
v]
> msgToBytes (NoteOff Ticks
c Ticks
k Ticks
v) = 
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ticks
c], Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
k, Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
v]
> msgToBytes (ProgramChange Ticks
c Ticks
p) =  
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xC0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ticks
c], Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
p]
> msgToBytes (ControlChange Ticks
c Ticks
n Ticks
v) =  
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xB0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Ticks
c], Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
n, Ticks -> Ticks -> ByteString
forall a. Integral a => Ticks -> a -> ByteString
padByte Ticks
1 Ticks
v]
> msgToBytes (TempoChange Ticks
t) = -- META EVENT, HAS NO CHANNEL NUMBER

>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xFF, Word8
0x51, Word8
0x03], Ticks -> ByteString
fixTempo Ticks
t]
> msgToBytes Message
x = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char]
"(msgToBytes) Message type not currently "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
>                [Char]
"supported: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Message -> [Char]
forall a. Show a => a -> [Char]
show Message
x)

Fix a tempo value to be exactly 3 bytes:

> fixTempo :: Ticks -> ByteString
fixTempo = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString)
-> (Ticks -> [Word8]) -> Ticks -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Ticks -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Ticks -> Word8) -> ([Char] -> Ticks) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Ticks
binStrToNum ([Char] -> Ticks) -> ([Char] -> [Char]) -> [Char] -> Ticks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse) ([[Char]] -> [Word8]) -> (Ticks -> [[Char]]) -> Ticks -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
>            Ticks -> [Char] -> [[Char]]
breakBinStrs Ticks
8 ([Char] -> [[Char]]) -> (Ticks -> [Char]) -> Ticks -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticks -> Char -> [Char] -> [Char]
forall a. Ticks -> a -> [a] -> [a]
pad (Ticks
4Ticks -> Ticks -> Ticks
forall a. Num a => a -> a -> a
*Ticks
6) Char
'0' ([Char] -> [Char]) -> (Ticks -> [Char]) -> Ticks -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ticks -> [Char]
forall a. (Integral a, Show a) => a -> [Char]
numToBinStr

> exportMidiFile :: FilePath -> Midi -> IO ()
> exportMidiFile :: [Char] -> Midi -> IO ()
exportMidiFile [Char]
fn = [Char] -> ByteString -> IO ()
Byte.writeFile [Char]
fn (ByteString -> IO ()) -> (Midi -> ByteString) -> Midi -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Midi -> ByteString
makeFile


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

USAGE

The exportMidiFile can now be used as follows in place of Codec.Midi's exportFile:

 writeMidi :: (ToMusic1 a) => FilePath -> Music a -> IO ()
 writeMidi fn = exportMidiFile fn . testMidi

 writeMidiA :: (ToMusic1 a) => FilePath -> PMap Note1 -> Context Note1 -> Music a -> IO ()
 writeMidiA fn pm con m = exportMidiFile fn $ testMidiA pm con m

 test :: (ToMusic1 a) => Music a -> IO ()
 test = exportMidiFile "test.mid" . testMidi
 
 testA :: ToMusic1 a => PMap Note1 -> Context Note1 -> Music a -> IO ()
 testA pm con m = exportMidiFile "test.mid" (testMidiA pm con m)