zmidi-core 0.5.0 → 0.6.0

raw patch · 10 files changed

+336/−87 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +16/−0
• src/ZMidi/Core.hs +3/−1
• src/ZMidi/Core/Canonical.hs +55/−0
• src/ZMidi/Core/Datatypes.hs +39/−16
• src/ZMidi/Core/Internal/ParserMonad.hs +71/−14
• src/ZMidi/Core/Pretty.hs +34/−14
• src/ZMidi/Core/ReadFile.hs +67/−18
• src/ZMidi/Core/VersionNumber.hs +2/−2
• src/ZMidi/Core/WriteFile.hs +31/−20
• zmidi-core.cabal +18/−2

@@ -1,4 +1,20 @@ +0.5.0 to 0.6.0:+  +  * Extended the parser and changed the syntax tree to interpret +    MIDI Running Status. +   +  * Added a module @ZMidi.Core.Canonical@ to translate MidiFiles+    to a canonical form where any shorthand NoteOff introduced by +    Running Status is expanded to regular NoteOn and NoteOff +    events (with Running Status set, MidiFiles can signal NoteOff +    events as another NoteOn with 0 channel velocity).+  +  * Added a hack to the pretty printer to stop printing ASCII+    chars greater than 164 causing an error when printing to +    stdout.+  + 0.4.0 to 0.5.0:    * Changed order of @MidiVoiceEnvent@ constructors so the Ord 

@@ -21,7 +21,8 @@  module ZMidi.Core   (-    module ZMidi.Core.Datatypes+    module ZMidi.Core.Canonical+  , module ZMidi.Core.Datatypes   , module ZMidi.Core.Pretty   , module ZMidi.Core.ReadFile   , module ZMidi.Core.VersionNumber@@ -30,6 +31,7 @@        ) where +import ZMidi.Core.Canonical import ZMidi.Core.Datatypes import ZMidi.Core.Pretty import ZMidi.Core.ReadFile

@@ -0,0 +1,55 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  ZMidi.Core.Canonical+-- Copyright   :  (c) Stephen Tetley 2012+-- License     :  BSD3+--+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>+-- Stability   :  unstable+-- Portability :  GHC (at least generalized newtype deriving)+--+-- Convert a MidiFile into \"canonical\" form - i.e. expand +-- any use of Running Status and translate Running Status high, +-- NoteOn channel velocity 0 events to NoteOff events.+--+--------------------------------------------------------------------------------+++module ZMidi.Core.Canonical+  (+++    canonical    ++  ) where++import ZMidi.Core.Datatypes++-- | Convert an MidiFile into \"canonical\" form where any +-- abbreviation introduced by Running Status is expanded.+--+-- Note - even with Running Status on the syntax tree is almost +-- canonical (some expansion takes place in the Parser), so this+-- translation is quite simplistic.+--+canonical :: MidiFile -> MidiFile+canonical (MidiFile hdr trks) = MidiFile hdr (map transTrack trks)++transTrack :: MidiTrack -> MidiTrack+transTrack (MidiTrack msgs) = MidiTrack $ map transMsg msgs++transMsg :: MidiMessage -> MidiMessage+transMsg (dt,e) = (dt, transEvent e)++transEvent :: MidiEvent -> MidiEvent+transEvent (VoiceEvent rs e) = VoiceEvent RS_OFF (transVoiceEvent rs e)+transEvent evt               = evt+++transVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> MidiVoiceEvent+transVoiceEvent RS_ON (NoteOn ch pch 0) = NoteOff ch pch 0+transVoiceEvent _     evt               = evt+

@@ -14,8 +14,8 @@ -- Concrete syntax tree for MIDI files. -- -- Values are sometimes not interpreted. This means that the--- the data types do not fully represent the sematics of the --- data, but all the data is either stored within the data type +-- the data types do not fully represent the sematics of MIDI +-- events, but all the data is either stored within the data type  -- or synthesizeable. Hence, @ readFile >>= writeFile @ will  -- produce an identical binary \[1\].  --@@ -34,10 +34,11 @@   , MidiHeader(..)     , MidiTrack(..)   , MidiFormat(..)+  , MidiRunningStatus(..)   , MidiMessage   , MidiEvent(..) -  , MidiDataEvent(..)+  , MidiDataOther(..)   , MidiVoiceEvent(..)   , MidiSysExEvent(..)   , MidiSysCommonEvent(..)@@ -149,27 +150,45 @@ type MidiMessage = (DeltaTime, MidiEvent)  --- Note, the Ord instance for pairs is very useful for rendering.--- When we have have a NoteOn and a NoteOff on the same channel at the --- same time we want the NoteOff played first. An ordinary sort will --- give us this.-      +-- | Running Status.+--+-- MIDI allows a compact representation of voice events where+-- consecutive events (same event, same channel) only need to+-- include the first event-channel byte - subsequent events +-- only send payload until the next event or channel change.+--+-- Including @MidiRunningStatus@ in the data representation is +-- important for ZMidi as an aim is to allow round-tripping+-- of exisiting MIDI files. However it makes MIDI generation+-- more complicated (there is more scope to generate bad +-- output) - if you are only generating MIDI it is wise to always +-- set @MidiRunningStatus@ to @RS_OFF@.+-- +data MidiRunningStatus = RS_ON | RS_OFF+  deriving (Enum,Eq,Ord,Show)  --- | Recognised event types - some types ('DataEvent' and +-- | Recognised event types - some types ('MidiEventOther' and  -- 'SysEx') are not interpreted. -- data MidiEvent -    -- | Data event - just initial tag byte, -    -- uninterpreted+    -- | An unrecognized event. This event is not expected in +    -- well formed MIDI, but the parser may insert it - if it +    -- encounters ill-formed data.     ---    = DataEvent         MidiDataEvent+    = MidiEventOther   MidiDataOther -    -- | Voice event (e.g @note-on@, @note-off@) are relayed to specific-    -- channels.+    -- | Voice event (e.g @note-on@, @note-off@) are relayed to +    -- specific channels. +    -- +    -- Note - they are tagged with Running Status, this is +    -- pertinent to parsing MIDI where a input stream may use +    -- running status to save space. If you are generating MIDI+    -- use RunningStatus with caution and ensure that consecutive+    -- events are all of the same sort.     ---    | VoiceEvent        MidiVoiceEvent+    | VoiceEvent        MidiRunningStatus MidiVoiceEvent       -- | SysEx - system exclusive event. Usually synthesizer @@ -196,14 +215,16 @@    deriving (Eq,Show,Ord) + -- | Data events are events with tags from 0x00 to 0x7F.  --  -- Data events have no payload - they are represented only by the -- tag byte.   ---newtype MidiDataEvent = MidiDataEvent { getTagByte :: TagByte }+newtype MidiDataOther = MidiDataOther { getMidiDataOther :: TagByte }   deriving (Eq,Ord,Show) + -- | Voice events control the output of the synthesizer. -- -- Note - change in v0.5.0 - the constructors have been reordered@@ -281,6 +302,8 @@     -- NOTE - currently value is uninterpreted.     --     | PitchBend           Word8 Word16++   deriving (Eq,Show,Ord)  -- | \SysEx\ - system exclusive event. 

@@ -17,12 +17,19 @@ module ZMidi.Core.Internal.ParserMonad   ( -    ErrMsg++    RS_VoiceEvent(..)+  , ErrMsg   , Pos   , ParseErr(..)   , ParserM   , runParser-  ++  , getRunningEvent+  , setRunningEvent++  , peek+  , dropW8   , word8   , int8 @@ -43,6 +50,7 @@    ) where + import Control.Applicative import Data.Bits import qualified Data.ByteString.Lazy as L@@ -50,6 +58,18 @@ import Data.Int import Data.Word +-- | Status is either OFF of the previous VoiceEvent * Channel.+--+data RS_VoiceEvent = RS_STATUS_OFF+                   | RS_NOTE_OFF    !Word8+                   | RS_NOTE_ON     !Word8+                   | RS_NOTE_AFT    !Word8+                   | RS_CONTROL     !Word8+                   | RS_PROG_CHANGE !Word8+                   | RS_CHAN_AFT    !Word8+                   | RS_PCH_BEND    !Word8+  deriving (Eq,Show)                 + -- | Position of the parser in the input stream. --  -- This is exposed by the ReadFile API and may be useful for @@ -58,10 +78,12 @@ type Pos = Int  data ParserState = ParserState -       { pos       :: !Pos-       , input     :: L.ByteString +       { pos                    :: !Pos+       , running_status         :: !RS_VoiceEvent+       , input                  :: !L.ByteString         } + -- | Error message - alias for String. -- type ErrMsg = String@@ -96,24 +118,58 @@                                 Left e -> (Left e, s')                                 Right a -> (getParserM . k) a s' + -- | Run the parser. -- runParser :: L.ByteString -> ParserM a -> Either ParseErr a-runParser bs mf = fst $ getParserM mf (ParserState { pos = 0, input = bs})+runParser bs mf = +    fst $ getParserM mf state_zero +  where+    -- seed the initial state with an unmatchable event+    state_zero = ParserState { pos = 0+                             , running_status = RS_STATUS_OFF+                             , input = bs }  +-- | Get the Running Status flag and channel.+--+getRunningEvent :: ParserM RS_VoiceEvent+getRunningEvent = ParserM $ \s -> (Right $ running_status s, s)++-- | Set the Running Status flag and channel.+--+setRunningEvent :: RS_VoiceEvent -> ParserM ()+setRunningEvent rs = ParserM $ \s -> (Right (), s { running_status = rs })++ -- | Get current Pos. -- getPos :: ParserM Int getPos = ParserM $ \s -> (Right $ pos s, s) ++-- | Peek a Word8.+--+peek :: ParserM Word8+peek = ParserM $ \s@(ParserState n rs bs) -> case L.uncons bs of +    Nothing      -> (Left (ParseErr n "peek - no more data."), s)+    Just (a,_)   -> (Right a, ParserState n rs bs)+++-- | Drop a Word8.+--+dropW8 :: ParserM ()+dropW8 = ParserM $ \s@(ParserState n rs bs) -> case L.uncons bs of +    Nothing      -> (Left (ParseErr n "dropW8 - no more data."), s)+    Just (_,bs') -> (Right (), ParserState (n+1) rs bs')++ -- | Parse a Word8. -- word8 :: ParserM Word8-word8 = ParserM $ \s@(ParserState n bs) -> case L.uncons bs of +word8 = ParserM $ \s@(ParserState n rs bs) -> case L.uncons bs of      Nothing      -> (Left (ParseErr n "word8 - no more data."), s)-    Just (a,bs') -> (Right a, ParserState (n+1) bs')-+    Just (a,bs') -> (Right a, ParserState (n+1) rs bs')   -- | Parse an Int8.@@ -121,26 +177,27 @@ int8 :: ParserM Int8 int8 = fromIntegral <$> word8 + -- | Parse a Word16 (big-endian). -- word16be :: ParserM Word16-word16be = ParserM $ \s@(ParserState n bs) -> case uncons2 bs of+word16be = ParserM $ \s@(ParserState n rs bs) -> case uncons2 bs of     Nothing -> (Left (ParseErr n "word16be - no more data."), s)-    Just (a,b,bs') -> (Right $ w16be a b, ParserState (n+2) bs')+    Just (a,b,bs') -> (Right $ w16be a b, ParserState (n+2) rs bs')  -- | Parse a Word24 (big-endian). -- word24be :: ParserM Word32-word24be = ParserM $ \s@(ParserState n bs) -> case uncons3 bs of+word24be = ParserM $ \s@(ParserState n rs bs) -> case uncons3 bs of     Nothing -> (Left (ParseErr n "word24be - no more data."), s)-    Just (a,b,c,bs') -> (Right $ w24be a b c, ParserState (n+3) bs')+    Just (a,b,c,bs') -> (Right $ w24be a b c, ParserState (n+3) rs bs')  -- | Parse a Word32 (big-endian). -- word32be :: ParserM Word32-word32be = ParserM $ \s@(ParserState n bs) -> case uncons4 bs of+word32be = ParserM $ \s@(ParserState n rs bs) -> case uncons4 bs of     Nothing -> (Left (ParseErr n "word32be - no more data."), s)-    Just (a,b,c,d,bs') -> (Right $ w32be a b c d, ParserState (n+4) bs')+    Just (a,b,c,d,bs') -> (Right $ w32be a b c d, ParserState (n+4) rs bs')  -- | Parse a Char. --

@@ -34,6 +34,7 @@ import ZMidi.Core.Datatypes import ZMidi.Core.Internal.SimpleFormat +import Data.Char import Data.List import Data.Monoid import Data.Word@@ -108,8 +109,8 @@     dtime   = padl 6  (integral delta)  ppEvent :: MidiEvent -> Doc-ppEvent (DataEvent e)         = ppDataEvent e-ppEvent (VoiceEvent e)        = ppVoiceEvent e+ppEvent (MidiEventOther e)    = ppMidiDataOther e+ppEvent (VoiceEvent rs e)     = ppVoiceEvent rs e ppEvent (SysExEvent e)        = ppSysExEvent e ppEvent (SysCommonEvent e)    = ppSysCommonEvent e ppEvent (SysRealTimeEvent e)  = ppSysRealTimeEvent e@@ -119,29 +120,35 @@ event :: String -> Doc -> Doc event s d = padr 18 (text s) `dashsep` d -ppDataEvent :: MidiDataEvent -> Doc-ppDataEvent (MidiDataEvent tag)     = event "data" (hex2 tag)+ppMidiDataOther :: MidiDataOther -> Doc+ppMidiDataOther (MidiDataOther n)     = event "midi data other" (hex2 n) -ppVoiceEvent :: MidiVoiceEvent -> Doc-ppVoiceEvent (Controller c n v)     = ++-- | Voice event needs RunningStatus...++ppVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> Doc+ppVoiceEvent _  (Controller c n v)     =      event "controller" (hex2 c `sep` hex2 n `sep` hex2 v) -ppVoiceEvent (ProgramChange c n)    = +ppVoiceEvent _  (ProgramChange c n)    =      event "program-change" (hex2 c `sep` hex2 n) -ppVoiceEvent (NoteOff c n v)        =+ppVoiceEvent _ (NoteOff c n v)        =     event "note-off" (hex2 c `sep` hex2 n `sep` hex2 v) -ppVoiceEvent (NoteOn c n v)         = -    event "note-on" (hex2 c `sep` hex2 n `sep` hex2 v)+ppVoiceEvent rs (NoteOn c n v)         +    | rs == RS_ON && v == 0 = event "note-off (RS,V0)" +                                    (hex2 c `sep` hex2 n `sep` hex2 v)+    | otherwise = event "note-on" (hex2 c `sep` hex2 n `sep` hex2 v) -ppVoiceEvent (NoteAftertouch c n v) =++ppVoiceEvent _  (NoteAftertouch c n v) =     event "note-aftertouch" (hex2 c `sep` hex2 n `sep` hex2 v) -ppVoiceEvent (ChanAftertouch c v)   = +ppVoiceEvent _  (ChanAftertouch c v)   =      event "channel-aftertouch" (hex2 c `sep` hex2 v) -ppVoiceEvent (PitchBend c v)        =+ppVoiceEvent _  (PitchBend c v)        =     event "pitch-bend" (hex2 c `sep` hex4 v)  @@ -179,7 +186,7 @@   ppMetaEvent :: MidiMetaEvent -> Doc-ppMetaEvent (TextEvent ty s)          = event (textType ty) (text s)+ppMetaEvent (TextEvent ty s)          = event (textType ty) (text $ safeString s)  ppMetaEvent (SequenceNumber w)        = event "sequence-number" (hex4 w) @@ -226,3 +233,16 @@ ppScale (MAJOR)         = text "major" ppScale (MINOR)         = text "minor" ppScale (SCALE_OTHER i) = text "unrecognized scale" `sep` hex2 i+++-- | This is a temporary hack - characters above ASCII 163+-- cause an (invalid character) error when written to stdout.+--+-- Make the string safe.+--+safeString :: String -> String+safeString = map (f . ord) +  where+    f i | i < 164   = chr i+        | otherwise = '#'+

@@ -16,6 +16,14 @@ -- (i.e all cases of event types are fully enumerated).  -- Malformed input (syntactically bad events, or truncated data)  -- will cause fatal parse errors.+-- +-- Note - the parser returns a /literal/ result if the input +-- uses Running Status, i.e, - the answer matches the input - +-- where running status uses a NoteOn event with velocity 0 to +-- stand for a NoteOff, the parser likewise returns a Note-On. +-- Use the @ZMidi.Core.Canonical@ to translate the input to +-- canonical form where note-offs are encoded directly with +-- NoteOff. -- -------------------------------------------------------------------------------- @@ -96,18 +104,16 @@ -- can cause fatal parse errors. -- event :: ParserM MidiEvent-event = word8 >>= step+event = peek >>= step   where     -- 00..7f  -- /data/-    step n | n == 0xFF  = MetaEvent        <$> (word8 >>= metaEvent)-           | n >= 0xF8  = SysRealTimeEvent <$> sysRealTimeEvent n-           | n >= 0xF1  = SysCommonEvent   <$> sysCommonEvent n-           | n == 0xF0  = SysExEvent       <$> sysExEvent-           | n >= 0x80  = VoiceEvent       <$> voiceEvent (splitByte n)-           | otherwise  = DataEvent        <$> dataEvent n--dataEvent :: Word8 -> ParserM MidiDataEvent-dataEvent tag = pure $ MidiDataEvent tag+    step n +      | n == 0xFF  = MetaEvent         <$> (dropW8 *> (word8 >>= metaEvent))+      | n >= 0xF8  = SysRealTimeEvent  <$> (dropW8 *> sysRealTimeEvent n)+      | n >= 0xF1  = SysCommonEvent    <$> (dropW8 *> sysCommonEvent n)+      | n == 0xF0  = SysExEvent        <$> (dropW8 *> sysExEvent)+      | n >= 0x80  = VoiceEvent RS_OFF <$> (dropW8 *> voiceEvent (splitByte n))+      | otherwise  = getRunningEvent >>= runningStatus      @@ -118,31 +124,74 @@ -- voiceEvent :: SplitByte -> ParserM MidiVoiceEvent voiceEvent (SB 0x80 ch)  = -    "note-off"          <??> (NoteOff ch)        <$> word8 <*> word8+    setRunningEvent (RS_NOTE_OFF ch)    >> noteOff ch  voiceEvent (SB 0x90 ch)  = -    "note-on"           <??> (NoteOn ch)         <$> word8 <*> word8+    setRunningEvent (RS_NOTE_ON ch)     >> noteOn ch  voiceEvent (SB 0xA0 ch)  = -    "note aftertouch"   <??> (NoteAftertouch ch) <$> word8 <*> word8-    +    setRunningEvent (RS_NOTE_AFT ch)    >> noteAftertouch ch+ voiceEvent (SB 0xB0 ch)  = -    "controller"        <??> (Controller ch)     <$> word8 <*> word8+    setRunningEvent (RS_CONTROL ch)     >> controller ch  voiceEvent (SB 0xC0 ch)  = -    "program change"    <??> (ProgramChange ch)  <$> word8 +    setRunningEvent (RS_PROG_CHANGE ch) >> programChange ch  voiceEvent (SB 0xD0 ch)  = -    "chan aftertouch"   <??> (ChanAftertouch ch) <$> word8 +    setRunningEvent (RS_CHAN_AFT ch)    >> chanAftertouch ch  voiceEvent (SB 0xE0 ch)  = -    "pitch bend"        <??> (PitchBend ch)      <$> word16be+    setRunningEvent (RS_PCH_BEND ch)    >> pitchBend ch  -- This is an /impossible/ match - to get here either @splitByte@  -- or the pattern match of @step@ in @event@ would be wrong. voiceEvent (SB z   _ )  = impossibleMatch $ "voiceEvent " ++ hexStr z   ++noteOff :: Word8 -> ParserM MidiVoiceEvent+noteOff ch = +    "note-off"          <??> (NoteOff ch)        <$> word8 <*> word8++noteOn :: Word8 -> ParserM MidiVoiceEvent+noteOn ch = +    "note-on"           <??> (NoteOn ch)         <$> word8 <*> word8++noteAftertouch :: Word8 -> ParserM MidiVoiceEvent+noteAftertouch ch = +    "note aftertouch"   <??> (NoteAftertouch ch) <$> word8 <*> word8++controller :: Word8 -> ParserM MidiVoiceEvent    +controller ch = +    "controller"        <??> (Controller ch)     <$> word8 <*> word8++programChange :: Word8 -> ParserM MidiVoiceEvent+programChange ch = +    "program change"    <??> (ProgramChange ch)  <$> word8 ++chanAftertouch :: Word8 -> ParserM MidiVoiceEvent+chanAftertouch ch = +    "chan aftertouch"   <??> (ChanAftertouch ch) <$> word8 ++pitchBend :: Word8 -> ParserM MidiVoiceEvent+pitchBend ch = +    "pitch bend"        <??> (PitchBend ch)      <$> word16be++++++runningStatus :: RS_VoiceEvent -> ParserM MidiEvent+runningStatus (RS_NOTE_OFF ch)        = VoiceEvent RS_ON <$> noteOff ch+runningStatus (RS_NOTE_ON ch)         = VoiceEvent RS_ON <$> noteOn ch+runningStatus (RS_NOTE_AFT ch)        = VoiceEvent RS_ON <$> noteAftertouch ch+runningStatus (RS_CONTROL ch)         = VoiceEvent RS_ON <$> controller ch+runningStatus (RS_PROG_CHANGE ch)     = VoiceEvent RS_ON <$> programChange ch+runningStatus (RS_CHAN_AFT ch)        = VoiceEvent RS_ON <$> chanAftertouch ch+runningStatus (RS_PCH_BEND ch)        = VoiceEvent RS_ON <$> pitchBend ch+runningStatus (RS_STATUS_OFF)         = +    MidiEventOther . MidiDataOther <$> word8  -- | Input is a contiguous sequence 0xF1 to 0xF7 so any match  -- failure indicates this parser is called with an invalid 

@@ -22,7 +22,7 @@  -- | Version number ----- > (0,5,0)+-- > (0,6,0) -- zmidi_core_version :: (Int,Int,Int)-zmidi_core_version = (0,5,0)+zmidi_core_version = (0,6,0)

@@ -75,40 +75,46 @@ putMessage (dt,evt) = putVarlen (fromIntegral dt) *> putEvent evt  putEvent :: MidiEvent -> PutM ()-putEvent (DataEvent e)        = putDataEvent  e-putEvent (VoiceEvent e)       = putVoiceEvent e+putEvent (MidiEventOther e)   = putMidiDataOther  e+putEvent (VoiceEvent rs e)    = putVoiceEvent rs e putEvent (SysExEvent e)       = putSysExEvent e putEvent (SysCommonEvent e)   = putSysCommonEvent e putEvent (SysRealTimeEvent e) = putSysRealTimeEvent e putEvent (MetaEvent e)        = putMetaEvent  e    -putDataEvent :: MidiDataEvent -> PutM ()-putDataEvent (MidiDataEvent tag) = putWord8 tag-    -putVoiceEvent :: MidiVoiceEvent -> PutM ()-putVoiceEvent (NoteOff c n v)         = -    putWord8 (0x8 `u4l4` c) *> putWord8 n *> putWord8 v +putMidiDataOther :: MidiDataOther -> PutM ()+putMidiDataOther (MidiDataOther n) = putWord8 n -putVoiceEvent (NoteOn c n v)          = -    putWord8 (0x9 `u4l4` c) *> putWord8 n *> putWord8 v  -putVoiceEvent (NoteAftertouch c n v)  = -    putWord8 (0xA `u4l4` c) *> putWord8 n *> putWord8 v+-- | Note - this assumes the output is properly formed where+-- initial events are labelled with RS_OFF and subsequent events +-- are labelled with RS_ON only when they share the same +-- constructor and channel.+-- +putVoiceEvent :: MidiRunningStatus -> MidiVoiceEvent -> PutM ()+putVoiceEvent rs (NoteOff c n v)         = +    optTagByte rs (0x8 `u4l4` c) *> putWord8 n *> putWord8 v  -putVoiceEvent (Controller c n v)      = -    putWord8 (0xB `u4l4` c) *> putWord8 n *> putWord8 v+putVoiceEvent rs (NoteOn c n v)          = +    optTagByte rs (0x9 `u4l4` c) *> putWord8 n *> putWord8 v  -putVoiceEvent (ProgramChange c n)     = -    putWord8 (0xC `u4l4` c) *> putWord8 n+putVoiceEvent rs (NoteAftertouch c n v)  = +    optTagByte rs (0xA `u4l4` c) *> putWord8 n *> putWord8 v -putVoiceEvent (ChanAftertouch c v)    = -    putWord8 (0xD `u4l4` c) *> putWord8 v  +putVoiceEvent rs (Controller c n v)      = +    optTagByte rs (0xB `u4l4` c) *> putWord8 n *> putWord8 v -putVoiceEvent (PitchBend c v)         = -    putWord8 (0xE `u4l4` c) *> putWord16be v+putVoiceEvent rs (ProgramChange c n)     = +    optTagByte rs (0xC `u4l4` c) *> putWord8 n +putVoiceEvent rs (ChanAftertouch c v)    = +    optTagByte rs (0xD `u4l4` c) *> putWord8 v   +putVoiceEvent rs (PitchBend c v)         = +    optTagByte rs (0xE `u4l4` c) *> putWord16be v++ putSysExEvent :: MidiSysExEvent -> PutM () putSysExEvent (SysEx n ws) =      putWord8 0xF0 *> putVarlen n *> mapM_ putWord8 ws@@ -199,6 +205,11 @@  -------------------------------------------------------------------------------- -- Output helpers++optTagByte :: MidiRunningStatus -> Word8 -> PutM ()+optTagByte RS_OFF n = putWord8 n+optTagByte _      _ = return ()+  prefixLen :: Word8 -> PutM () -> PutM () prefixLen n out = putWord8 n *> out 

@@ -1,5 +1,5 @@ name:             zmidi-core-version:          0.5.0+version:          0.6.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -14,9 +14,24 @@   .   Changelog:   .+  v0.5.0 to v0.6.0:+  .+  * Extended the parser and changed the syntax tree to interpret +    MIDI Running Status. +  . +  * Added a module @ZMidi.Core.Canonical@ to translate MidiFiles+    to a canonical form where any shorthand NoteOff introduced by +    Running Status is expanded to regular NoteOn and NoteOff +    events (with Running Status set, MidiFiles can signal NoteOff +    events as another NoteOn with 0 channel velocity).+  .+  * Added a hack to the pretty printer to stop printing ASCII+    chars greater than 164 causing an error when printing to +    stdout.+  .   v0.4.0 to v0.5.0:   .-  * Changed order of @MidiVoiceEnvent@ constructors so the Ord +  * Changed order of @MidiVoiceEvent@ constructors so the Ord      instance follows the order of the /tag/ in the MIDI binary     representation.   . @@ -85,6 +100,7 @@      exposed-modules:     ZMidi.Core,+    ZMidi.Core.Canonical,     ZMidi.Core.Datatypes,     ZMidi.Core.Pretty,     ZMidi.Core.ReadFile,