{- |
Save MIDI data to files.

The functions in this module allow 'Sound.MIDI.File.T's
to be written into Standard MIDI files (@*.mid@)
that can be read and played by music programs such as Cakewalk.
-}

module Sound.MIDI.File.Save
   (toSeekableFile, toFile, toByteList, toByteString,
    toCompressedByteString, ) where

import           Sound.MIDI.File
import qualified Sound.MIDI.File   as MIDIFile
import qualified Sound.MIDI.File.Event      as Event
import qualified Sound.MIDI.File.Event.Meta as MetaEvent
import qualified Data.EventList.Relative.TimeBody as EventList
import qualified Numeric.NonNegative.Wrapper as NonNeg

import qualified Sound.MIDI.Writer.Status as StatusWriter
import qualified Sound.MIDI.Writer.Basic  as Writer
import Sound.MIDI.Monoid ((+#+))

import qualified Data.Monoid.Transformer as Trans
import Data.Foldable (foldMap, )

import Sound.MIDI.IO (ByteList, writeBinaryFile, )

import qualified Data.ByteString.Lazy as B



{- |
Directly write to a file.
Since chunks lengths are not known before writing,
we need to seek in a file.
Thus you cannot write to pipes with this function.
-}
toSeekableFile :: FilePath {- ^ file name -} -> MIDIFile.T -> IO ()
toSeekableFile :: FilePath -> T -> IO ()
toSeekableFile FilePath
fn =
   FilePath -> SeekableFile -> IO ()
Writer.runSeekableFile FilePath
fn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put

{- |
The function 'toFile' is the main function
for writing 'MIDIFile.T' values to an actual file.
-}
toFile :: FilePath {- ^ file name -} -> MIDIFile.T -> IO ()
toFile :: FilePath -> T -> IO ()
toFile FilePath
fn T
mf = FilePath -> ByteList -> IO ()
writeBinaryFile FilePath
fn (T -> ByteList
toByteList T
mf)

{-
MIDI files are first converted to a monadic string computation
using the function 'put',
and then \"executed\" using 'execWriter'.
-}

{- |
Convert a MIDI file to a 'ByteList'.
-}
toByteList :: MIDIFile.T -> ByteList
toByteList :: T -> ByteList
toByteList =
   ByteList -> ByteList
Writer.runByteList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put

{- |
Convert a MIDI file to a lazy 'B.ByteString'.
-}
toByteString :: MIDIFile.T -> B.ByteString
toByteString :: T -> ByteString
toByteString =
   ByteString -> ByteString
Writer.runByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put

{- |
Convert a MIDI file to a lazy 'B.ByteString'.
It converts @NoteOff p 64@ to @NoteOn p 0@
and then uses the running MIDI status in order to compress the file.
-}
toCompressedByteString :: MIDIFile.T -> B.ByteString
toCompressedByteString :: T -> ByteString
toCompressedByteString =
   ByteString -> ByteString
Writer.runByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall writer. Monoid writer => T Compressed writer -> writer
StatusWriter.toWriterWithStatus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   T -> T
MIDIFile.implicitNoteOff




put ::
   (StatusWriter.Compression compress, Writer.C writer) =>
   MIDIFile.T -> StatusWriter.T compress writer
put :: forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put (MIDIFile.Cons Type
mft Division
divisn [Track]
trks) =
   (forall compress writer.
(Compression compress, C writer) =>
FilePath -> T compress writer -> T compress writer
putChunk FilePath
"MThd" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift forall a b. (a -> b) -> a -> b
$
      forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 (forall a. Enum a => a -> Int
fromEnum Type
mft) forall m. Monoid m => m -> m -> m
+#+ -- format (type 0, 1 or 2)
      forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Track]
trks)  forall m. Monoid m => m -> m -> m
+#+ -- number of tracks to come
      forall writer. C writer => Division -> writer
putDivision Division
divisn)                 -- time unit
   forall m. Monoid m => m -> m -> m
+#+ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall compress writer.
(Compression compress, C writer) =>
Track -> T compress writer
putTrack [Track]
trks

putDivision :: Writer.C writer => Division -> writer
putDivision :: forall writer. C writer => Division -> writer
putDivision (Ticks Tempo
nticks) =
   forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 (forall a. T a -> a
NonNeg.toNumber Tempo
nticks)
putDivision (SMPTE Int
mode Int
nticks) =
   forall writer. C writer => Int -> writer
Writer.putIntAsByte (Int
256forall a. Num a => a -> a -> a
-Int
mode) forall m. Monoid m => m -> m -> m
+#+
   forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
nticks

putTrack ::
   (StatusWriter.Compression compress, Writer.C writer) =>
   Track -> StatusWriter.T compress writer
putTrack :: forall compress writer.
(Compression compress, C writer) =>
Track -> T compress writer
putTrack Track
trk =
   forall compress writer.
(Compression compress, C writer) =>
FilePath -> T compress writer -> T compress writer
putChunk FilePath
"MTrk" forall a b. (a -> b) -> a -> b
$
   forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
EventList.concatMapMonoid (forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall writer. C writer => Integer -> writer
Writer.putVar) forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
Event.put forall a b. (a -> b) -> a -> b
$
   forall time body. T time body -> time -> body -> T time body
EventList.snoc Track
trk Integer
0 (T -> T
Event.MetaEvent T
MetaEvent.EndOfTrack)



putChunk ::
   (StatusWriter.Compression compress, Writer.C writer) =>
   String -> StatusWriter.T compress writer -> StatusWriter.T compress writer
putChunk :: forall compress writer.
(Compression compress, C writer) =>
FilePath -> T compress writer -> T compress writer
putChunk FilePath
tag T compress writer
m =
   forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (forall writer. C writer => FilePath -> writer
putTag FilePath
tag) forall m. Monoid m => m -> m -> m
+#+
   (forall compress writer. T compress writer -> T compress writer
StatusWriter.Cons forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
Trans.lift forall a b. (a -> b) -> a -> b
$
    forall m. C m => Int -> m -> m
Writer.putLengthBlock Int
4 forall a b. (a -> b) -> a -> b
$ forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
StatusWriter.toWriter T compress writer
m)


putTag :: Writer.C writer => String -> writer
putTag :: forall writer. C writer => FilePath -> writer
putTag tag :: FilePath
tag@(Char
_:Char
_:Char
_:Char
_:[]) = forall writer. C writer => FilePath -> writer
Writer.putStr FilePath
tag
putTag FilePath
tag =
   forall a. HasCallStack => FilePath -> a
error (FilePath
"SaveMIDI.putChunk: Chunk name " forall a. [a] -> [a] -> [a]
++ FilePath
tag forall a. [a] -> [a] -> [a]
++
          FilePath
" does not consist of 4 characters.")