zmidi-core 0.2.1 → 0.3.0

raw patch · 10 files changed

+352/−227 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES +15/−0
• demo/MidiCopy.hs +3/−5
• demo/MidiTune.hs +51/−0
• src/ZMidi/Core/Datatypes.hs +66/−145
• src/ZMidi/Core/Internal/ExtraTypes.hs +115/−0
• src/ZMidi/Core/Pretty.hs +26/−23
• src/ZMidi/Core/ReadFile.hs +29/−27
• src/ZMidi/Core/VersionNumber.hs +2/−2
• src/ZMidi/Core/WriteFile.hs +24/−23
• zmidi-core.cabal +21/−2

@@ -1,3 +1,18 @@+0.2.1 to 0.3.0:++  * Revised naming of the MIDI data types. All data types now have +  the prefix Midi (previously only MidiFile followed this scheme).+  The rationale for this is client software, that might want a +  higher-level representation, is then free to use the more +  generic names Track, Message, etc.++  * @DeltaTime@ made a newtype wrapper rather than a type synonym.++  * Renamed the pretty print functions @track@ to @printMidiTrack@ +    and @header@ to @printMidiHeader@.++  * Moved internal dataypes (SplitByte, Varlen) into a private +    module.  0.2.0 to 0.2.1: 

@@ -6,9 +6,7 @@  module Main where -import ZMidi.Core.ReadFile-import ZMidi.Core.WriteFile-+import ZMidi.Core  import System.Environment @@ -31,7 +29,7 @@     ans <- readMidi filename     case ans of       Left err -> print err-      Right a  -> writeMidi (filename ++ ".001") a-    putStrLn $ take 1000 $ show ans  -- not very good, need a pretty printer...+      Right a  -> do { mapM_ putStrLn $ printMidiHeader $ mf_header a+                     ; writeMidi (filename ++ ".001") a }   

@@ -0,0 +1,51 @@+{-# OPTIONS -Wall #-}++--+-- Write a MIDI \"tune\".+--+-- The MIDI AST should be considered too low level to work with +-- directly...+--++module Main where++import ZMidi.Core++import System.Directory++++main :: IO ()+main = do +    createDirectoryIfMissing True "./out/"+    writeMidi "./out/midi_tune.mid" midi_tune01+    ++midi_tune01 :: MidiFile+midi_tune01 = MidiFile+    { mf_header = MidiHeader { hdr_format    = MF1+                             , num_tracks    = 2+                             , time_division = TPB 480+                             }+    , mf_tracks = [ meta_track, sound_track ]+    }+  where+    meta_track  = MidiTrack [ (0, MetaEvent $ TextEvent SEQUENCE_NAME "Track 0")+                            , (0, MetaEvent $ EndOfTrack) +                            ]++    sound_track = MidiTrack [ (0, MetaEvent $ TextEvent SEQUENCE_NAME "Track 1")+                            , (0, MetaEvent $ SetTempo 500000)+                            , (0,   VoiceEvent $ NoteOn  0 60 127)+                            , (480, VoiceEvent $ NoteOff 0 60 15)+                            , (0,   VoiceEvent $ NoteOn  0 62 127)+                            , (480, VoiceEvent $ NoteOff 0 62 15)+                            , (0,   VoiceEvent $ NoteOn  0 64 127)+                            , (480, VoiceEvent $ NoteOff 0 64 15)+                            , (0,   VoiceEvent $ NoteOn  0 66 127)+                            , (480, VoiceEvent $ NoteOff 0 66 15)+                            , (0, MetaEvent $ EndOfTrack) +                            ]+                  ++ 

@@ -1,3 +1,4 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# OPTIONS -Wall #-}  --------------------------------------------------------------------------------@@ -8,7 +9,7 @@ -- -- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com> -- Stability   :  unstable--- Portability :  As per dependencies.+-- Portability :  GHC (at least generalized newtype deriving) -- -- Concrete syntax tree for MIDI files. --@@ -26,45 +27,47 @@  module ZMidi.Core.Datatypes    (-  -- * MidiFile representation.-    MidiFile(..)-  , Header(..)  -  , Track(..)-  , Format(..)-  , DeltaTime-  , Message-  , Event(..)-  , DataEvent(..)-  , VoiceEvent(..)-  , SysExEvent(..)-  , SysCommonEvent(..)-  , SysRealTimeEvent(..)-  , MetaEvent(..)-  , TimeDivision(..)-  , TextType(..)-  , ScaleType(..)+  -- * MidiFile syntax.+    DeltaTime+  , TagByte -  -- * Interim types.-  -- ** SplitByte-  , SplitByte(..)-  , splitByte-  , joinByte-    -  -- ** Varlen-  , Varlen(..)-  , fromVarlen-  , toVarlen+  , MidiFile(..)+  , MidiHeader(..)  +  , MidiTrack(..)+  , MidiFormat(..)+  , MidiMessage+  , MidiEvent(..) -  , hexStr+  , MidiDataEvent(..)+  , MidiVoiceEvent(..)+  , MidiSysExEvent(..)+  , MidiSysCommonEvent(..)+  , MidiSysRealTimeEvent(..)+  , MidiMetaEvent(..)+  , MidiTimeDivision(..)+  , MidiTextType(..)+  , MidiScaleType(..)        ) where -import Data.Bits import Data.Int import Data.Word-import Numeric (showHex)  ++-- | All time values in a MIDI track are represented as a \delta\ +-- from the previous event rather than an absolute time. +--+-- DeltaTime is a newtype wrapper over Word32, note that in MIDI +-- files it is represented as a @varlen@ to save space rather than +-- a four byte number. +--+newtype DeltaTime = DeltaTime { getDeltaTime :: Word32 }+  deriving (Enum,Eq,Ord,Num,Integral,Real)++instance Show DeltaTime where+  showsPrec p = showsPrec p . getDeltaTime+ -- | TagByte is an alias to 'Word8'. -- type TagByte = Word8@@ -73,8 +76,8 @@ -- | 'MidiFile' : @ header * tracks @ -- data MidiFile = MidiFile -      { mf_header         :: Header-      , mf_tracks         :: [Track]+      { mf_header         :: MidiHeader+      , mf_tracks         :: [MidiTrack]       }   deriving (Eq,Show) @@ -85,11 +88,11 @@ -- The header is the start of a MIDI file, it is indicated by the  -- 4 character marker @MThd@.    ---data Header = Header -      { hdr_format        :: Format+data MidiHeader = MidiHeader +      { hdr_format        :: MidiFormat       , num_tracks        :: Word16-      , time_division     :: TimeDivision-    }+      , time_division     :: MidiTimeDivision+      }   deriving (Eq,Show)  -- | 'Track' : @ [message] @@@ -97,13 +100,13 @@ -- In MIDI files, the start of a track is indicated by the 4  -- character marker @MTrk@.   ---newtype Track = Track { getMessages :: [Message] }+newtype MidiTrack = MidiTrack { getTrackMessages :: [MidiMessage] }   deriving (Eq,Show)  -- | The file format - in a MIDI file this is a big-endian  -- word16 with 0,1 or 2 being the only valid values.  ---data Format +data MidiFormat      -- | Format 0 file - single multi-channel track.     = MF0      -- | Format 1 file - 1 or more tracks, played simultaneously.@@ -114,12 +117,12 @@  -- | Default unit of time in the MIDI file. ---data TimeDivision +data MidiTimeDivision      -- | Frames-per-second.     --     = FPS Word16     -    -- | Ticks-per-beat, i.e. the number of units for a quater +    -- | Ticks-per-beat, i.e. the number of units for a quarter      -- note.     --     | TPB Word16    @@ -127,7 +130,7 @@                                               -- | Enumeration of the text meta event types. ---data TextType +data MidiTextType      = GENERIC_TEXT      | COPYRIGHT_NOTICE      | SEQUENCE_NAME @@ -137,13 +140,6 @@     | CUE_POINT    deriving (Eq,Enum,Ord,Show)  --- | All time values in a MIDI track are represented as a \delta\ --- from the previous event rather than an absolute time. ------ Although DeltaTime is a type synonym for Word32, in MIDI --- files it is represented as a @varlen@ to save space. ----type DeltaTime = Word32  -- | MIDI messages are pairs of 'DeltaTime' and 'Event' wrapped in  -- a newtype. @@ -151,7 +147,7 @@ -- Sequential messages with delta time 0 are played  -- simultaneously.   ---type Message = (DeltaTime, Event)+type MidiMessage = (DeltaTime, MidiEvent)   -- Note, the Ord instance for pairs is very useful for rendering.@@ -165,38 +161,38 @@ -- | Recognised event types - some types ('DataEvent' and  -- 'SysEx') are not interpreted. ---data Event +data MidiEvent      -- | Data event - just initial tag byte,      -- uninterpreted     ---    = DataEvent         DataEvent+    = DataEvent         MidiDataEvent      -- | Voice event (e.g @note-on@, @note-off@) are relayed to specific     -- channels.     ---    | VoiceEvent        VoiceEvent+    | VoiceEvent        MidiVoiceEvent       -- | SysEx - system exclusive event. Usually synthesizer      -- specific, not interpreted.     ---    | SysExEvent        SysExEvent+    | SysExEvent        MidiSysExEvent       -- | SysCommon - system common event.     ---    | SysCommonEvent    SysCommonEvent+    | SysCommonEvent    MidiSysCommonEvent       -- | SysRealTime - system realtime event.     ---    | SysRealTimeEvent  SysRealTimeEvent+    | SysRealTimeEvent  MidiSysRealTimeEvent       -- | Meta event - interpreted (e.g. @end-of-track@,      -- @set-tempo@).     ---    | MetaEvent         MetaEvent+    | MetaEvent         MidiMetaEvent     deriving (Eq,Show,Ord)@@ -206,7 +202,7 @@ -- Data events have no payload - they are represented only by the -- tag byte.   ---data DataEvent = Data1 TagByte+newtype MidiDataEvent = MidiDataEvent { getTagByte :: TagByte }   deriving (Eq,Ord,Show)  -- | Voice events control the output of the synthesizer.@@ -221,7 +217,7 @@ -- delta-time. Changing the order of the constructors helps to  -- sort for this. ---data VoiceEvent +data MidiVoiceEvent      -- | @ channel * controller_number * value @      --      -- Controller change, e.g. by a footswitch.@@ -269,7 +265,7 @@  -- | \SysEx\ - system exclusive event.  ---data SysExEvent+data MidiSysExEvent     -- | @ length * data @      --      -- An uninterpreted sys-ex event.@@ -286,10 +282,13 @@ -- computer (as opposed to MIDI generated by a synthesizer or  -- sequencer). ---data SysCommonEvent+data MidiSysCommonEvent     -- | Time code quarter frame.+    -- +    -- Note the payload is really a byte split into two 4-bit +    -- values, however here it is uninterpreted.     ---    = QuarterFrame      SplitByte+    = QuarterFrame      Word8          -- | Song position pointer.     --@@ -323,7 +322,7 @@ -- computer (as opposed to MIDI generated by a synthesizer or  -- sequencer). ---data SysRealTimeEvent+data MidiSysRealTimeEvent     -- | Timing signal.     --           = TimingClock@@ -367,14 +366,14 @@ -- only appear in track 1. Certain events (e.g. end-of-track)  -- can appear in any track where necessary.  ---data MetaEvent+data MidiMetaEvent      -- | @ text_type * contents @      --      -- Free text field (e.g. copyright statement). The contents      -- can notionally be any length.     ---    = TextEvent           TextType String+    = TextEvent           MidiTextType String      -- | @ value @      -- @@ -424,7 +423,7 @@     --     -- @scale_type@ indicates major or minor.       ---    | KeySignature        Int8 ScaleType+    | KeySignature        Int8 MidiScaleType          -- | @ length * data@      -- @@ -436,85 +435,7 @@  -- | Scale type - @major@ or @minor@.   ---data ScaleType = MAJOR | MINOR+data MidiScaleType = MAJOR | MINOR   deriving (Eq,Enum,Ord,Show)  -------------------------------------------------------------------------------------- | SplitByte - divide a byte into the upper four and lower --- 4 bits.--- -data SplitByte = SB { upper4 :: Word8, lower4 :: Word8 }-  deriving (Eq,Ord,Show)--splitByte :: Word8 -> SplitByte-splitByte i = SB ((i .&. 0xF0) `shiftR` 4) (i .&. 0x0F)--joinByte :: SplitByte -> Word8-joinByte (SB a b) = (a `shiftL` 4) + (b .&. 0x0F)-------------------------------------------------------------------------------------- helper for varlen------------------------------------------------------------------------------------- | Space efficient representation of length fields.--- --- This data type is not used directly in the syntax tree where--- it would be cumbersome. But it is used as an intermediate type--- in the parser and emitter.----data Varlen = V1 !Word8-            | V2 !Word8 !Word8-            | V3 !Word8 !Word8 !Word8-            | V4 !Word8 !Word8 !Word8 !Word8-  deriving (Eq,Ord,Show)---up :: Word8 -> Word32-up = fromIntegral . (0x7f .&.)--down :: Word32 -> Word8-down = (0x80 .|.) . fromIntegral--downl :: Word32 -> Word8-downl = (0x7f .&.) . fromIntegral- --fromVarlen :: Varlen -> Word32-fromVarlen (V1 a)       = up a-fromVarlen (V2 a b)     = (left7 $ up a)  + up b-fromVarlen (V3 a b c)   = (left14 $ up a) + (left7  $ up b) + up c-fromVarlen (V4 a b c d) = (left21 $ up a) + (left14 $ up b) -                        + (left7  $ up c) + up d--left7     :: Word32 -> Word32-left7     = (`shiftL` 7)--left14    :: Word32 -> Word32-left14    = (`shiftL` 14)--left21    :: Word32 -> Word32-left21    = (`shiftL` 21)--right7    :: Word32 -> Word32-right7    = (`shiftR` 7)--right14   :: Word32 -> Word32-right14   = (`shiftR` 14)--right21   :: Word32 -> Word32-right21   = (`shiftR` 21)--toVarlen :: Word32 -> Varlen-toVarlen i -    | i < 0x80           = V1 (downl i)-    | i < 0x4000         = V2 (down $ right7 i)  (downl i)-    | i < 0x200000       = V3 (down $ right14 i) (down $ right7  i) (downl i)-    | otherwise          = V4 (down $ right21 i) (down $ right14 i)-                              (down $ right7  i) (downl i)--hexStr :: (Show a, Integral a) => a -> String-hexStr i = (showString "0x" . showHex i) "" 

@@ -0,0 +1,115 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module      :  ZMidi.Core.Internal.ExtraTypes+-- Copyright   :  (c) Stephen Tetley 2010+-- License     :  BSD3+--+-- Maintainer  :  Stephen Tetley <stephen.tetley@gmail.com>+-- Stability   :  unstable+-- Portability :  As per dependencies.+--+-- Internal types not exported by the package.+--+--------------------------------------------------------------------------------+++module ZMidi.Core.Internal.ExtraTypes+  (++  -- * SplitByte+    SplitByte(..)+  , splitByte+  , joinByte+    +  -- * Varlen+  , Varlen(..)+  , fromVarlen+  , toVarlen++  , hexStr+    +  ) where++import Data.Bits+import Data.Word+import Numeric (showHex)++++-- | SplitByte - divide a byte into the upper four and lower +-- 4 bits.+-- +data SplitByte = SB { upper4 :: Word8, lower4 :: Word8 }+  deriving (Eq,Ord,Show)++splitByte :: Word8 -> SplitByte+splitByte i = SB ((i .&. 0xF0) `shiftR` 4) (i .&. 0x0F)++joinByte :: SplitByte -> Word8+joinByte (SB a b) = (a `shiftL` 4) + (b .&. 0x0F)+++--------------------------------------------------------------------------------+-- helper for varlen+--------------------------------------------------------------------------------++-- | Space efficient representation of length fields.+-- +-- This data type is not used directly in the syntax tree where+-- it would be cumbersome. But it is used as an intermediate type+-- in the parser and emitter.+--+data Varlen = V1 !Word8+            | V2 !Word8 !Word8+            | V3 !Word8 !Word8 !Word8+            | V4 !Word8 !Word8 !Word8 !Word8+  deriving (Eq,Ord,Show)+++up :: Word8 -> Word32+up = fromIntegral . (0x7f .&.)++down :: Word32 -> Word8+down = (0x80 .|.) . fromIntegral++downl :: Word32 -> Word8+downl = (0x7f .&.) . fromIntegral+ ++fromVarlen :: Varlen -> Word32+fromVarlen (V1 a)       = up a+fromVarlen (V2 a b)     = (left7 $ up a)  + up b+fromVarlen (V3 a b c)   = (left14 $ up a) + (left7  $ up b) + up c+fromVarlen (V4 a b c d) = (left21 $ up a) + (left14 $ up b) +                        + (left7  $ up c) + up d++left7     :: Word32 -> Word32+left7     = (`shiftL` 7)++left14    :: Word32 -> Word32+left14    = (`shiftL` 14)++left21    :: Word32 -> Word32+left21    = (`shiftL` 21)++right7    :: Word32 -> Word32+right7    = (`shiftR` 7)++right14   :: Word32 -> Word32+right14   = (`shiftR` 14)++right21   :: Word32 -> Word32+right21   = (`shiftR` 21)++toVarlen :: Word32 -> Varlen+toVarlen i +    | i < 0x80           = V1 (downl i)+    | i < 0x4000         = V2 (down $ right7 i)  (downl i)+    | i < 0x200000       = V3 (down $ right14 i) (down $ right7  i) (downl i)+    | otherwise          = V4 (down $ right21 i) (down $ right14 i)+                              (down $ right7  i) (downl i)++hexStr :: (Show a, Integral a) => a -> String+hexStr i = (showString "0x" . showHex i) "" 

@@ -20,8 +20,8 @@      printMidi -  , header-  , track+  , printMidiHeader+  , printMidiTrack    ) where @@ -40,10 +40,10 @@ printMidi :: MidiFile -> IO () printMidi (MidiFile hdr tracks) = do     column_break-    mapM_ putStrLn (header hdr)  +    mapM_ putStrLn (printMidiHeader hdr)       mapM_ (\t -> column_break >> putTrack t) tracks   where-    putTrack       = (mapM_ putStrLn) . track+    putTrack       = (mapM_ putStrLn) . printMidiTrack     column_break   = putStrLn $ replicate 60 '-'  @@ -52,8 +52,8 @@ -- Results are returned as a list of String to avoid extraneous -- concatenation. -- -header :: Header -> [String]-header (Header fmt tcount td) = +printMidiHeader :: MidiHeader -> [String]+printMidiHeader (MidiHeader fmt tcount td) =     map output [ppFormat fmt, ppNumTracks tcount, ppTimeDivision td]    -- | Print a track.@@ -61,9 +61,10 @@ -- Results are returned as a list of String to avoid extraneous -- concatenation. ---track  :: Track -> [String]-track = snd . mapAccumL (\acc b -> msnd output $ message acc b) 0 . getMessages +printMidiTrack :: MidiTrack -> [String]+printMidiTrack = snd . mapAccumL fn 0 . getTrackMessages    where+    fn acc b     = msnd output $ message acc b     msnd f (a,b) = (a,f b)  --------------------------------------------------------------------------------@@ -71,7 +72,7 @@ column2 :: String -> Doc -> Doc column2 s d2 = padr 20 (text s) `sep` char '|' `ssep` d2  -ppFormat :: Format -> Doc+ppFormat :: MidiFormat -> Doc ppFormat = column2 "MIDI Format" . step    where     step MF0  = text "Type 0 MIDI File"@@ -81,7 +82,7 @@ ppNumTracks :: Word16 -> Doc ppNumTracks = column2 "Number of tracks" . integral -ppTimeDivision :: TimeDivision -> Doc+ppTimeDivision :: MidiTimeDivision -> Doc ppTimeDivision = column2 "Time Division" . step   where     step (FPS i)   = text "fps"   `ssep` integral i@@ -92,15 +93,15 @@ dashsep :: Doc -> Doc -> Doc dashsep d1 d2 = d1 `ssep` char '-' `ssep` d2 -message :: Word32 -> Message -> (Word32,Doc)+message :: Word32 -> MidiMessage -> (Word32,Doc) message acc (delta,evt) =      (n, acctime `dashsep` dtime `dashsep` ppEvent evt)   where-    n             = acc + delta +    n             = acc + fromIntegral delta      acctime = padl 12 (integral n)     dtime   = padl 6  (integral delta) -ppEvent :: Event -> Doc+ppEvent :: MidiEvent -> Doc ppEvent (DataEvent e)         = ppDataEvent e ppEvent (VoiceEvent e)        = ppVoiceEvent e ppEvent (SysExEvent e)        = ppSysExEvent e@@ -112,10 +113,10 @@ event :: String -> Doc -> Doc event s d = padr 18 (text s) `dashsep` d -ppDataEvent :: DataEvent -> Doc-ppDataEvent (Data1 tag)       = event "data" (hex2 tag)+ppDataEvent :: MidiDataEvent -> Doc+ppDataEvent (MidiDataEvent tag)     = event "data" (hex2 tag) -ppVoiceEvent :: VoiceEvent -> Doc+ppVoiceEvent :: MidiVoiceEvent -> Doc ppVoiceEvent (Controller c n v)     =      event "controller" (hex2 c `ssep` hex2 n `ssep` hex2 v) @@ -138,12 +139,13 @@     event "pitch-bend" (hex2 c `ssep` hex4 v)  -ppSysExEvent :: SysExEvent -> Doc+ppSysExEvent :: MidiSysExEvent -> Doc ppSysExEvent (SysEx n ws) = event "sys-ex" $ byteList n ws -ppSysCommonEvent :: SysCommonEvent -> Doc++ppSysCommonEvent :: MidiSysCommonEvent -> Doc ppSysCommonEvent (QuarterFrame sb)      = -    event "time-code-quarter-frame" (hex2 $ joinByte sb)+    event "time-code-quarter-frame" (hex2 sb)  ppSysCommonEvent (SongPosPointer a b)   =      event "sys-common song pos. pointer" (hex2 a `ssep` hex2 b)@@ -157,7 +159,7 @@ ppSysCommonEvent EOX                    = text "end-of-sys-ex"  -ppSysRealTimeEvent :: SysRealTimeEvent -> Doc+ppSysRealTimeEvent :: MidiSysRealTimeEvent -> Doc ppSysRealTimeEvent TimingClock          = text "sys-real-time timing-clock" ppSysRealTimeEvent (RT_undefined tag)   = event "sys-real-time" (hex2 tag) ppSysRealTimeEvent StartSequence        = text "sys-real-time start"@@ -166,7 +168,8 @@ ppSysRealTimeEvent ActiveSensing        = text "sys-real-time active sensing" ppSysRealTimeEvent SystemReset          = text "system-reset" -ppMetaEvent :: MetaEvent -> Doc++ppMetaEvent :: MidiMetaEvent -> Doc ppMetaEvent (TextEvent ty s)          = event (textType ty) (text s)  ppMetaEvent (SequenceNumber w)        = event "sequence-number" (hex4 w)@@ -195,7 +198,7 @@               | otherwise = integral n `sep` multiply 10 '.'  -textType :: TextType -> String+textType :: MidiTextType -> String textType GENERIC_TEXT         =  "generic-text"  textType COPYRIGHT_NOTICE     =  "copyright-notice"   textType SEQUENCE_NAME        =  "sequence-name"@@ -205,6 +208,6 @@ textType CUE_POINT            =  "cue-point"    -ppScale :: ScaleType -> Doc+ppScale :: MidiScaleType -> Doc ppScale MAJOR  = text "major" ppScale MINOR  = text "minor"

@@ -27,6 +27,7 @@   ) where  import ZMidi.Core.Datatypes+import ZMidi.Core.Internal.ExtraTypes import ZMidi.Core.Internal.ParserMonad  @@ -46,41 +47,41 @@       midiFile :: ParserM MidiFile  -midiFile = do+midiFile = {- printHexAll >> -} do     hdr   <- header     let i  = trackCount hdr     trks  <- count i track     return $ MidiFile hdr trks      where-    trackCount :: Header -> Int -    trackCount (Header _ n _) = fromIntegral n+    trackCount :: MidiHeader -> Int +    trackCount (MidiHeader _ n _) = fromIntegral n -header :: ParserM Header  -header = Header <$> (assertString "MThd" *> assertWord32 (6::Int) *> format)-                <*> word16be-                <*> timeDivision+header :: ParserM MidiHeader  +header = MidiHeader <$> (assertString "MThd" *> assertWord32 (6::Int) *> format)+                    <*> word16be+                    <*> timeDivision   -track :: ParserM Track-track = liftM Track (trackHeader >>= messages)+track :: ParserM MidiTrack+track = liftM MidiTrack (trackHeader >>= messages)  trackHeader :: ParserM Word32 trackHeader = assertString "MTrk" >> word32be   -messages :: Word32 -> ParserM [Message]+messages :: Word32 -> ParserM [MidiMessage] messages i = boundRepeat (fromIntegral i) message  -message :: ParserM Message+message :: ParserM MidiMessage message = (,) <$>  deltaTime <*> event -deltaTime :: ParserM Word32-deltaTime = "delta time" <??> getVarlen+deltaTime :: ParserM DeltaTime+deltaTime = "delta time" <??> fmap fromIntegral getVarlen -event :: ParserM Event+event :: ParserM MidiEvent event = word8 >>= step   where     -- 00..7f  -- /data/@@ -91,12 +92,12 @@            | 0x80 <= n      = VoiceEvent       <$> voiceEvent (splitByte n)            | otherwise      = DataEvent        <$> dataEvent n -dataEvent :: Word8 -> ParserM DataEvent-dataEvent tag = pure $ Data1 tag+dataEvent :: Word8 -> ParserM MidiDataEvent+dataEvent tag = pure $ MidiDataEvent tag      -voiceEvent :: SplitByte -> ParserM VoiceEvent+voiceEvent :: SplitByte -> ParserM MidiVoiceEvent voiceEvent (SB 0x8 ch)  =      "note-off"          <??> (NoteOff ch)        <$> word8 <*> word8 @@ -121,9 +122,10 @@ voiceEvent (SB z   _ )  = reportError $ "voiceEvent " ++ hexStr z   -sysCommonEvent :: Word8 -> ParserM SysCommonEvent++sysCommonEvent :: Word8 -> ParserM MidiSysCommonEvent sysCommonEvent 0xF1     = -    "quarter frame"     <??> QuarterFrame . splitByte      <$> word8+    "quarter frame"     <??> QuarterFrame                  <$> word8  sysCommonEvent 0xF2     =      "song pos. pointer" <??> SongPosPointer                <$> word8 <*> word8@@ -142,7 +144,7 @@ sysCommonEvent tag      = pure $ Common_undefined tag  -sysRealTimeEvent :: Word8 -> ParserM SysRealTimeEvent+sysRealTimeEvent :: Word8 -> ParserM MidiSysRealTimeEvent sysRealTimeEvent 0xF8 = pure TimingClock sysRealTimeEvent 0xF9 = pure $ RT_undefined 0xF9 sysRealTimeEvent 0xFA = pure StartSequence@@ -154,12 +156,12 @@ sysRealTimeEvent tag  = pure $ RT_undefined tag  -sysExEvent :: ParserM SysExEvent+sysExEvent :: ParserM MidiSysExEvent sysExEvent = "sys-ex" <??> (uncurry SysEx) <$> getVarlenBytes                         -metaEvent :: Word8 -> ParserM MetaEvent+metaEvent :: Word8 -> ParserM MidiMetaEvent metaEvent 0x00          =      "sequence number"   <??> SequenceNumber <$> (assertWord8 2 *> word16be) @@ -202,7 +204,7 @@                             -format :: ParserM Format+format :: ParserM MidiFormat format = word16be >>= fn    where      fn 0 = return MF0@@ -211,13 +213,13 @@     fn z = reportError $                "getFormat - unrecognized file format " ++ hexStr z         -timeDivision :: ParserM TimeDivision+timeDivision :: ParserM MidiTimeDivision timeDivision = division <$> word16be   where division i | i `testBit` 15 = FPS (i `clearBit` 15)                    | otherwise      = TPB i  -scale :: ParserM ScaleType+scale :: ParserM MidiScaleType scale = word8 >>= fn    where     fn 0 = return MAJOR@@ -225,7 +227,7 @@     fn z = reportError $ "scale expecting 0 or 1, got " ++ hexStr z          -textEvent :: TextType -> ParserM MetaEvent+textEvent :: MidiTextType -> ParserM MidiMetaEvent textEvent ty = (TextEvent ty . snd) <$> getVarlenText  --------------------------------------------------------------------------------@@ -237,7 +239,7 @@   where      msg = "assertWord8 - input did not match " ++ show i              -assertWord32 :: (Show a, Integral a) => a -> ParserM Word32+assertWord32 :: (Integral a, Show a) => a -> ParserM Word32 assertWord32 i = postCheck word32be ((==i) . fromIntegral) msg   where     msg = "assertWord32 - input did not match " ++ show i

@@ -22,7 +22,7 @@  -- | Version number ----- > (0,2,1)+-- > (0,3,0) -- zmidi_core_version :: (Int,Int,Int)-zmidi_core_version = (0,2,1)+zmidi_core_version = (0,3,0)

@@ -14,7 +14,6 @@ -- -------------------------------------------------------------------------------- - module ZMidi.Core.WriteFile    (   -- * Write a Midi structure to file@@ -22,7 +21,7 @@   ) where  import ZMidi.Core.Datatypes-+import ZMidi.Core.Internal.ExtraTypes  import Data.Binary.Put                  -- package: binary @@ -46,35 +45,35 @@ putMidiFile (MidiFile hdr trks) =      putHeader hdr *> mapM_ putTrack trks   -putHeader :: Header -> PutM ()-putHeader (Header fmt n td) =+putHeader :: MidiHeader -> PutM ()+putHeader (MidiHeader fmt n td) =     putString "MThd"  *>  putWord32be 6 *>      putFormat fmt     *>  putWord16be n *>  putTimeDivision td  -putTrack :: Track -> PutM ()-putTrack (Track ms) = +putTrack :: MidiTrack -> PutM ()+putTrack (MidiTrack ms) =      putString "MTrk" *> (putWord32be $ fromIntegral $ L.length bs)                      *> putLazyByteString bs   where      bs = runPut (mapM_ putMessage ms)   -putFormat :: Format -> PutM ()+putFormat :: MidiFormat -> PutM () putFormat MF0 = putWord16be 0 putFormat MF1 = putWord16be 1 putFormat MF2 = putWord16be 2 -putTimeDivision :: TimeDivision -> PutM ()+putTimeDivision :: MidiTimeDivision -> PutM () putTimeDivision (FPS n) = putWord16be (n `setBit`   15) putTimeDivision (TPB n) = putWord16be (n `clearBit` 15)   -putMessage :: Message -> PutM () -putMessage (dt,evt) = putVarlen dt *> putEvent evt+putMessage :: MidiMessage -> PutM () +putMessage (dt,evt) = putVarlen (fromIntegral dt) *> putEvent evt -putEvent :: Event -> PutM ()+putEvent :: MidiEvent -> PutM () putEvent (DataEvent e)        = putDataEvent  e putEvent (VoiceEvent e)       = putVoiceEvent e putEvent (SysExEvent e)       = putSysExEvent e@@ -83,10 +82,10 @@ putEvent (MetaEvent e)        = putMetaEvent  e    -putDataEvent :: DataEvent -> PutM ()-putDataEvent (Data1 tag) = putWord8 tag+putDataEvent :: MidiDataEvent -> PutM ()+putDataEvent (MidiDataEvent tag) = putWord8 tag     -putVoiceEvent :: VoiceEvent -> PutM ()+putVoiceEvent :: MidiVoiceEvent -> PutM () putVoiceEvent (NoteOff c n v)         =      putWord8 (0x8 `u4l4` c) *> putWord8 n *> putWord8 v  @@ -108,13 +107,15 @@ putVoiceEvent (PitchBend c v)         =      putWord8 (0xE `u4l4` c) *> putWord16be v -putSysExEvent :: SysExEvent -> PutM ()++putSysExEvent :: MidiSysExEvent -> PutM () putSysExEvent (SysEx n ws) =      putWord8 0xF0 *> putVarlen n *> mapM_ putWord8 ws -putSysCommonEvent :: SysCommonEvent -> PutM ()++putSysCommonEvent :: MidiSysCommonEvent -> PutM () putSysCommonEvent (QuarterFrame sb)        = -    putWord8 0xF1 *> putSplitByte sb+    putWord8 0xF1 *> putWord8 sb  putSysCommonEvent (SongPosPointer lsb msb) =      putWord8 0xF2 *> putWord8 lsb *> putWord8 msb@@ -131,7 +132,8 @@ putSysCommonEvent EOX                      =      putWord8 0xF7 -putSysRealTimeEvent :: SysRealTimeEvent -> PutM ()++putSysRealTimeEvent :: MidiSysRealTimeEvent -> PutM () putSysRealTimeEvent TimingClock            = putWord8 0xF8 putSysRealTimeEvent (RT_undefined tag)     = putWord8 tag putSysRealTimeEvent StartSequence          = putWord8 0xFA@@ -140,7 +142,8 @@ putSysRealTimeEvent ActiveSensing          = putWord8 0xFE putSysRealTimeEvent SystemReset            = putWord8 0xFF -putMetaEvent :: MetaEvent -> PutM ()++putMetaEvent :: MidiMetaEvent -> PutM () putMetaEvent (TextEvent ty ss)                =      putWord8 0xFF *> putWord8 (texttype ty)                    *> putVarlen   (fromIntegral $ length ss) @@ -189,8 +192,6 @@ prefixLen :: Word8 -> PutM () -> PutM () prefixLen n out = putWord8 n *> out  -putSplitByte :: SplitByte -> PutM ()-putSplitByte a = putWord8 (joinByte a)  infixr 5 `u4l4` @@ -205,7 +206,7 @@     i' :: Int     i' = fromIntegral i       -wscale :: ScaleType -> Word8+wscale :: MidiScaleType -> Word8 wscale MAJOR = 0x00 wscale MINOR = 0x01 @@ -239,7 +240,7 @@   -texttype :: TextType -> Word8+texttype :: MidiTextType -> Word8 texttype GENERIC_TEXT         = 0x01 texttype COPYRIGHT_NOTICE     = 0x02 texttype SEQUENCE_NAME        = 0x03

@@ -1,5 +1,5 @@ name:             zmidi-core-version:          0.2.1+version:          0.3.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -8,11 +8,28 @@ category:         Music synopsis:         Read and write MIDI files. description:+  .   Minimalist library to read and write MIDI files, with    dependencies only on ByteString and Data.Binary.   .   Changelog:   .+  v0.2.1 to v0.3.0:+  .+  * Revised naming of the MIDI data types. All data types now have +    the prefix Midi (previously only MidiFile followed this scheme).+    The rationale for this is client software, that might want a +    higher-level representation, is then free to use the more +    generic names Track, Message, etc.+  .+  * @DeltaTime@ made a newtype wrapper rather than a type synonym.+  .+  * Renamed the pretty print functions @track@ to @printMidiTrack@ +    and @header@ to @printMidiHeader@.+  .+  * Moved internal dataypes (SplitByte, Varlen) into a private +    module.+  .   v0.2.0 to v0.2.1:   .    * Added Show class constraints to various type signatures to @@ -31,8 +48,9 @@  extra-source-files:   CHANGES,+  demo/MidiCopy.hs,   demo/MidiPrint.hs,-  demo/MidiCopy.hs+  demo/MidiTune.hs   library@@ -50,6 +68,7 @@     ZMidi.Core.WriteFile    other-modules:+    ZMidi.Core.Internal.ExtraTypes,     ZMidi.Core.Internal.ParserMonad,     ZMidi.Core.Internal.SimpleFormat