{- |
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.
-}
module Sound.MIDI.File.Load (
   fromFile, fromByteList, maybeFromByteList, maybeFromByteString,
   showFile,
   ) where

import           Sound.MIDI.File
import qualified Sound.MIDI.File as MIDIFile
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Sound.MIDI.File.Event as Event

import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg

import Sound.MIDI.IO (ByteList, readBinaryFile, )
import           Sound.MIDI.String (unlinesS)
import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser
import qualified Sound.MIDI.Parser.Restricted as RestrictedParser
import qualified Sound.MIDI.Parser.ByteString as ByteStringParser
import qualified Sound.MIDI.Parser.Stream as StreamParser
import qualified Sound.MIDI.Parser.File   as FileParser
import qualified Sound.MIDI.Parser.Status as StatusParser
import qualified Sound.MIDI.Parser.Report as Report
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, liftM2, )

import qualified Data.ByteString.Lazy as B

import qualified Control.Monad.Exception.Asynchronous as Async
import Data.List (genericReplicate, genericLength, )
import Data.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 -> IO MIDIFile.T
fromFile :: FilePath -> IO T
fromFile =
   Partial (Fragile T) T -> FilePath -> IO T
forall a. Partial (Fragile T) a -> FilePath -> IO a
FileParser.runIncompleteFile Partial (Fragile T) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse


{-
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.T
fromByteList :: ByteList -> T
fromByteList ByteList
contents =
   (FilePath -> T) -> (T -> T) -> Either FilePath T -> T
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
      FilePath -> T
forall a. HasCallStack => FilePath -> a
error T -> T
forall a. a -> a
id
      (T T -> Either FilePath T
forall a. T a -> Either FilePath a
Report.result (ByteList -> T T
maybeFromByteList ByteList
contents))

maybeFromByteList ::
   ByteList -> Report.T MIDIFile.T
maybeFromByteList :: ByteList -> T T
maybeFromByteList =
   Partial (Fragile (T ByteList)) T -> ByteList -> T T
forall str a.
ByteStream str =>
Partial (Fragile (T str)) a -> str -> T a
StreamParser.runIncomplete Partial (Fragile (T ByteList)) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse (ByteList -> T T) -> (ByteList -> ByteList) -> ByteList -> T T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteList -> ByteList
StreamParser.ByteList

maybeFromByteString ::
   B.ByteString -> Report.T MIDIFile.T
maybeFromByteString :: ByteString -> T T
maybeFromByteString =
   Partial (Fragile T) T -> ByteString -> T T
forall a. Partial (Fragile T) a -> ByteString -> T a
ByteStringParser.runIncomplete Partial (Fragile T) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse



{- |
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.C parser => Parser.Partial (Parser.Fragile parser) MIDIFile.T
parse :: Partial (Fragile parser) T
parse =
   Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk Fragile parser (FilePath, Integer)
-> ((FilePath, Integer) -> Partial (Fragile parser) T)
-> Partial (Fragile parser) T
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (FilePath
typ, Integer
hdLen) ->
      case FilePath
typ of
        FilePath
"MThd" ->
           do (Type
format, Int
nTracks, Division
division) <-
                 Integer
-> Fragile (T parser) (Type, Int, Division)
-> Fragile parser (Type, Int, Division)
forall (parser :: * -> *) a.
C parser =>
Integer -> Fragile (T parser) a -> Fragile parser a
RestrictedParser.runFragile Integer
hdLen Fragile (T parser) (Type, Int, Division)
forall (parser :: * -> *).
C parser =>
Fragile parser (Type, Int, Division)
getHeader
              PossiblyIncomplete [Maybe Track]
excTracks <-
                 parser (PossiblyIncomplete [Maybe Track])
-> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (PossiblyIncomplete [Maybe Track])
 -> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track]))
-> parser (PossiblyIncomplete [Maybe Track])
-> ExceptionalT FilePath parser (PossiblyIncomplete [Maybe Track])
forall a b. (a -> b) -> a -> b
$ Partial (Fragile parser) (Maybe Track)
-> parser (PossiblyIncomplete [Maybe Track])
forall (parser :: * -> *) a.
EndCheck parser =>
Partial (Fragile parser) a -> Partial parser [a]
Parser.zeroOrMoreInc
                    (Partial (Fragile parser) (Maybe Track)
forall (parser :: * -> *).
C parser =>
Partial (Fragile parser) (Maybe Track)
getTrackChunk Partial (Fragile parser) (Maybe Track)
-> (PossiblyIncomplete (Maybe Track)
    -> Partial (Fragile parser) (Maybe Track))
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Track -> ExceptionalT FilePath parser (Maybe Track))
-> PossiblyIncomplete (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b e.
Monad m =>
(a -> m b) -> Exceptional e a -> m (Exceptional e b)
Async.mapM (parser (Maybe Track) -> ExceptionalT FilePath parser (Maybe Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (Maybe Track)
 -> ExceptionalT FilePath parser (Maybe Track))
-> (Maybe Track -> parser (Maybe Track))
-> Maybe Track
-> ExceptionalT FilePath parser (Maybe Track)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Track -> parser Track) -> Maybe Track -> parser (Maybe Track)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe Track -> parser Track
forall (parser :: * -> *). C parser => Track -> parser Track
removeEndOfTrack))
              (([Maybe Track] -> ExceptionalT FilePath parser T)
 -> PossiblyIncomplete [Maybe Track] -> Partial (Fragile parser) T)
-> PossiblyIncomplete [Maybe Track]
-> ([Maybe Track] -> ExceptionalT FilePath parser T)
-> Partial (Fragile parser) T
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Maybe Track] -> ExceptionalT FilePath parser T)
-> PossiblyIncomplete [Maybe Track] -> Partial (Fragile parser) T
forall (m :: * -> *) a b e.
Monad m =>
(a -> m b) -> Exceptional e a -> m (Exceptional e b)
Async.mapM PossiblyIncomplete [Maybe Track]
excTracks (([Maybe Track] -> ExceptionalT FilePath parser T)
 -> Partial (Fragile parser) T)
-> ([Maybe Track] -> ExceptionalT FilePath parser T)
-> Partial (Fragile parser) T
forall a b. (a -> b) -> a -> b
$ \[Maybe Track]
tracks ->
                 do let n :: Int
n = [Maybe Track] -> Int
forall i a. Num i => [a] -> i
genericLength [Maybe Track]
tracks
                    parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser () -> ExceptionalT FilePath parser ())
-> parser () -> ExceptionalT FilePath parser ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf (Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
nTracks)
                       (FilePath
"header says " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
nTracks FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
                        FilePath
" tracks, but " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
n FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" tracks were found")
                    T -> ExceptionalT FilePath parser T
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> Division -> [Track] -> T
MIDIFile.Cons Type
format Division
division ([Track] -> T) -> [Track] -> T
forall a b. (a -> b) -> a -> b
$ [Maybe Track] -> [Track]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Track]
tracks)
        FilePath
_ -> parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn (FilePath
"found Alien chunk <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
typ FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
">")) ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Integer -> ExceptionalT FilePath parser ()
forall (parser :: * -> *). C parser => Integer -> Fragile parser ()
Parser.skip Integer
hdLen ExceptionalT FilePath parser ()
-> Partial (Fragile parser) T -> Partial (Fragile parser) T
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Partial (Fragile parser) T
forall (parser :: * -> *). C parser => Partial (Fragile parser) T
parse


liftMaybe :: Monad m => (a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe :: (a -> m b) -> Maybe a -> m (Maybe b)
liftMaybe a -> m b
f = m (Maybe b) -> (a -> m (Maybe b)) -> Maybe a -> m (Maybe b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing) ((b -> Maybe b) -> m b -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (m b -> m (Maybe b)) -> (a -> m b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
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.C parser => Track -> parser Track
removeEndOfTrack :: Track -> parser Track
removeEndOfTrack Track
xs =
   parser Track
-> ((Track, (Integer, T)) -> parser Track)
-> Maybe (Track, (Integer, T))
-> parser Track
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn FilePath
"Empty track, missing EndOfTrack" parser () -> parser Track -> parser Track
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
       Track -> parser Track
forall (m :: * -> *) a. Monad m => a -> m a
return Track
xs)
      (\(Track
initEvents, (Integer, T)
lastEvent) ->
          let (Track
eots, Track
track) =
                 (T -> Bool) -> Track -> (Track, Track)
forall time body.
C time =>
(body -> Bool) -> T time body -> (T time body, T time body)
EventList.partition T -> Bool
isEndOfTrack Track
initEvents
          in  do Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf
                    (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Track -> Bool
forall time body. T time body -> Bool
EventList.null Track
eots)
                    FilePath
"EndOfTrack inside a track"
                 Bool -> FilePath -> parser ()
forall (parser :: * -> *).
C parser =>
Bool -> FilePath -> parser ()
Parser.warnIf
                    (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ T -> Bool
isEndOfTrack (T -> Bool) -> T -> Bool
forall a b. (a -> b) -> a -> b
$ (Integer, T) -> T
forall a b. (a, b) -> b
snd (Integer, T)
lastEvent)
                    FilePath
"Track does not end with EndOfTrack"
                 Track -> parser Track
forall (m :: * -> *) a. Monad m => a -> m a
return Track
track)
      (Track -> Maybe (Track, (Integer, T))
forall time body. T time body -> Maybe (T time body, (time, body))
EventList.viewR Track
xs)

isEndOfTrack :: Event.T -> Bool
isEndOfTrack :: T -> Bool
isEndOfTrack T
ev =
   case T
ev of
      Event.MetaEvent T
MetaEvent.EndOfTrack -> Bool
True
      T
_ -> Bool
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.C parser => Parser.Fragile parser (String, NonNeg.Integer)
getChunk :: Fragile parser (FilePath, Integer)
getChunk =
   (FilePath -> Integer -> (FilePath, Integer))
-> ExceptionalT FilePath parser FilePath
-> ExceptionalT FilePath parser Integer
-> Fragile parser (FilePath, Integer)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,)
      (Integer -> ExceptionalT FilePath parser FilePath
forall (parser :: * -> *).
C parser =>
Integer -> Fragile parser FilePath
getString Integer
4)  -- chunk type: header or track
      (Int -> ExceptionalT FilePath parser Integer
forall (parser :: * -> *).
C parser =>
Int -> Fragile parser Integer
getNByteCardinal Int
4)
                     -- chunk body

getTrackChunk :: Parser.C parser => Parser.Partial (Parser.Fragile parser) (Maybe Track)
getTrackChunk :: Partial (Fragile parser) (Maybe Track)
getTrackChunk =
   do (FilePath
typ, Integer
len) <- Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk
      if FilePath
typFilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==FilePath
"MTrk"
        then (Exceptional FilePath Track -> PossiblyIncomplete (Maybe Track))
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((Track -> Maybe Track)
-> Exceptional FilePath Track -> PossiblyIncomplete (Maybe Track)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Track -> Maybe Track
forall a. a -> Maybe a
Just) (ExceptionalT FilePath parser (Exceptional FilePath Track)
 -> Partial (Fragile parser) (Maybe Track))
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
-> Partial (Fragile parser) (Maybe Track)
forall a b. (a -> b) -> a -> b
$ parser (Exceptional FilePath Track)
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (parser (Exceptional FilePath Track)
 -> ExceptionalT FilePath parser (Exceptional FilePath Track))
-> parser (Exceptional FilePath Track)
-> ExceptionalT FilePath parser (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$
             Integer
-> T parser (Exceptional FilePath Track)
-> parser (Exceptional FilePath Track)
forall (parser :: * -> *) a.
C parser =>
Integer -> T parser a -> parser a
RestrictedParser.run Integer
len (T parser (Exceptional FilePath Track)
 -> parser (Exceptional FilePath Track))
-> T parser (Exceptional FilePath Track)
-> parser (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$
             T (T parser) (Exceptional FilePath Track)
-> T parser (Exceptional FilePath Track)
forall (parser :: * -> *) a. Monad parser => T parser a -> parser a
StatusParser.run T (T parser) (Exceptional FilePath Track)
forall (parser :: * -> *). C parser => Partial (T parser) Track
getTrack
        else parser () -> ExceptionalT FilePath parser ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (FilePath -> parser ()
forall (parser :: * -> *). C parser => FilePath -> parser ()
Parser.warn (FilePath
"found Alien chunk <" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
typ FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"> in track section")) ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
-> ExceptionalT FilePath parser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             Integer -> ExceptionalT FilePath parser ()
forall (parser :: * -> *). C parser => Integer -> Fragile parser ()
Parser.skip Integer
len ExceptionalT FilePath parser ()
-> Partial (Fragile parser) (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
             PossiblyIncomplete (Maybe Track)
-> Partial (Fragile parser) (Maybe Track)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Track -> PossiblyIncomplete (Maybe Track)
forall a e. a -> Exceptional e a
Async.pure Maybe Track
forall a. Maybe a
Nothing)



{- |
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.C parser => Parser.Fragile parser (MIDIFile.Type, NonNeg.Int, Division)
getHeader :: Fragile parser (Type, Int, Division)
getHeader =
   do
      Type
format   <- Int -> Fragile parser Type
forall (parser :: * -> *) enum.
(C parser, Enum enum, Bounded enum) =>
Int -> Fragile parser enum
makeEnum (Int -> Fragile parser Type)
-> ExceptionalT FilePath parser Int -> Fragile parser Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ExceptionalT FilePath parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get2
      Int
nTracks  <- (Int -> Int)
-> ExceptionalT FilePath parser Int
-> ExceptionalT FilePath parser Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (FilePath -> Int -> Int
forall a. (Ord a, Num a) => FilePath -> a -> T a
NonNeg.fromNumberMsg FilePath
"MIDI.Load.getHeader") ExceptionalT FilePath parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get2
      Division
division <- Fragile parser Division
forall (parser :: * -> *). C parser => Fragile parser Division
getDivision
      (Type, Int, Division) -> Fragile parser (Type, Int, Division)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
format, Int
nTracks, Division
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.C parser => Parser.Fragile parser Division
getDivision :: Fragile parser Division
getDivision =
   do
      Int
x <- Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
      Int
y <- Fragile parser Int
forall (parser :: * -> *). C parser => Fragile parser Int
get1
      Division -> Fragile parser Division
forall (m :: * -> *) a. Monad m => a -> m a
return (Division -> Fragile parser Division)
-> Division -> Fragile parser Division
forall a b. (a -> b) -> a -> b
$
         if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
128
           then Int -> Division
Ticks (FilePath -> Int -> Int
forall a. (Ord a, Num a) => FilePath -> a -> T a
NonNeg.fromNumberMsg FilePath
"MIDI.Load.getDivision" (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
y))
           else Int -> Int -> Division
SMPTE (Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x) Int
y

{- |
A track is a series of events.  Parse a track, stopping when the size
is zero.
-}
getTrack :: Parser.C parser => Parser.Partial (StatusParser.T parser) MIDIFile.Track
getTrack :: Partial (T parser) Track
getTrack =
   (Exceptional FilePath [(Integer, T)] -> Exceptional FilePath Track)
-> T parser (Exceptional FilePath [(Integer, T)])
-> Partial (T parser) Track
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM
      (([(Integer, T)] -> Track)
-> Exceptional FilePath [(Integer, T)]
-> Exceptional FilePath Track
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Integer, T)] -> Track
forall a b. [(a, b)] -> T a b
EventList.fromPairList)
      (Fragile (T parser) (Integer, T)
-> T parser (Exceptional FilePath [(Integer, T)])
forall (parser :: * -> *) a.
EndCheck parser =>
Fragile parser a -> Partial parser [a]
Parser.zeroOrMore Fragile (T parser) (Integer, T)
forall (parser :: * -> *).
C parser =>
Fragile (T parser) (Integer, T)
Event.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 ()
showFile :: FilePath -> IO ()
showFile FilePath
fileName = FilePath -> IO ()
putStr (FilePath -> IO ()) -> (ByteList -> FilePath) -> ByteList -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteList -> FilePath
showChunks (ByteList -> IO ()) -> IO ByteList -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO ByteList
readBinaryFile FilePath
fileName

showChunks :: ByteList -> String
showChunks :: ByteList -> FilePath
showChunks ByteList
mf =
  Fragile (T ByteList) (PossiblyIncomplete [(FilePath, ByteList)])
-> (PossiblyIncomplete [(FilePath, ByteList)]
    -> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR (T ByteList (PossiblyIncomplete [(FilePath, ByteList)])
-> Fragile (T ByteList) (PossiblyIncomplete [(FilePath, ByteList)])
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift T ByteList (PossiblyIncomplete [(FilePath, ByteList)])
forall (parser :: * -> *).
C parser =>
Partial parser [(FilePath, ByteList)]
getChunks) (\(Async.Exceptional Maybe FilePath
me [(FilePath, ByteList)]
cs) ->
     [FilePath -> FilePath] -> FilePath -> FilePath
unlinesS (((FilePath, ByteList) -> FilePath -> FilePath)
-> [(FilePath, ByteList)] -> [FilePath -> FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, ByteList) -> FilePath -> FilePath
pp [(FilePath, ByteList)]
cs) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (FilePath -> FilePath)
-> (FilePath -> FilePath -> FilePath)
-> Maybe FilePath
-> FilePath
-> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath -> FilePath
forall a. a -> a
id (\FilePath
e -> FilePath -> FilePath -> FilePath
showString (FilePath
"incomplete chunk list: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n")) Maybe FilePath
me) ByteList
mf FilePath
""
 where
  pp :: (String, ByteList) -> ShowS
  pp :: (FilePath, ByteList) -> FilePath -> FilePath
pp (FilePath
"MThd",ByteList
contents) =
    FilePath -> FilePath -> FilePath
showString FilePath
"Header: " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Fragile (T ByteList) (Type, Int, Division)
-> ((Type, Int, Division) -> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR Fragile (T ByteList) (Type, Int, Division)
forall (parser :: * -> *).
C parser =>
Fragile parser (Type, Int, Division)
getHeader (Type, Int, Division) -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ByteList
contents
  pp (FilePath
"MTrk",ByteList
contents) =
    FilePath -> FilePath -> FilePath
showString FilePath
"Track:\n" (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    Fragile (T ByteList) (Exceptional FilePath Track)
-> (Exceptional FilePath Track -> FilePath -> FilePath)
-> ByteList
-> FilePath
-> FilePath
forall a.
Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR (T ByteList (Exceptional FilePath Track)
-> Fragile (T ByteList) (Exceptional FilePath Track)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (T ByteList (Exceptional FilePath Track)
 -> Fragile (T ByteList) (Exceptional FilePath Track))
-> T ByteList (Exceptional FilePath Track)
-> Fragile (T ByteList) (Exceptional FilePath Track)
forall a b. (a -> b) -> a -> b
$ T (T ByteList) (Exceptional FilePath Track)
-> T ByteList (Exceptional FilePath Track)
forall (parser :: * -> *) a. Monad parser => T parser a -> parser a
StatusParser.run T (T ByteList) (Exceptional FilePath Track)
forall (parser :: * -> *). C parser => Partial (T parser) Track
getTrack)
        (\(Async.Exceptional Maybe FilePath
me Track
track) FilePath
str ->
            (Integer -> FilePath -> FilePath)
-> (T -> FilePath -> FilePath) -> FilePath -> Track -> FilePath
forall time a b body.
(time -> a -> b) -> (body -> b -> a) -> b -> T time body -> b
EventList.foldr
               Integer -> FilePath -> FilePath
MIDIFile.showTime
               (\T
e -> T -> FilePath -> FilePath
MIDIFile.showEvent T
e (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
showString FilePath
"\n")
               (FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"" (\FilePath
e -> FilePath
"incomplete track: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
e FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n") Maybe FilePath
me FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
str) Track
track)
        ByteList
contents
  pp (FilePath
ty,ByteList
contents) =
    FilePath -> FilePath -> FilePath
showString FilePath
"Alien Chunk: " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FilePath -> FilePath -> FilePath
showString FilePath
ty (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FilePath -> FilePath -> FilePath
showString FilePath
" " (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ByteList -> FilePath -> FilePath
forall a. Show a => a -> FilePath -> FilePath
shows ByteList
contents (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    FilePath -> FilePath -> FilePath
showString FilePath
"\n"


showMR :: Parser.Fragile (StreamParser.T StreamParser.ByteList) a -> (a->ShowS) -> ByteList -> ShowS
showMR :: Fragile (T ByteList) a
-> (a -> FilePath -> FilePath) -> ByteList -> FilePath -> FilePath
showMR Fragile (T ByteList) a
m a -> FilePath -> FilePath
pp ByteList
contents =
  let report :: T a
report = Fragile (T ByteList) a -> ByteList -> T a
forall str a. ByteStream str => Fragile (T str) a -> str -> T a
StreamParser.run Fragile (T ByteList) a
m (ByteList -> ByteList
StreamParser.ByteList ByteList
contents)
  in  [FilePath -> FilePath] -> FilePath -> FilePath
unlinesS ((FilePath -> FilePath -> FilePath)
-> [FilePath] -> [FilePath -> FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath -> FilePath
showString ([FilePath] -> [FilePath -> FilePath])
-> [FilePath] -> [FilePath -> FilePath]
forall a b. (a -> b) -> a -> b
$ T a -> [FilePath]
forall a. T a -> [FilePath]
Report.warnings T a
report) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (FilePath -> FilePath -> FilePath)
-> (a -> FilePath -> FilePath)
-> Either FilePath a
-> FilePath
-> FilePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> FilePath -> FilePath
showString a -> FilePath -> FilePath
pp (T a -> Either FilePath a
forall a. T a -> Either FilePath a
Report.result T a
report)



{- |
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.C parser => Parser.Partial parser [(String, ByteList)]
getChunks :: Partial parser [(FilePath, ByteList)]
getChunks =
   Fragile parser (FilePath, ByteList)
-> Partial parser [(FilePath, ByteList)]
forall (parser :: * -> *) a.
EndCheck parser =>
Fragile parser a -> Partial parser [a]
Parser.zeroOrMore (Fragile parser (FilePath, ByteList)
 -> Partial parser [(FilePath, ByteList)])
-> Fragile parser (FilePath, ByteList)
-> Partial parser [(FilePath, ByteList)]
forall a b. (a -> b) -> a -> b
$
      do (FilePath
typ, Integer
len) <- Fragile parser (FilePath, Integer)
forall (parser :: * -> *).
C parser =>
Fragile parser (FilePath, Integer)
getChunk
         ByteList
body <- [ExceptionalT FilePath parser Word8]
-> ExceptionalT FilePath parser ByteList
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Integer
-> ExceptionalT FilePath parser Word8
-> [ExceptionalT FilePath parser Word8]
forall i a. Integral i => i -> a -> [a]
genericReplicate Integer
len ExceptionalT FilePath parser Word8
forall (parser :: * -> *). C parser => Fragile parser Word8
getByte)
         (FilePath, ByteList) -> Fragile parser (FilePath, ByteList)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
typ, ByteList
body)