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 Int]
trs) = 
>     let ticksPerQn :: Int
ticksPerQn = 
>             case TimeDiv
td of TicksPerBeat Int
x -> Int
x
>                        TicksPerSecond Int
x Int
y -> 
>                            [Char] -> Int
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 -> Int -> Int -> ByteString
makeHeader FileType
ft ([Track Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Track Int]
trs) Int
ticksPerQn
>         body :: [ByteString]
body = (Track Int -> ByteString) -> [Track Int] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Track Int -> ByteString
makeTrack [Track Int]
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 -> Int -> Int -> ByteString
makeHeader FileType
ft Int
numTracks Int
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' = Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
2 Int
numTracks
>         ticksPerQn' :: ByteString
ticksPerQn' = Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
2 Int
ticksPerQn
>     in  if Int
numTracks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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 :: forall a. Integral a => Int -> a -> ByteString
padByte Int
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 :: Int
n = ByteString -> Int
Byte.length ByteString
b
>       padding :: ByteString
padding = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
take (Int
byteCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Word8 -> [Word8]
forall a. a -> [a]
repeat Word8
0x00
>   in  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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 Int -> ByteString
makeTrack Track Int
t = 
>     let body :: ByteString
body = Track Int -> ByteString
makeTrackBody Track Int
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 :: Int
len = ByteString -> Int
Byte.length ByteString
tbody
>         f :: Int -> ByteString
f = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> ([Char] -> Int) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
binStrToNum ([Char] -> Int) -> ([Char] -> [Char]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse) ([[Char]] -> [Word8]) -> (Int -> [[Char]]) -> Int -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
>             Int -> [Char] -> [[Char]]
breakBinStrs Int
8 ([Char] -> [[Char]]) -> (Int -> [Char]) -> Int -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> [Char] -> [Char]
forall a. Int -> a -> [a] -> [a]
pad (Int
8Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
4) Char
'0' ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. (Integral a, Show a) => a -> [Char]
numToBinStr
>     in  [ByteString] -> ByteString
Byte.concat [ByteString
trackHeaderConst, Int -> ByteString
f Int
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 Int -> ByteString
makeTrackBody [] = ByteString
endOfTrack -- end marker, very important!

> makeTrackBody ((Int
ticks, Message
msg):Track Int
rest) = 
>     let b :: ByteString
b = Message -> ByteString
msgToBytes Message
msg
>         b' :: [ByteString]
b' = [Int -> ByteString
forall a. (Integral a, Show a) => a -> ByteString
to7Bits Int
ticks, Message -> ByteString
msgToBytes Message
msg, Track Int -> ByteString
makeTrackBody Track Int
rest]
>     in  if ByteString -> Int
Byte.length ByteString
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [ByteString] -> ByteString
Byte.concat [ByteString]
b'             
>         else Track Int -> ByteString
makeTrackBody Track Int
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 :: forall a. (Integral a, Show a) => 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 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> ([Char] -> Int) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
binStrToNum ([Char] -> Int) -> ([Char] -> [Char]) -> [Char] -> Int
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 (Int -> [Char] -> [Char]
padTo Int
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
. 
>            Int -> [Char] -> [[Char]]
breakBinStrs Int
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
. Int -> [Char] -> [Char]
padTo Int
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 :: Int -> [Char] -> [Char]
padTo Int
i [Char]
xs = if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
xs else Int -> [Char] -> [Char]
padTo Int
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 :: Int -> [Char] -> [[Char]]
breakBinStrs Int
i [Char]
s = if [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Char]
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i then [[Char]
s] else Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take Int
i [Char]
s [Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
: Int -> [Char] -> [[Char]]
breakBinStrs Int
i (Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
i [Char]
s)

Convert a number to a binary string:

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

Convert a binary string to an integer:

> binStrToNum :: String -> Int
> binStrToNum :: [Char] -> Int
binStrToNum [] = Int
0
> binStrToNum (Char
'0':[Char]
xs) = Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Char] -> Int
binStrToNum [Char]
xs
> binStrToNum (Char
'1':[Char]
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*[Char] -> Int
binStrToNum [Char]
xs
> binStrToNum [Char]
_ = [Char] -> Int
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 :: Int
n = [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs
>         bits :: [Char]
bits = Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
take (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
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 :: forall a. Int -> a -> [a] -> [a]
pad Int
b a
x [a]
xs = if [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
b then [a]
xs else Int -> a -> [a] -> [a]
forall a. Int -> a -> [a] -> [a]
pad Int
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 Int
c Int
k Int
v) = 
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0x90 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c], Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
k, Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
v]
> msgToBytes (NoteOff Int
c Int
k Int
v) = 
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0x80 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c], Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
k, Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
v]
> msgToBytes (ProgramChange Int
c Int
p) =  
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xC0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c], Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
p]
> msgToBytes (ControlChange Int
c Int
n Int
v) =  
>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xB0 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c], Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
n, Int -> Int -> ByteString
forall a. Integral a => Int -> a -> ByteString
padByte Int
1 Int
v]
> msgToBytes (TempoChange Int
t) = -- META EVENT, HAS NO CHANNEL NUMBER

>     [ByteString] -> ByteString
Byte.concat [[Word8] -> ByteString
Byte.pack [Word8
0xFF, Word8
0x51, Word8
0x03], Int -> ByteString
fixTempo Int
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 :: Int -> ByteString
fixTempo = [Word8] -> ByteString
Byte.pack ([Word8] -> ByteString) -> (Int -> [Word8]) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> ([Char] -> Int) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Int
binStrToNum ([Char] -> Int) -> ([Char] -> [Char]) -> [Char] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
reverse) ([[Char]] -> [Word8]) -> (Int -> [[Char]]) -> Int -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
>            Int -> [Char] -> [[Char]]
breakBinStrs Int
8 ([Char] -> [[Char]]) -> (Int -> [Char]) -> Int -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Char -> [Char] -> [Char]
forall a. Int -> a -> [a] -> [a]
pad (Int
4Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
6) Char
'0' ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [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)