diff --git a/midi.cabal b/midi.cabal --- a/midi.cabal +++ b/midi.cabal @@ -1,5 +1,5 @@ Name: midi -Version: 0.2.1.4 +Version: 0.2.1.5 License: GPL License-File: LICENSE Author: Henning Thielemann @@ -30,7 +30,7 @@ Source-Repository this type: darcs location: http://hub.darcs.net/thielema/midi/ - tag: 0.2.1.4 + tag: 0.2.1.5 Flag splitBase description: Choose the new smaller, split-up base package. diff --git a/parser/Sound/MIDI/Parser/Exception.hs b/parser/Sound/MIDI/Parser/Exception.hs --- a/parser/Sound/MIDI/Parser/Exception.hs +++ b/parser/Sound/MIDI/Parser/Exception.hs @@ -4,7 +4,6 @@ module Sound.MIDI.Parser.Exception where import qualified Sound.MIDI.Parser.Report as Report --- import qualified Sound.MIDI.Parser.Warning as Warning import qualified Control.Monad.Exception.Synchronous as Sync diff --git a/parser/Sound/MIDI/Parser/Stream.hs b/parser/Sound/MIDI/Parser/Stream.hs --- a/parser/Sound/MIDI/Parser/Stream.hs +++ b/parser/Sound/MIDI/Parser/Stream.hs @@ -16,8 +16,6 @@ import qualified Sound.MIDI.Parser.Exception as Exception import qualified Sound.MIDI.Parser.Warning as Warning --- import qualified Control.Monad.Exception.Synchronous as Sync - import qualified Sound.MIDI.IO as MIO import Data.Word (Word8) diff --git a/src/Sound/MIDI/Example/ControllerRamp.hs b/src/Sound/MIDI/Example/ControllerRamp.hs --- a/src/Sound/MIDI/Example/ControllerRamp.hs +++ b/src/Sound/MIDI/Example/ControllerRamp.hs @@ -3,20 +3,14 @@ import qualified Sound.MIDI.File as MidiFile import qualified Sound.MIDI.File.Save as Save --- import qualified Sound.MIDI.File.Event.Meta as MetaEvent import qualified Sound.MIDI.File.Event as Event import qualified Sound.MIDI.Message.Channel as ChannelMsg import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg --- import qualified Sound.MIDI.Parser.Report as Report - import qualified Data.EventList.Relative.TimeBody as EventList --- import Data.EventList.Relative.MixedBody ((/.), (./), ) import qualified Data.ByteString.Lazy as B - --- import qualified Numeric.NonNegative.Wrapper as NonNeg diff --git a/src/Sound/MIDI/Example/Tomatosalad.hs b/src/Sound/MIDI/Example/Tomatosalad.hs --- a/src/Sound/MIDI/Example/Tomatosalad.hs +++ b/src/Sound/MIDI/Example/Tomatosalad.hs @@ -14,18 +14,12 @@ import qualified Sound.MIDI.Message.Channel as ChannelMsg import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg --- import qualified Sound.MIDI.Parser.Report as Report - import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Relative.BodyTime as EventListBT import qualified Data.EventList.Relative.MixedTime as EventListMT import qualified Data.EventList.Relative.TimeBody as EventList --- import Data.EventList.Relative.MixedBody ((/.), (./), ) import qualified Data.ByteString.Lazy as B - --- import qualified Numeric.NonNegative.Wrapper as NonNeg - import Data.Tuple.HT (mapFst, ) import qualified Control.Monad.Trans.State as State diff --git a/src/Sound/MIDI/File.hs b/src/Sound/MIDI/File.hs --- a/src/Sound/MIDI/File.hs +++ b/src/Sound/MIDI/File.hs @@ -37,7 +37,6 @@ import qualified Control.Monad.Trans.State as MS import Control.Monad (liftM, liftM2, ) --- import Sound.MIDI.IO(ByteList) import Sound.MIDI.String (rightS, ) import Data.Ratio((%)) diff --git a/src/Sound/MIDI/File/Event.hs b/src/Sound/MIDI/File/Event.hs --- a/src/Sound/MIDI/File/Event.hs +++ b/src/Sound/MIDI/File/Event.hs @@ -112,6 +112,6 @@ put :: Writer.C writer => T -> StatusWriter.T writer put e = case e of - MIDIEvent m -> StatusWriter.lift (ChannelMsg.put m) + MIDIEvent m -> ChannelMsg.putWithStatus m MetaEvent m -> StatusWriter.clear +#+ StatusWriter.lift (MetaEvent.put m) SystemExclusive m -> StatusWriter.clear +#+ StatusWriter.lift (SysEx.put m) diff --git a/src/Sound/MIDI/File/Load.hs b/src/Sound/MIDI/File/Load.hs --- a/src/Sound/MIDI/File/Load.hs +++ b/src/Sound/MIDI/File/Load.hs @@ -12,10 +12,10 @@ 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 +module Sound.MIDI.File.Load ( + fromFile, fromByteList, maybeFromByteList, maybeFromByteString, + showFile, + ) where import Sound.MIDI.File import qualified Sound.MIDI.File as MIDIFile @@ -26,7 +26,6 @@ import qualified Numeric.NonNegative.Wrapper as NonNeg import Sound.MIDI.IO (ByteList, readBinaryFile, ) --- import qualified Sound.MIDI.Bit as Bit import Sound.MIDI.String (unlinesS) import Sound.MIDI.Parser.Primitive import qualified Sound.MIDI.Parser.Class as Parser @@ -42,8 +41,6 @@ import qualified Data.ByteString.Lazy as B import qualified Control.Monad.Exception.Asynchronous as Async --- import qualified Control.Monad.Exception.Synchronous as Sync --- import System.IO (hPutStrLn, stderr, ) import Data.List (genericReplicate, genericLength, ) import Data.Maybe (catMaybes, ) diff --git a/src/Sound/MIDI/Message/System.hs b/src/Sound/MIDI/Message/System.hs --- a/src/Sound/MIDI/Message/System.hs +++ b/src/Sound/MIDI/Message/System.hs @@ -9,7 +9,6 @@ import qualified Sound.MIDI.Message.System.Common as Common import qualified Sound.MIDI.Message.System.RealTime as RealTime --- import Sound.MIDI.Parser.Primitive import qualified Sound.MIDI.Parser.Class as Parser import qualified Sound.MIDI.Writer.Basic as Writer diff --git a/src/Sound/MIDI/Message/System/RealTime.hs b/src/Sound/MIDI/Message/System/RealTime.hs --- a/src/Sound/MIDI/Message/System/RealTime.hs +++ b/src/Sound/MIDI/Message/System/RealTime.hs @@ -5,7 +5,6 @@ T(..), get, put, ) where --- import Sound.MIDI.Parser.Primitive import qualified Sound.MIDI.Parser.Class as Parser import qualified Sound.MIDI.Writer.Basic as Writer diff --git a/src/Sound/MIDI/Parser/ByteString.hs b/src/Sound/MIDI/Parser/ByteString.hs --- a/src/Sound/MIDI/Parser/ByteString.hs +++ b/src/Sound/MIDI/Parser/ByteString.hs @@ -21,10 +21,6 @@ import qualified Sound.MIDI.Parser.Exception as Exception import qualified Sound.MIDI.Parser.Warning as Warning --- import qualified Control.Monad.Exception.Synchronous as Sync - --- import Data.Word (Word8) - import Data.Int (Int64) import qualified Numeric.NonNegative.Wrapper as NonNeg diff --git a/src/Sound/MIDI/Parser/Status.hs b/src/Sound/MIDI/Parser/Status.hs --- a/src/Sound/MIDI/Parser/Status.hs +++ b/src/Sound/MIDI/Parser/Status.hs @@ -52,7 +52,7 @@ This definition should be in Message.Channel, but this results in a cyclic import. -} -newtype Channel = Channel {fromChannel :: Int} deriving (Show, Eq, Ord, Ix) +newtype Channel = Channel {fromChannel :: Int} deriving (Show, Eq, Ord, Ix) toChannel :: Int -> Channel toChannel = checkRange "Channel" Channel diff --git a/src/Sound/MIDI/Writer/Basic.hs b/src/Sound/MIDI/Writer/Basic.hs --- a/src/Sound/MIDI/Writer/Basic.hs +++ b/src/Sound/MIDI/Writer/Basic.hs @@ -26,7 +26,6 @@ import Control.Exception (bracket, ) import qualified System.IO as IO import System.IO (openBinaryFile, hClose, hPutChar, Handle, IOMode(WriteMode)) --- import System.IO.Error (ioError, userError) import Prelude hiding (putStr, ) @@ -69,8 +68,7 @@ -newtype ByteString = - ByteString {unByteString :: Builder} +newtype ByteString = ByteString {unByteString :: Builder} instance Monoid ByteString where mempty = ByteString $ mempty @@ -95,8 +93,7 @@ -newtype SeekableFile = - SeekableFile {unSeekableFile :: ReaderT Handle IO ()} +newtype SeekableFile = SeekableFile {unSeekableFile :: ReaderT Handle IO ()} instance Monoid SeekableFile where mempty = SeekableFile $ return () diff --git a/src/Sound/MIDI/Writer/Status.hs b/src/Sound/MIDI/Writer/Status.hs --- a/src/Sound/MIDI/Writer/Status.hs +++ b/src/Sound/MIDI/Writer/Status.hs @@ -3,8 +3,6 @@ lift, ) where --- import qualified Sound.MIDI.Writer.Basic as Writer - import Sound.MIDI.Parser.Status (Channel) import qualified Data.Monoid.State as State diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -12,7 +12,9 @@ import qualified Sound.MIDI.File as MidiFile import qualified Sound.MIDI.File.Load as Load import qualified Sound.MIDI.File.Save as Save +import qualified Sound.MIDI.File.Event as Event +import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg import qualified Sound.MIDI.Parser.Report as Report import qualified Data.EventList.Relative.TimeBody as EventList @@ -22,13 +24,12 @@ import qualified Data.List.HT as ListHT import qualified Data.List.Match as Match import Data.Int (Int64, ) +import Data.Bool.HT (implies, ) import Control.Monad (when, ) --- import Debug.Trace (trace) - testMidiName :: FilePath testMidiName = "quickcheck-test.mid" @@ -45,7 +46,7 @@ -- provoke a test failure in order to see some examples of Arbitrary MIDI files checkArbitrary :: MidiFile.T -> Bool checkArbitrary (MidiFile.Cons _typ _division tracks) = - length (EventList.toPairList (EventList.concat tracks)) < 10 + all ((< 10) . length . EventList.toPairList) tracks saveLoadByteString :: MidiFile.T -> Bool @@ -62,6 +63,48 @@ report = Report.Cons [] (Right (MidiFile.implicitNoteOff midi)) in struct == report +compressionShortens :: MidiFile.T -> Bool +compressionShortens midi = + B.length (Save.toByteString midi) + >= + B.length (Save.toCompressedByteString midi) + + +{- +This does not cover all cases of possible running status compression, +but the most common ones. +-} +equalStatus :: Event.T -> Event.T -> Bool +equalStatus x y = + case (Event.maybeVoice x, Event.maybeVoice y) of + (Just (ch0, ev0), Just (ch1, ev1)) -> + ch0 == ch1 + && + case (ev0, ev1) of + (VoiceMsg.Control _ _, VoiceMsg.Control _ _) -> True + _ -> + VoiceMsg.isNoteOn ev0 && VoiceMsg.isNoteOn ev1 + || + VoiceMsg.isNoteOff ev0 && VoiceMsg.isNoteOff ev1 + _ -> False + +{- +You may test manually with Example.status +which is definitely compressible. +-} +compressible :: MidiFile.T -> Bool +compressible = + any (or . ListHT.mapAdjacent equalStatus . EventList.getBodies) . + MidiFile.getTracks + +compressionStrictlyShortens :: MidiFile.T -> Bool +compressionStrictlyShortens midi = + compressible midi + `implies` + B.length (Save.toByteString midi) + > + B.length (Save.toCompressedByteString midi) + saveLoadMaybeByteList :: MidiFile.T -> Bool saveLoadMaybeByteList midi = let bin = Save.toByteList midi @@ -94,7 +137,7 @@ let bin0 = Save.toCompressedByteString midi0 in case Load.maybeFromByteString bin0 of Report.Cons [] (Right midi1) -> - bin0 == Save.toByteString midi1 + bin0 == Save.toCompressedByteString midi1 _ -> False loadSaveByteList :: MidiFile.T -> Bool @@ -203,6 +246,9 @@ check "loadSaveByteString" loadSaveByteString check "loadSaveCompressedByteString" loadSaveCompressedByteString check "loadSaveByteList" loadSaveByteList + + check "compressionShortens" compressionShortens + check "compressionStrictlyShortens" compressionStrictlyShortens check "restrictionByteList" restrictionByteList