packages feed

zmidi-core 0.3.0 → 0.4.0

raw patch · 10 files changed

+129/−54 lines, 10 files

Files

demo/MidiPrint.hs view
@@ -2,6 +2,9 @@  -- Dump the contents of a MIDI file +-- Note - GHC (Windows at least) appears to throw an error if+-- the copyright symbol is used a Text meta-event.+ module Main where  import ZMidi.Core@@ -20,7 +23,8 @@ process filename = do     ans <- readMidi filename     case ans of-      Left (n,msg) -> putStrLn $ "Parse failure at " ++ show n ++ ": " ++ msg-      Right m      -> printMidi m+      Left (ParseErr n msg) -> +                putStrLn $ "Parse failure at " ++ show n ++ ": " ++ msg+      Right m               -> printMidi m
src/ZMidi/Core.hs view
@@ -26,6 +26,7 @@   , module ZMidi.Core.ReadFile   , module ZMidi.Core.VersionNumber   , module ZMidi.Core.WriteFile+          ) where @@ -34,4 +35,3 @@ import ZMidi.Core.ReadFile import ZMidi.Core.VersionNumber import ZMidi.Core.WriteFile-
src/ZMidi/Core/Datatypes.hs view
@@ -368,15 +368,19 @@ -- data MidiMetaEvent -    -- | @ text_type * contents @ +    -- | Text / copywright etc.     -- +    -- > FF * text_type * contents+    --      -- Free text field (e.g. copyright statement). The contents      -- can notionally be any length.     --     = TextEvent           MidiTextType String -    -- | @ value @ +    -- | Sequence Number      -- +    -- > FF 00 02 * value+    --      -- Format 1 files - only track 1 should have a sequence      -- number.      --@@ -388,36 +392,56 @@     --     | SequenceNumber      Word16 -    -- | @ 1 * channel @ +    -- | Channel prefix      -- +    -- > FF 20 01 * channel+    --      -- Relay all meta and sys-ex events to the given channel.     --     -- The first byte should always be 1.     --      | ChannelPrefix       Word8 Word8 +    -- | Midi port+    -- +    -- > FF 21 01 * port+    -- +    -- Midi port number - used to workaround 16 channel limit...+    -- +    | MidiPort Word8+     -- | End-of-track event.      --+    -- > FF 2F 00+    --     | EndOfTrack -    -- | @ microseconds_per_quarter_note @+    -- | Set tempo     --+    -- > FF 51 03 * microseconds_per_quarter_note+    --     | SetTempo            Word32 -    -- | @ hour * minute * second * frac * subfrac @ +    -- | SMPTE offest     -- +    -- > FF 54 05 * hour * minute * second * frac * subfrac+    --      -- The SMPTE time when a track should start. This event      -- should occur at the start of a track, before any non-zero      -- time events.     --     | SMPTEOffset         Word8 Word8 Word8 Word8 Word8     -    -- | @ numerator * denominator * metro * num_32nd_notes @ +    -- | Time signature +    -- +    -- > FF 58 04 * numerator * denominator * metro * num_32nd_notes     --     | TimeSignature       Word8 Word8 Word8 Word8     -    -- | @ key_type * scale_type @ +    -- | Key signature      --+    -- > FF 59 02 * key_type * scale_type+    --     -- @key_type@ is the number of sharps (postive numbers) or      -- flats (negative numbers), e.g. (-1) is 1 flat.     --@@ -425,17 +449,27 @@     --     | KeySignature        Int8 MidiScaleType     -    -- | @ length * data@ +    -- | SSME      -- +    -- > FF 7F * length * data+    --      -- Sequencer specific meta-event - uninterpreted.     --     | SSME                Word32 [Word8] +    -- | Unrecognized Meta Event+    --+    -- > FF * type * length * data +    --+    | MetaOther           Word8 Word32 [Word8]+   deriving (Eq,Show,Ord) --- | Scale type - @major@ or @minor@.  +-- | Scale type - @major@ or @minor@ or @SCALE_OTHER@.   ---data MidiScaleType = MAJOR | MINOR-  deriving (Eq,Enum,Ord,Show)+-- @SCALE_OTHER@ represents a parse error.+-- +data MidiScaleType = MAJOR | MINOR | SCALE_OTHER Word8+  deriving (Eq,Ord,Show)
src/ZMidi/Core/Internal/ParserMonad.hs view
@@ -19,7 +19,7 @@      ErrMsg   , Pos-  , ParseErr+  , ParseErr(..)   , ParserM   , runParser   @@ -33,6 +33,7 @@    , (<??>)   , reportError+  , catchError    , count   , gencount@@ -61,7 +62,8 @@  type ErrMsg = String -type ParseErr = (Pos,ErrMsg)+data ParseErr = ParseErr !Pos !ErrMsg+  deriving (Eq,Show)  newtype ParserM a = ParserM            { getParserM :: ParserState -> (Either ParseErr a, ParserState) }@@ -95,7 +97,7 @@  word8 :: ParserM Word8 word8 = ParserM $ \s@(ParserState n bs) -> case L.uncons bs of -    Nothing      -> (Left (n,"word8 - no more data."), s)+    Nothing      -> (Left (ParseErr n "word8 - no more data."), s)     Just (a,bs') -> (Right a, ParserState (n+1) bs')  @@ -107,17 +109,17 @@  word16be :: ParserM Word16 word16be = ParserM $ \s@(ParserState n bs) -> case uncons2 bs of-    Nothing -> (Left (n,"word16be - no more data."), s)+    Nothing -> (Left (ParseErr n "word16be - no more data."), s)     Just (a,b,bs') -> (Right $ w16be a b, ParserState (n+2) bs')  word24be :: ParserM Word32 word24be = ParserM $ \s@(ParserState n bs) -> case uncons3 bs of-    Nothing -> (Left (n,"word24be - no more data."), s)+    Nothing -> (Left (ParseErr n "word24be - no more data."), s)     Just (a,b,c,bs') -> (Right $ w24be a b c, ParserState (n+3) bs')  word32be :: ParserM Word32 word32be = ParserM $ \s@(ParserState n bs) -> case uncons4 bs of-    Nothing -> (Left (n, "word32be - no more data."), s)+    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')  @@ -127,15 +129,21 @@ infixr 0 <??>  (<??>) :: ErrMsg -> ParserM a -> ParserM a-(<??>) msg p = ParserM $ \s -> case getParserM p s of-                                (Left (n,_),s') -> (Left (n,msg),s')-                                (Right a,   s') -> (Right a,s')+(<??>) msg p = ParserM $ \s -> +                 case getParserM p s of+                   (Left (ParseErr n _),s') -> (Left (ParseErr n msg),s')+                   (Right a,            s') -> (Right a,s')  reportError :: ErrMsg -> ParserM a-reportError msg = ParserM $ \s -> (Left (pos s, msg), s)--+reportError msg = ParserM $ \s -> (Left (ParseErr (pos s) msg), s) +-- | This uses backtracking...+--+catchError :: ParserM a -> (ErrMsg -> ParserM a) -> ParserM a+catchError f g = ParserM $ \s -> +                   case getParserM f s of+                     (Left (ParseErr _ msg),_)  -> getParserM (g msg) s+                     (Right a,              s') -> (Right a,s')  count :: Int -> ParserM a -> ParserM [a] count i p @@ -143,9 +151,11 @@     | otherwise = (:) <$> p <*> count (i-1) p  -gencount :: Integral i => ParserM i -> ParserM a -> ParserM (i,[a]) -gencount plen p = plen >>= \i -> -    count (fromIntegral i) p >>= \ans -> return (i,ans)+gencount :: Integral i => ParserM i -> ParserM a -> (i -> [a] -> ans) -> ParserM ans+gencount plen p constr = do +    i   <- plen+    xs  <- count (fromIntegral i) p +    return $ constr i xs   text :: Int -> ParserM String
src/ZMidi/Core/Internal/SimpleFormat.hs view
@@ -21,7 +21,7 @@   , width   , output -  , sep+  , cat   , ssep   , char   , text@@ -73,10 +73,10 @@   Doc i1 f1 `mappend` Doc i2 f2 = Doc (i1+i2) (f1 . f2)  -infixr 6 `sep`+infixr 6 `cat` -sep :: Doc -> Doc -> Doc-sep = mappend+cat :: Doc -> Doc -> Doc+cat = mappend  infixr 6 `ssep`
src/ZMidi/Core/Pretty.hs view
@@ -70,7 +70,7 @@ --------------------------------------------------------------------------------  column2 :: String -> Doc -> Doc-column2 s d2 = padr 20 (text s) `sep` char '|' `ssep` d2 +column2 s d2 = padr 20 (text s) `cat` char '|' `ssep` d2   ppFormat :: MidiFormat -> Doc ppFormat = column2 "MIDI Format" . step @@ -177,8 +177,10 @@ ppMetaEvent (ChannelPrefix a b)       =      event "channel-prefix" (hex2 a `ssep` hex2 b) -ppMetaEvent EndOfTrack                = text "end-of-track"+ppMetaEvent (MidiPort w)              = event "midi-port" (hex2 w) +ppMetaEvent (EndOfTrack)              = text "end-of-track"+ ppMetaEvent (SetTempo w)              = event "set-tempo" (integral w)   ppMetaEvent (SMPTEOffset h m s f sf)  = @@ -193,9 +195,12 @@ ppMetaEvent (SSME n ws)               =      event "sequencer-specific" (byteList n ws) +ppMetaEvent (MetaOther ty len ws)     =+    event "meta-other" (hex2 ty `ssep` byteList len ws)+ byteList :: (Show a, Integral a) => a -> [Word8] -> Doc -byteList n ws | n < 10    = integral n `sep` mconcat (map hex2 ws)-              | otherwise = integral n `sep` multiply 10 '.'+byteList n ws | n < 10    = integral n `cat` mconcat (map hex2 ws)+              | otherwise = integral n `cat` multiply 10 '.'   textType :: MidiTextType -> String@@ -211,3 +216,4 @@ ppScale :: MidiScaleType -> Doc ppScale MAJOR  = text "major" ppScale MINOR  = text "minor"+ppScale (SCALE_OTHER i) = text "unrecognized scale" `ssep` hex2 i
src/ZMidi/Core/ReadFile.hs view
@@ -20,7 +20,7 @@     readMidi    -- * Auxiallary types-  , ParseErr+  , ParseErr(..)        -- exported from internal file ParserMonad   , Pos   , ErrMsg   @@ -47,7 +47,7 @@       midiFile :: ParserM MidiFile  -midiFile = {- printHexAll >> -} do+midiFile = do     hdr   <- header     let i  = trackCount hdr     trks  <- count i track@@ -76,7 +76,7 @@   message :: ParserM MidiMessage-message = (,) <$>  deltaTime <*> event+message = (,) <$> deltaTime <*> event  deltaTime :: ParserM DeltaTime deltaTime = "delta time" <??> fmap fromIntegral getVarlen@@ -157,10 +157,12 @@   sysExEvent :: ParserM MidiSysExEvent-sysExEvent = "sys-ex" <??> (uncurry SysEx) <$> getVarlenBytes-                      +sysExEvent = "sys-ex" <??> getVarlenBytes SysEx  +-- FF and the "type" byte already parsed, input to this function +-- is the type byte.+-- metaEvent :: Word8 -> ParserM MidiMetaEvent metaEvent 0x00          =      "sequence number"   <??> SequenceNumber <$> (assertWord8 2 *> word16be)@@ -176,6 +178,9 @@ metaEvent 0x20          =      "channel prefix"    <??> ChannelPrefix <$> word8 <*> word8 +metaEvent 0x21          = +    "MIDI port"         <??> MidiPort <$> (assertWord8 1 *> word8)+ metaEvent 0x2F          =      "end of track"      <??> EndOfTrack <$ assertWord8 0   @@ -197,12 +202,14 @@                                             <*> scale  metaEvent 0x7F          = -    "system specific meta event" <??> (uncurry SSME) <$> getVarlenBytes     +    "system specific meta event" <??> getVarlenBytes SSME -metaEvent z    = reportError $ "unreconized meta-event " ++ hexStr z+metaEvent ty            = +    "meta other"        <??> getVarlenBytes (MetaOther ty)   +                            format :: ParserM MidiFormat format = word16be >>= fn @@ -224,11 +231,11 @@   where     fn 0 = return MAJOR     fn 1 = return MINOR-    fn z = reportError $ "scale expecting 0 or 1, got " ++ hexStr z+    fn z = return $ SCALE_OTHER z           textEvent :: MidiTextType -> ParserM MidiMetaEvent-textEvent ty = (TextEvent ty . snd) <$> getVarlenText+textEvent ty = getVarlenText (\_ ss -> TextEvent ty ss)   -------------------------------------------------------------------------------- -- helpers@@ -250,10 +257,10 @@     msg = "assertString - input did not match " ++ s  -getVarlenText :: ParserM (Word32,String)  +getVarlenText :: (Word32 -> String -> ans) -> ParserM ans getVarlenText = gencount getVarlen char8 -getVarlenBytes :: ParserM (Word32,[Word8]) +getVarlenBytes :: (Word32 -> [Word8] -> ans) -> ParserM ans getVarlenBytes = gencount getVarlen word8
src/ZMidi/Core/VersionNumber.hs view
@@ -22,7 +22,7 @@  -- | Version number ----- > (0,3,0)+-- > (0,4,0) -- zmidi_core_version :: (Int,Int,Int)-zmidi_core_version = (0,3,0)+zmidi_core_version = (0,4,0)
src/ZMidi/Core/WriteFile.hs view
@@ -154,6 +154,9 @@    putMetaEvent (ChannelPrefix i ch)             =      putWord8 0xFF *> putWord8 0x20 *> prefixLen i (putWord8 ch)++putMetaEvent (MidiPort pn)                     = +    putWord8 0xFF *> putWord8 0x21 *> putWord8 0x01 *> putWord8 pn    putMetaEvent (EndOfTrack)                     =      putWord8 0xFF *> putWord8 0x2F *> prefixLen 0 (pure ())@@ -180,6 +183,9 @@ putMetaEvent (SSME i ws)                      =       putWord8 0xFF *> putWord8 0x7F *> putVarlen i *> mapM_ putWord8 ws +putMetaEvent (MetaOther ty len bs)             = +    putWord8 0xff *> putWord8 ty *> putVarlen (fromIntegral len) +                  *> mapM_ putWord8 bs         @@ -207,9 +213,9 @@     i' = fromIntegral i        wscale :: MidiScaleType -> Word8-wscale MAJOR = 0x00-wscale MINOR = 0x01-+wscale (MAJOR)          = 0x00+wscale (MINOR)          = 0x01+wscale (SCALE_OTHER i)  = i  putWord24be :: Word32 -> PutM () putWord24be i = putWord8 c *> putWord8 b *> putWord8 a
zmidi-core.cabal view
@@ -1,5 +1,5 @@ name:             zmidi-core-version:          0.3.0+version:          0.4.0 license:          BSD3 license-file:     LICENSE copyright:        Stephen Tetley <stephen.tetley@gmail.com>@@ -13,6 +13,14 @@   dependencies only on ByteString and Data.Binary.   .   Changelog:+  .+  v0.3.0 to v0.4.0:+  .+  * Added new constructors to @MidiMetaEvent@ for MidiPort and +    MetaOther. MetaOther recognizes otherwise unrecognized events+    improving the robustness of the parser. Similarly a new +    /other/ constructor has been added to @MidiScaleType@ to +    avoid parse errors.   .   v0.2.1 to v0.3.0:   .