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
toSeekableFile :: FilePath -> MIDIFile.T -> IO ()
toSeekableFile :: FilePath -> T -> IO ()
toSeekableFile FilePath
fn =
FilePath -> SeekableFile -> IO ()
Writer.runSeekableFile FilePath
fn (SeekableFile -> IO ()) -> (T -> SeekableFile) -> T -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Uncompressed SeekableFile -> SeekableFile
forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus (T Uncompressed SeekableFile -> SeekableFile)
-> (T -> T Uncompressed SeekableFile) -> T -> SeekableFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T Uncompressed SeekableFile
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put
toFile :: FilePath -> MIDIFile.T -> IO ()
toFile :: FilePath -> T -> IO ()
toFile FilePath
fn T
mf = FilePath -> ByteList -> IO ()
writeBinaryFile FilePath
fn (T -> ByteList
toByteList T
mf)
toByteList :: MIDIFile.T -> ByteList
toByteList :: T -> ByteList
toByteList =
ByteList -> ByteList
Writer.runByteList (ByteList -> ByteList) -> (T -> ByteList) -> T -> ByteList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Uncompressed ByteList -> ByteList
forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus (T Uncompressed ByteList -> ByteList)
-> (T -> T Uncompressed ByteList) -> T -> ByteList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T Uncompressed ByteList
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put
toByteString :: MIDIFile.T -> B.ByteString
toByteString :: T -> ByteString
toByteString =
ByteString -> ByteString
Writer.runByteString (ByteString -> ByteString) -> (T -> ByteString) -> T -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Uncompressed ByteString -> ByteString
forall writer. Monoid writer => T Uncompressed writer -> writer
StatusWriter.toWriterWithoutStatus (T Uncompressed ByteString -> ByteString)
-> (T -> T Uncompressed ByteString) -> T -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T Uncompressed ByteString
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put
toCompressedByteString :: MIDIFile.T -> B.ByteString
toCompressedByteString :: T -> ByteString
toCompressedByteString =
ByteString -> ByteString
Writer.runByteString (ByteString -> ByteString) -> (T -> ByteString) -> T -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T Compressed ByteString -> ByteString
forall writer. Monoid writer => T Compressed writer -> writer
StatusWriter.toWriterWithStatus (T Compressed ByteString -> ByteString)
-> (T -> T Compressed ByteString) -> T -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T Compressed ByteString
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
put (T -> T Compressed ByteString)
-> (T -> T) -> T -> T Compressed ByteString
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 :: T -> T compress writer
put (MIDIFile.Cons Type
mft Division
divisn [Track]
trks) =
(FilePath -> T compress writer -> T compress writer
forall compress writer.
(Compression compress, C writer) =>
FilePath -> T compress writer -> T compress writer
putChunk FilePath
"MThd" (T compress writer -> T compress writer)
-> T compress writer -> T compress writer
forall a b. (a -> b) -> a -> b
$ writer -> T compress writer
forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (writer -> T compress writer) -> writer -> T compress writer
forall a b. (a -> b) -> a -> b
$
Int -> Int -> writer
forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 (Type -> Int
forall a. Enum a => a -> Int
fromEnum Type
mft) writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
Int -> Int -> writer
forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 ([Track] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Track]
trks) writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
Division -> writer
forall writer. C writer => Division -> writer
putDivision Division
divisn)
T compress writer -> T compress writer -> T compress writer
forall m. Monoid m => m -> m -> m
+#+ (Track -> T compress writer) -> [Track] -> T compress writer
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Track -> T compress writer
forall compress writer.
(Compression compress, C writer) =>
Track -> T compress writer
putTrack [Track]
trks
putDivision :: Writer.C writer => Division -> writer
putDivision :: Division -> writer
putDivision (Ticks Tempo
nticks) =
Int -> Int -> writer
forall writer. C writer => Int -> Int -> writer
Writer.putInt Int
2 (Tempo -> Int
forall a. T a -> a
NonNeg.toNumber Tempo
nticks)
putDivision (SMPTE Int
mode Int
nticks) =
Int -> writer
forall writer. C writer => Int -> writer
Writer.putIntAsByte (Int
256Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
mode) writer -> writer -> writer
forall m. Monoid m => m -> m -> m
+#+
Int -> writer
forall writer. C writer => Int -> writer
Writer.putIntAsByte Int
nticks
putTrack ::
(StatusWriter.Compression compress, Writer.C writer) =>
Track -> StatusWriter.T compress writer
putTrack :: Track -> T compress writer
putTrack Track
trk =
FilePath -> T compress writer -> T compress writer
forall compress writer.
(Compression compress, C writer) =>
FilePath -> T compress writer -> T compress writer
putChunk FilePath
"MTrk" (T compress writer -> T compress writer)
-> T compress writer -> T compress writer
forall a b. (a -> b) -> a -> b
$
(Integer -> T compress writer)
-> (T -> T compress writer) -> Track -> T compress writer
forall m time body.
Monoid m =>
(time -> m) -> (body -> m) -> T time body -> m
EventList.concatMapMonoid (writer -> T compress writer
forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (writer -> T compress writer)
-> (Integer -> writer) -> Integer -> T compress writer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> writer
forall writer. C writer => Integer -> writer
Writer.putVar) T -> T compress writer
forall compress writer.
(Compression compress, C writer) =>
T -> T compress writer
Event.put (Track -> T compress writer) -> Track -> T compress writer
forall a b. (a -> b) -> a -> b
$
Track -> Integer -> T -> Track
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 :: FilePath -> T compress writer -> T compress writer
putChunk FilePath
tag T compress writer
m =
writer -> T compress writer
forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
StatusWriter.lift (FilePath -> writer
forall writer. C writer => FilePath -> writer
putTag FilePath
tag) T compress writer -> T compress writer -> T compress writer
forall m. Monoid m => m -> m -> m
+#+
(T compress writer -> T compress writer
forall compress writer. T compress writer -> T compress writer
StatusWriter.Cons (T compress writer -> T compress writer)
-> T compress writer -> T compress writer
forall a b. (a -> b) -> a -> b
$ writer -> T compress writer
forall (t :: * -> *) m. (C t, Monoid m) => m -> t m
Trans.lift (writer -> T compress writer) -> writer -> T compress writer
forall a b. (a -> b) -> a -> b
$
Int -> writer -> writer
forall m. C m => Int -> m -> m
Writer.putLengthBlock Int
4 (writer -> writer) -> writer -> writer
forall a b. (a -> b) -> a -> b
$ T compress writer -> writer
forall compress writer.
(Compression compress, Monoid writer) =>
T compress writer -> writer
StatusWriter.toWriter T compress writer
m)
putTag :: Writer.C writer => String -> writer
putTag :: FilePath -> writer
putTag tag :: FilePath
tag@(Char
_:Char
_:Char
_:Char
_:[]) = FilePath -> writer
forall writer. C writer => FilePath -> writer
Writer.putStr FilePath
tag
putTag FilePath
tag =
FilePath -> writer
forall a. HasCallStack => FilePath -> a
error (FilePath
"SaveMIDI.putChunk: Chunk name " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
tag FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" does not consist of 4 characters.")