{- |
Loading MIDI Files
This module loads and parses a MIDI File.
It can convert it into a 'MIDIFile.T' data type object or
simply print out the contents of the file.
-}{-
The MIDI file format is quite similar to the Interchange File Format (IFF)
of Electronic Arts.
But it seems to be not sensible
to re-use functionality from the @iff@ package.
-}moduleSound.MIDI.File.Load(fromFile,fromByteList,maybeFromByteList,maybeFromByteString,showFile,)whereimportSound.MIDI.FileimportqualifiedSound.MIDI.FileasMIDIFileimportqualifiedSound.MIDI.File.Event.MetaasMetaEventimportqualifiedSound.MIDI.File.EventasEventimportqualifiedData.EventList.Relative.TimeBodyasEventListimportqualifiedNumeric.NonNegative.WrapperasNonNegimportSound.MIDI.IO(ByteList,readBinaryFile,)-- import qualified Sound.MIDI.Bit as BitimportSound.MIDI.String(unlinesS)importSound.MIDI.Parser.PrimitiveimportqualifiedSound.MIDI.Parser.ClassasParserimportqualifiedSound.MIDI.Parser.RestrictedasRestrictedParserimportqualifiedSound.MIDI.Parser.ByteStringasByteStringParserimportqualifiedSound.MIDI.Parser.StreamasStreamParserimportqualifiedSound.MIDI.Parser.FileasFileParserimportqualifiedSound.MIDI.Parser.StatusasStatusParserimportqualifiedSound.MIDI.Parser.ReportasReportimportControl.Monad.Trans(lift,)importControl.Monad(liftM,liftM2,)importqualifiedData.ByteString.LazyasBimportqualifiedControl.Monad.Exception.AsynchronousasAsync-- import qualified Control.Monad.Exception.Synchronous as Sync-- import System.IO (hPutStrLn, stderr, )importData.List(genericReplicate,genericLength,)importData.Maybe(catMaybes,){- |
The main load function.
Warnings are written to standard error output
and an error is signaled by a user exception.
This function will not be appropriate in GUI applications.
For these, use 'maybeFromByteString' instead.
-}fromFile::FilePath->IOMIDIFile.TfromFile=FileParser.runIncompleteFileparse{-
fromFile :: FilePath -> IO MIDIFile.T
fromFile filename =
do report <- fmap maybeFromByteList $ readBinaryFile filename
mapM_ (hPutStrLn stderr . ("MIDI.File.Load warning: " ++)) (StreamParser.warnings report)
either
(ioError . userError . ("MIDI.File.Load error: " ++))
return
(StreamParser.result report)
-}{- |
This function ignores warnings, turns exceptions into errors,
and return partial results without warnings.
Use this only in testing but never in production code!
-}fromByteList::ByteList->MIDIFile.TfromByteListcontents=eithererrorid(Report.result(maybeFromByteListcontents))maybeFromByteList::ByteList->Report.TMIDIFile.TmaybeFromByteList=StreamParser.runIncompleteparse.StreamParser.ByteListmaybeFromByteString::B.ByteString->Report.TMIDIFile.TmaybeFromByteString=ByteStringParser.runIncompleteparse{- |
A MIDI file is made of /chunks/, each of which is either a /header chunk/
or a /track chunk/. To be correct, it must consist of one header chunk
followed by any number of track chunks, but for robustness's sake we ignore
any non-header chunks that come before a header chunk. The header tells us
the number of tracks to come, which is passed to 'getTracks'.
-}parse::Parser.Cparser=>Parser.Partial(Parser.Fallibleparser)MIDIFile.Tparse=getChunk>>=\(typ,hdLen)->casetypof"MThd"->do(format,nTracks,division)<-RestrictedParser.runFalliblehdLengetHeaderexcTracks<-lift$Parser.zeroOrMoreInc(getTrackChunk>>=Async.mapM(lift.liftMayberemoveEndOfTrack))flipAsync.mapMexcTracks$\tracks->doletn=genericLengthtrackslift$Parser.warnIf(n/=nTracks)("header says "++shownTracks++" tracks, but "++shown++" tracks were found")return(MIDIFile.Consformatdivision$catMaybestracks)_->lift(Parser.warn("found Alien chunk <"++typ++">"))>>Parser.skiphdLen>>parseliftMaybe::Monadm=>(a->mb)->Maybea->m(Maybeb)liftMaybef=maybe(returnNothing)(liftMJust.f){- |
There are two ways to mark the end of the track:
The end of the event list and the meta event 'EndOfTrack'.
Thus the end marker is redundant and we remove a 'EndOfTrack'
at the end of the track
and complain about all 'EndOfTrack's within the event list.
-}removeEndOfTrack::Parser.Cparser=>Track->parserTrackremoveEndOfTrackxs=maybe(Parser.warn"Empty track, missing EndOfTrack">>returnxs)(\(initEvents,lastEvent)->let(eots,track)=EventList.partitionisEndOfTrackinitEventsindoParser.warnIf(not$EventList.nulleots)"EndOfTrack inside a track"Parser.warnIf(not$isEndOfTrack$sndlastEvent)"Track does not end with EndOfTrack"returntrack)(EventList.viewRxs)isEndOfTrack::Event.T->BoolisEndOfTrackev=caseevofEvent.MetaEventMetaEvent.EndOfTrack->True_->False{-
removeEndOfTrack :: Track -> Track
removeEndOfTrack =
maybe
(error "Track does not end with EndOfTrack")
(\(ev,evs) ->
case snd ev of
MetaEvent EndOfTrack ->
if EventList.null evs
then evs
else error "EndOfTrack inside a track"
_ -> uncurry EventList.cons ev (removeEndOfTrack evs)) .
EventList.viewL
-}{- |
Parse a chunk, whether a header chunk, a track chunk, or otherwise.
A chunk consists of a four-byte type code
(a header is @MThd@; a track is @MTrk@),
four bytes for the size of the coming data,
and the data itself.
-}getChunk::Parser.Cparser=>Parser.Fallibleparser(String,NonNeg.Integer)getChunk=liftM2(,)(getString4)-- chunk type: header or track(getNByteCardinal4)-- chunk bodygetTrackChunk::Parser.Cparser=>Parser.Partial(Parser.Fallibleparser)(MaybeTrack)getTrackChunk=do(typ,len)<-getChunkiftyp=="MTrk"thenliftM(fmapJust)$lift$RestrictedParser.runlen$StatusParser.rungetTrackelselift(Parser.warn("found Alien chunk <"++typ++"> in track section"))>>Parser.skiplen>>return(Async.pureNothing){- |
Parse a Header Chunk. A header consists of a format (0, 1, or 2),
the number of track chunks to come, and the smallest time division
to be used in reading the rest of the file.
-}getHeader::Parser.Cparser=>Parser.Fallibleparser(MIDIFile.Type,NonNeg.Int,Division)getHeader=doformat<-makeEnum=<<get2nTracks<-liftM(NonNeg.fromNumberMsg"MIDI.Load.getHeader")get2division<-getDivisionreturn(format,nTracks,division){- |
The division is implemented thus: the most significant bit is 0 if it's
in ticks per quarter note; 1 if it's an SMPTE value.
-}getDivision::Parser.Cparser=>Parser.FallibleparserDivisiongetDivision=dox<-get1y<-get1return$ifx<128thenTicks(NonNeg.fromNumberMsg"MIDI.Load.getDivision"(x*256+y))elseSMPTE(256-x)y{- |
A track is a series of events. Parse a track, stopping when the size
is zero.
-}getTrack::Parser.Cparser=>Parser.Partial(StatusParser.Tparser)MIDIFile.TrackgetTrack=liftM(fmapEventList.fromPairList)(Parser.zeroOrMoreEvent.getTrackEvent)-- * show contents of a MIDI file for debugging{-# DEPRECATED showFile "only use this for debugging" #-}{- |
Functions to show the decoded contents of a MIDI file in an easy-to-read format.
This is for debugging purposes and should not be used in production code.
-}showFile::FilePath->IO()showFilefileName=putStr.showChunks=<<readBinaryFilefileNameshowChunks::ByteList->StringshowChunksmf=showMR(liftgetChunks)(\(Async.Exceptionalmecs)->unlinesS(mapppcs).maybeid(\e->showString("incomplete chunk list: "++e++"\n"))me)mf""wherepp::(String,ByteList)->ShowSpp("MThd",contents)=showString"Header: ".showMRgetHeadershowscontentspp("MTrk",contents)=showString"Track:\n".showMR(lift$StatusParser.rungetTrack)(\(Async.Exceptionalmetrack)str->EventList.foldrMIDIFile.showTime(\e->MIDIFile.showEvente.showString"\n")(maybe""(\e->"incomplete track: "++e++"\n")me++str)track)contentspp(ty,contents)=showString"Alien Chunk: ".showStringty.showString" ".showscontents.showString"\n"showMR::Parser.Fallible(StreamParser.TStreamParser.ByteList)a->(a->ShowS)->ByteList->ShowSshowMRmppcontents=letreport=StreamParser.runm(StreamParser.ByteListcontents)inunlinesS(mapshowString$Report.warningsreport).eithershowStringpp(Report.resultreport){- |
The two functions, the 'getChunk' and 'getChunks' parsers,
do not combine directly into a single master parser.
Rather, they should be used to chop parts of a midi file
up into chunks of bytes which can be outputted separately.
Chop a MIDI file into chunks returning:
* list of /chunk-type/-contents pairs; and
* leftover slop (should be empty in correctly formatted file)
-}getChunks::Parser.Cparser=>Parser.Partialparser[(String,ByteList)]getChunks=Parser.zeroOrMore$do(typ,len)<-getChunkbody<-sequence(genericReplicatelengetByte)return(typ,body)