packages feed

midi-simple (empty) → 0.1.0.0

raw patch · 13 files changed

+1537/−0 lines, 13 filesdep +QuickCheckdep +attoparsecdep +basesetup-changed

Dependencies added: QuickCheck, attoparsec, base, bytestring, criterion, generic-random, hspec, hspec-attoparsec, midi-simple, pipes, pipes-attoparsec, pipes-bytestring, tasty, tasty-hspec, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,165 @@+                   GNU LESSER GENERAL PUBLIC LICENSE+                       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++  This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++  0. Additional Definitions.++  As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++  "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++  An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++  A "Combined Work" is a work produced by combining or linking an+Application with the Library.  The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++  The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++  The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++  1. Exception to Section 3 of the GNU GPL.++  You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++  2. Conveying Modified Versions.++  If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++   a) under this License, provided that you make a good faith effort to+   ensure that, in the event an Application does not supply the+   function or data, the facility still operates, and performs+   whatever part of its purpose remains meaningful, or++   b) under the GNU GPL, with none of the additional permissions of+   this License applicable to that copy.++  3. Object Code Incorporating Material from Library Header Files.++  The object code form of an Application may incorporate material from+a header file that is part of the Library.  You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++   a) Give prominent notice with each copy of the object code that the+   Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the object code with a copy of the GNU GPL and this license+   document.++  4. Combined Works.++  You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++   a) Give prominent notice with each copy of the Combined Work that+   the Library is used in it and that the Library and its use are+   covered by this License.++   b) Accompany the Combined Work with a copy of the GNU GPL and this license+   document.++   c) For a Combined Work that displays copyright notices during+   execution, include the copyright notice for the Library among+   these notices, as well as a reference directing the user to the+   copies of the GNU GPL and this license document.++   d) Do one of the following:++       0) Convey the Minimal Corresponding Source under the terms of this+       License, and the Corresponding Application Code in a form+       suitable for, and under terms that permit, the user to+       recombine or relink the Application with a modified version of+       the Linked Version to produce a modified Combined Work, in the+       manner specified by section 6 of the GNU GPL for conveying+       Corresponding Source.++       1) Use a suitable shared library mechanism for linking with the+       Library.  A suitable mechanism is one that (a) uses at run time+       a copy of the Library already present on the user's computer+       system, and (b) will operate properly with a modified version+       of the Library that is interface-compatible with the Linked+       Version.++   e) Provide Installation Information, but only if you would otherwise+   be required to provide such information under section 6 of the+   GNU GPL, and only to the extent that such information is+   necessary to install and execute a modified version of the+   Combined Work produced by recombining or relinking the+   Application with a modified version of the Linked Version. (If+   you use option 4d0, the Installation Information must accompany+   the Minimal Corresponding Source and Corresponding Application+   Code. If you use option 4d1, you must provide the Installation+   Information in the manner specified by section 6 of the GNU GPL+   for conveying Corresponding Source.)++  5. Combined Libraries.++  You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++   a) Accompany the combined library with a copy of the same work based+   on the Library, uncombined with any other library facilities,+   conveyed under the terms of this License.++   b) Give prominent notice with the combined library that part of it+   is a work based on the Library, and explaining where to find the+   accompanying uncombined form of the same work.++  6. Revised Versions of the GNU Lesser General Public License.++  The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++  Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++  If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ README.rst view
@@ -0,0 +1,28 @@+midi-simple+===========++A simple and minimal MIDI library for Haskell, written with real-time+applications in mind.  It provides fast decoding and encoding of (normalized)+MIDI messages as output by e.g. JACK.++Currently, the MIDI 1.0 specification is supported. No extensions (e.g. General+MIDI) are implemented at the moment, but may be added in the future.++In particular, timing information, relative or absolute, is out of scope for+this project, as it messages are timed in the way they arrive in a real-time+setting. There are currently also no plans to support MIDI files, although this+library can be used as a base for building support for such a use case.++Usage+~~~~~++Most intended use cases should be covered by the `Sound.MIDI` module. The+modules `Sound.MIDI.Parser` and `Sound.MIDI.Serialize` export the innards of the+parser/serializer respectively for when they are needed.++Performance+~~~~~~~~~~~++In my benchmarks, the library has proven to be sufficient for real-time use.+Parsing of common MIDI events such as Note On/Off or Pitch Bend runs at around+50-60ns per event.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Bench.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Sound.MIDI+import Sound.MIDI.Types+import Criterion.Main+import Data.ByteString (ByteString)++pchannelVoice, ppitchBend, pmonoOn, pexclusive :: ByteString+pchannelVoice = "\x80\x3c\x7f"+ppitchBend = "\xe0\x08\x00"+pmonoOn = "\xb0\x7e\x03"+pexclusive = "\xf0\x00\x08\x08\x30\x30\x30\xf7"++pmulti :: ByteString+pmulti = "\x80\x3c\x7f\xf0\x00\x08\x08\x30\x30\x30\xf7\xe0\x08\x00\xb0\x7e\x03"++schannelVoice, spitchBend, smonoOn, sexclusive :: MidiMessage+schannelVoice = ChannelVoice (NoteOff (Channel 0) (Pitch 60) (Velocity 127))+spitchBend = ChannelVoice (PitchBend (Channel 0) (to14Bit 8))+smonoOn = ChannelMode (MonoOn (Channel 0) (to7Bit 3))+sexclusive = +    SystemExclusive (Exclusive (VendorIdLong (to7Bit 8) (to7Bit 8)) "000")++smulti = [ schannelVoice, spitchBend, smonoOn, sexclusive ]++main :: IO ()+main = defaultMain+    [ bgroup "parsing"+        [ bench "channelVoice" $ whnf decodeMidi1 pchannelVoice+        , bench "pitchBend" $ whnf decodeMidi1 ppitchBend+        , bench "monoOn" $ whnf decodeMidi1 pmonoOn+        , bench "exclusive" $ whnf decodeMidi1 pexclusive+        , bench "multi" $ whnf decodeMidi pmulti+        ]+    , bgroup "serializing"+        [ bench "channelVoice" $ whnf encodeMidi1' schannelVoice+        , bench "pitchBend" $ whnf encodeMidi1' spitchBend+        , bench "monoOn" $ whnf encodeMidi1' smonoOn+        , bench "exclusive" $ whnf encodeMidi1' sexclusive+        , bench "multi" $ whnf encodeMidi' smulti+        ]+    ]
+ example/MidiDump.hs view
@@ -0,0 +1,19 @@+module Main where++import Sound.MIDI+import Pipes+import qualified Pipes.Prelude as P+import qualified Pipes.ByteString as B+import Pipes.Attoparsec+import System.IO+import System.Environment++main :: IO ()+main = do+    [fp] <- getArgs+    fd   <- openFile fp ReadMode++    runEffect $+        void (parsed midiParser (B.fromHandle fd)) >-> P.map show >-> P.stdoutLn++    return ()
+ example/Reencode.hs view
@@ -0,0 +1,21 @@+module Main where++import Sound.MIDI+import Pipes+import qualified Pipes.Prelude as P+import qualified Pipes.ByteString as B+import Pipes.Attoparsec+import System.IO+import System.Environment++main :: IO ()+main = do+    [fp] <- getArgs+    fd   <- openFile fp ReadMode+    fdo  <- openFile (fp ++ "-re") WriteMode++    runEffect $+        void (parsed midiParser (B.fromHandle fd)) +            >-> P.map encodeMidi1' >-> B.toHandle fdo++    return ()
+ midi-simple.cabal view
@@ -0,0 +1,72 @@+name:                midi-simple+version:             0.1.0.0+synopsis:			 A simple and fast library for working with MIDI messages+description:         Please see README.rst+homepage:            https://github.com/tsahyt/midi-simple#readme+license:             LGPL-3+license-file:        LICENSE+author:              Paul Ogris+maintainer:          paul@tsahyt.com+copyright:           2017 Paul Ogris+category:            Sound+build-type:          Simple+extra-source-files:  README.rst+cabal-version:       >=1.10++flag examples+  description:       Build examples+  default:           False++library+  hs-source-dirs:      src+  ghc-options:         -Wall -O2+  exposed-modules:     Sound.MIDI+                       Sound.MIDI.Types+                       Sound.MIDI.Parser+                       Sound.MIDI.Serialize+                       Sound.MIDI.Controllers+  build-depends:       base >= 4.7 && < 5,+                       attoparsec >= 0.13.1.0 && < 0.14,+                       bytestring >= 0.10.8.1 && < 0.11+  default-language:    Haskell2010++executable midi-dump+  if flag(examples)+      build-depends:   base >= 4.7 && < 5, midi-simple, pipes, +                       pipes-bytestring, pipes-attoparsec+  else+      buildable:       False+  hs-source-dirs:      example+  ghc-options:         -Wall -O2+  main-is:             MidiDump.hs+  default-language:    Haskell2010++executable re-encode+  if flag(examples)+      build-depends:   base >= 4.7 && < 5, midi-simple, pipes, +                       pipes-bytestring, pipes-attoparsec+  else+      buildable:       False+  hs-source-dirs:      example+  ghc-options:         -Wall -O2 -rtsopts+  main-is:             Reencode.hs+  default-language:    Haskell2010++test-suite midi-tests+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Test.hs+  build-depends:       base >= 4.7 && < 5, midi-simple, tasty, tasty-hspec,+                       tasty-quickcheck, QuickCheck, generic-random, bytestring,+                       hspec-attoparsec, hspec, attoparsec++benchmark midi-bench+  type:                exitcode-stdio-1.0+  hs-source-dirs:      bench+  main-is:             Bench.hs+  ghc-options:         -Wall -O2+  build-depends:       base >= 4.7 && < 5, midi-simple, criterion, bytestring++source-repository head+  type:     git+  location: https://github.com/tsahyt/midi-simple
+ src/Sound/MIDI.hs view
@@ -0,0 +1,78 @@+module Sound.MIDI+(+    -- * Encoding+    encodeMidi,+    encodeMidi',+    encodeMidi1,+    encodeMidi1',++    -- * Decoding+    decodeMidi,+    decodeMidi1,+    partitionRealtime,++    -- * Parser and Serializer+    --+    -- | Top level parsing and serializing tools are exposed here. For+    -- fine-grained access, see "Sound.MIDI.Parser" and "Sound.MIDI.Serialize".+    midiParser,+    midiSerializer,++    -- * Re-exports+    module Sound.MIDI.Types+)+where++import Control.Applicative+import Data.Functor.Identity+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Builder (toLazyByteString, Builder)+import qualified Data.Attoparsec.ByteString as A++import Sound.MIDI.Types+import qualified Sound.MIDI.Parser as P+import qualified Sound.MIDI.Serialize as S++-- | Encode some collection of 'MidiMessage's to a lazy 'BL.ByteString'+encodeMidi :: Foldable t => t MidiMessage -> BL.ByteString+encodeMidi = toLazyByteString . foldMap S.midiMessage+{-# SPECIALISE encodeMidi :: [MidiMessage] -> BL.ByteString #-}++-- | Strict version of 'encodeMidi'+encodeMidi' :: Foldable t => t MidiMessage -> BS.ByteString+encodeMidi' = BL.toStrict . encodeMidi+{-# SPECIALISE encodeMidi' :: [MidiMessage] -> BS.ByteString #-}++-- | Encode a single message to a lazy 'BL.ByteString'+encodeMidi1 :: MidiMessage -> BL.ByteString+encodeMidi1 = encodeMidi . Identity++-- | Strict version of 'encodeMidi1'+encodeMidi1' :: MidiMessage -> BS.ByteString+encodeMidi1' = encodeMidi' . Identity++-- | Decode raw MIDI data from a strict 'ByteString'. Any incomplete data at the+-- beginning will be skipped! This function assumes a normalized MIDI stream,+-- i.e. one in which events are /not/ interrupted by real-time events!+decodeMidi :: BS.ByteString -> Either String [MidiMessage]+decodeMidi = A.parseOnly (P.skipToStatus *> some P.midiMessage)++-- | Decode one event from raw MIDI data in a strict 'ByteString'. Any+-- incomplete data at the beginning will be skipped!+decodeMidi1 :: BS.ByteString -> Either String MidiMessage+decodeMidi1 = A.parseOnly (P.skipToStatus *> P.midiMessage)++-- | Partition an event stream into real-time events and other messages. The+-- first parameter returned will be the real-time events, the second element+-- will be the rest of the stream. Note that this effectively normalizes the+-- second element.+partitionRealtime :: BS.ByteString -> (BS.ByteString, BS.ByteString)+partitionRealtime = BS.partition isRT+    where isRT x = x >= 0xF8 && x <= 0xFF++midiParser :: A.Parser MidiMessage+midiParser = P.midiMessage++midiSerializer :: MidiMessage -> Builder+midiSerializer = S.midiMessage
+ src/Sound/MIDI/Controllers.hs view
@@ -0,0 +1,379 @@+{-# LANGUAGE PatternSynonyms #-}+-- | A module providing pattern synonyms for controller numbers as defined in+-- the MIDI 1.0 specification.+module Sound.MIDI.Controllers+(+    pattern BankSelect, +    pattern ModWheel, +    pattern BreathController, +    pattern FootController, +    pattern PortamentoTime, +    pattern DataEntryMSB, +    pattern ChannelVolume, +    pattern Balance, +    pattern Pan, +    pattern ExpressionController, +    pattern EffectControl1, +    pattern EffectControl2, +    pattern GeneralPurposeController1, +    pattern GeneralPurposeController2, +    pattern GeneralPurposeController3, +    pattern GeneralPurposeController4, +    pattern LSB0, +    pattern LSB1, +    pattern LSB2, +    pattern LSB3, +    pattern LSB4, +    pattern LSB5, +    pattern LSB6, +    pattern LSB7, +    pattern LSB8, +    pattern LSB9, +    pattern LSB10, +    pattern LSB11, +    pattern LSB12, +    pattern LSB13, +    pattern LSB14, +    pattern LSB15, +    pattern LSB16, +    pattern LSB17, +    pattern LSB18, +    pattern LSB19, +    pattern LSB20, +    pattern LSB21, +    pattern LSB22, +    pattern LSB23, +    pattern LSB24, +    pattern LSB25, +    pattern LSB26, +    pattern LSB27, +    pattern LSB28, +    pattern LSB29, +    pattern LSB30, +    pattern LSB31, +    pattern DamperPedal, +    pattern Portamento, +    pattern Sostenuto, +    pattern SoftPedal, +    pattern LegatoFootswitch, +    pattern Hold2, +    pattern SoundController1, +    pattern SoundVariation, +    pattern SoundController2, +    pattern Timbre, +    pattern SoundController3, +    pattern ReleaseTime, +    pattern SoundController4, +    pattern AttackTime, +    pattern SoundController5, +    pattern Brightness, +    pattern SoundControllers6, +    pattern SoundControllers7, +    pattern SoundControllers8, +    pattern SoundControllers9, +    pattern SoundControllers10, +    pattern GeneralPurposeController5, +    pattern GeneralPurposeController6, +    pattern GeneralPurposeController7, +    pattern GeneralPurposeController8, +    pattern PortamentoControl, +    pattern Effects1Depth, +    pattern ExternalEffectsDepth, +    pattern Effects2Depth, +    pattern TremoloDepth, +    pattern Effects3Depth, +    pattern ChorusDepth, +    pattern Effects4Depth, +    pattern CelesteDepth, +    pattern Effects5Depth, +    pattern PhaserDepth, +    pattern DataIncrement, +    pattern DataDecrement, +    pattern UnRegisteredParameterNumberLSB, +    pattern UnRegisteredParameterNumberMSB, +    pattern RegisteredParameterNumberLSB, +    pattern RegisteredParameterNumberMSB+)+where++import Sound.MIDI.Types++pattern BankSelect :: Controller+pattern BankSelect = Controller 0++pattern ModWheel :: Controller+pattern ModWheel = Controller 1++pattern BreathController :: Controller+pattern BreathController = Controller 2++pattern FootController :: Controller+pattern FootController = Controller 4++pattern PortamentoTime :: Controller+pattern PortamentoTime = Controller 5++pattern DataEntryMSB :: Controller+pattern DataEntryMSB = Controller 6++pattern ChannelVolume :: Controller+pattern ChannelVolume = Controller 7++pattern Balance :: Controller+pattern Balance = Controller 8++pattern Pan :: Controller+pattern Pan = Controller 10++pattern ExpressionController :: Controller+pattern ExpressionController = Controller 11++pattern EffectControl1 :: Controller+pattern EffectControl1 = Controller 12++pattern EffectControl2 :: Controller+pattern EffectControl2 = Controller 13++pattern GeneralPurposeController1 :: Controller+pattern GeneralPurposeController1 = Controller 16++pattern GeneralPurposeController2 :: Controller+pattern GeneralPurposeController2 = Controller 17++pattern GeneralPurposeController3 :: Controller+pattern GeneralPurposeController3 = Controller 18++pattern GeneralPurposeController4 :: Controller+pattern GeneralPurposeController4 = Controller 19++pattern LSB0 :: Controller+pattern LSB0 = Controller 32++pattern LSB1 :: Controller+pattern LSB1 = Controller 33++pattern LSB2 :: Controller+pattern LSB2 = Controller 34++pattern LSB3 :: Controller+pattern LSB3 = Controller 35++pattern LSB4 :: Controller+pattern LSB4 = Controller 36++pattern LSB5 :: Controller+pattern LSB5 = Controller 37++pattern LSB6 :: Controller+pattern LSB6 = Controller 38++pattern LSB7 :: Controller+pattern LSB7 = Controller 39++pattern LSB8 :: Controller+pattern LSB8 = Controller 40++pattern LSB9 :: Controller+pattern LSB9 = Controller 41++pattern LSB10 :: Controller+pattern LSB10 = Controller 42++pattern LSB11 :: Controller+pattern LSB11 = Controller 43++pattern LSB12 :: Controller+pattern LSB12 = Controller 44++pattern LSB13 :: Controller+pattern LSB13 = Controller 45++pattern LSB14 :: Controller+pattern LSB14 = Controller 46++pattern LSB15 :: Controller+pattern LSB15 = Controller 47++pattern LSB16 :: Controller+pattern LSB16 = Controller 48++pattern LSB17 :: Controller+pattern LSB17 = Controller 49++pattern LSB18 :: Controller+pattern LSB18 = Controller 50++pattern LSB19 :: Controller+pattern LSB19 = Controller 51++pattern LSB20 :: Controller+pattern LSB20 = Controller 52++pattern LSB21 :: Controller+pattern LSB21 = Controller 53++pattern LSB22 :: Controller+pattern LSB22 = Controller 54++pattern LSB23 :: Controller+pattern LSB23 = Controller 55++pattern LSB24 :: Controller+pattern LSB24 = Controller 56++pattern LSB25 :: Controller+pattern LSB25 = Controller 57++pattern LSB26 :: Controller+pattern LSB26 = Controller 58++pattern LSB27 :: Controller+pattern LSB27 = Controller 59++pattern LSB28 :: Controller+pattern LSB28 = Controller 60++pattern LSB29 :: Controller+pattern LSB29 = Controller 61++pattern LSB30 :: Controller+pattern LSB30 = Controller 62++pattern LSB31 :: Controller+pattern LSB31 = Controller 63++pattern DamperPedal :: Controller+pattern DamperPedal = Controller 64++pattern Portamento :: Controller+pattern Portamento = Controller 65++pattern Sostenuto :: Controller+pattern Sostenuto = Controller 66++pattern SoftPedal :: Controller+pattern SoftPedal = Controller 67++pattern LegatoFootswitch :: Controller+pattern LegatoFootswitch = Controller 68++pattern Hold2 :: Controller+pattern Hold2 = Controller 69++pattern SoundController1 :: Controller+pattern SoundController1 = Controller 70++-- | Synonym for 'SoundController1'+pattern SoundVariation :: Controller+pattern SoundVariation = Controller 70++pattern SoundController2 :: Controller+pattern SoundController2 = Controller 71++-- | Synonym for 'SoundController2'+pattern Timbre :: Controller+pattern Timbre = Controller 71++pattern SoundController3 :: Controller+pattern SoundController3 = Controller 72++-- | Synonym for 'SoundController3'+pattern ReleaseTime :: Controller+pattern ReleaseTime = Controller 72++pattern SoundController4 :: Controller+pattern SoundController4 = Controller 73++-- | Synonym for 'SoundController4'+pattern AttackTime :: Controller+pattern AttackTime = Controller 73++pattern SoundController5 :: Controller+pattern SoundController5 = Controller 74++-- | Synonym for 'SoundController5'+pattern Brightness :: Controller+pattern Brightness = Controller 74++pattern SoundControllers6 :: Controller+pattern SoundControllers6 = Controller 75++pattern SoundControllers7 :: Controller+pattern SoundControllers7 = Controller 76++pattern SoundControllers8 :: Controller+pattern SoundControllers8 = Controller 77++pattern SoundControllers9 :: Controller+pattern SoundControllers9 = Controller 78++pattern SoundControllers10 :: Controller+pattern SoundControllers10 = Controller 79++pattern GeneralPurposeController5 :: Controller+pattern GeneralPurposeController5 = Controller 80++pattern GeneralPurposeController6 :: Controller+pattern GeneralPurposeController6 = Controller 81++pattern GeneralPurposeController7 :: Controller+pattern GeneralPurposeController7 = Controller 82++pattern GeneralPurposeController8 :: Controller+pattern GeneralPurposeController8 = Controller 83++pattern PortamentoControl :: Controller+pattern PortamentoControl = Controller 84++pattern Effects1Depth :: Controller+pattern Effects1Depth = Controller 91++-- | Synonym for 'Effects1Depth'+pattern ExternalEffectsDepth :: Controller+pattern ExternalEffectsDepth = Controller 91++pattern Effects2Depth :: Controller+pattern Effects2Depth = Controller 92++-- | Synonym for 'Effects2Depth'+pattern TremoloDepth :: Controller+pattern TremoloDepth = Controller 92++pattern Effects3Depth :: Controller+pattern Effects3Depth = Controller 93++-- | Synonym for 'Effects3Depth'+pattern ChorusDepth :: Controller+pattern ChorusDepth = Controller 93++pattern Effects4Depth :: Controller+pattern Effects4Depth = Controller 94++-- | Synonym for 'Effects4Depth'+pattern CelesteDepth :: Controller+pattern CelesteDepth = Controller 94++pattern Effects5Depth :: Controller+pattern Effects5Depth = Controller 95++-- | Synonym for 'Effects5Depth'+pattern PhaserDepth :: Controller+pattern PhaserDepth = Controller 95++pattern DataIncrement :: Controller+pattern DataIncrement = Controller 96++pattern DataDecrement :: Controller+pattern DataDecrement = Controller 97++pattern UnRegisteredParameterNumberLSB :: Controller+pattern UnRegisteredParameterNumberLSB = Controller 98++pattern UnRegisteredParameterNumberMSB :: Controller+pattern UnRegisteredParameterNumberMSB = Controller 99++pattern RegisteredParameterNumberLSB :: Controller+pattern RegisteredParameterNumberLSB = Controller 100++pattern RegisteredParameterNumberMSB :: Controller+pattern RegisteredParameterNumberMSB = Controller 101
+ src/Sound/MIDI/Parser.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE LambdaCase #-}+-- | Parsers for 'MidiMessage' and its components, implemented as Attoparsec+-- parsers. See "Data.Attoparsec.ByteString" for how to run them. In most common+-- use cases, the 'decodeMidi' function in "Sound.MIDI" should suffice.+module Sound.MIDI.Parser where++import Control.Applicative+import Sound.MIDI.Types+import Data.Bits+import Data.Word+import Data.Attoparsec.ByteString+import qualified Data.ByteString as B++import Prelude hiding (take)++midiMessage :: Parser MidiMessage+midiMessage = go =<< peekWord8'+    where go x = case x .&. 0xF0 of+                     0xB0 -> ChannelMode <$> channelMode +                         <|> ChannelVoice <$> channelVoice+                     0xF0 -> system x+                     _    -> ChannelVoice <$> channelVoice+          system x+              | x == 0xF0 = SystemExclusive <$> systemExclusive+              | x <= 0xF7 = SystemCommon <$> systemCommon+              | otherwise = SystemRealTime <$> systemRealTime++skipToStatus :: Parser ()+skipToStatus = skipWhile (not . flip testBit 7)++channelVoice :: Parser ChannelVoice+channelVoice = go =<< peekWord8'+    where go x = case x .&. 0xF0 of+                     0x80 -> noteOff+                     0x90 -> noteOn+                     0xA0 -> aftertouch+                     0xB0 -> controlChange+                     0xC0 -> patchChange+                     0xD0 -> channelPressure+                     0xE0 -> pitchBend+                     _    -> empty++channelMessage :: Word8 -> (Word8 -> Parser a) -> Parser a+channelMessage header p = do+    status <- anyWord8+    let upper = unsafeShiftR status 4+        lower = status .&. 0x0F+    if upper == header then p lower else empty+{-# INLINE channelMessage #-}++noteOff :: Parser ChannelVoice+noteOff = channelMessage 0x08 $ \c ->+    NoteOff (Channel c) <$> pitch <*> velocity++noteOn :: Parser ChannelVoice+noteOn = channelMessage 0x09 $ \c ->+    NoteOn (Channel c) <$> pitch <*> velocity++aftertouch :: Parser ChannelVoice+aftertouch = channelMessage 0x0A $ \c ->+    Aftertouch (Channel c) <$> pitch <*> touch++controlChange :: Parser ChannelVoice+controlChange = channelMessage 0x0B $ \c ->+    ControlChange (Channel c) <$> controller <*> anyWord8++patchChange :: Parser ChannelVoice+patchChange = channelMessage 0x0C $ \c ->+    PatchChange (Channel c) <$> patch++channelPressure :: Parser ChannelVoice+channelPressure = channelMessage 0x0D $ \c ->+    ChannelPressure (Channel c) <$> touch++pitchBend :: Parser ChannelVoice+pitchBend = channelMessage 0x0E $ \c ->+    PitchBend (Channel c) <$> anyWord14++anyWord14 :: Parser Word16+anyWord14 = go <$> take 2+    where go x = let l = x `B.index` 0+                     m = x `B.index` 1+                  in unsafeShiftL (fromIntegral m) 7 + fromIntegral l++channelMode :: Parser ChannelMode+channelMode = channelMessage 0x0B $ \c -> anyWord8 >>= \case+    0x78 -> AllSoundOff (Channel c) <$ word8 0x00+    0x79 -> ResetAllControllers (Channel c) <$ word8 0x00+    0x7A -> LocalControl (Channel c) <$> bool'+    0x7B -> AllNotesOff (Channel c) <$ word8 0x00+    0x7C -> OmniOff (Channel c) <$ word8 0x00+    0x7D -> OmniOn (Channel c) <$ word8 0x00+    0x7E -> MonoOn (Channel c) <$> anyWord8+    0x7F -> PolyOn (Channel c) <$ word8 0x00+    _    -> empty++    where bool' = anyWord8 >>= \case+                      0x00 -> pure False+                      0x7f -> pure True+                      _    -> empty++systemCommon :: Parser SystemCommon+systemCommon = peekWord8' >>= \case+    0xF1 -> mtcQuarter+    0xF2 -> songPosition+    0xF3 -> songSelect+    0xF6 -> tuneRequest+    0xF7 -> eox+    _    -> empty++mtcQuarter :: Parser SystemCommon+mtcQuarter = MTCQuarter <$> (word8 0xF1 *> anyWord8) ++songPosition :: Parser SystemCommon+songPosition = SongPosition <$> (word8 0xF2 *> (PositionPointer <$> anyWord14))++songSelect :: Parser SystemCommon+songSelect = SongSelect <$> (word8 0xF3 *> anyWord8)++tuneRequest :: Parser SystemCommon+tuneRequest = TuneRequest <$ word8 0xF6++eox :: Parser SystemCommon+eox = EOX <$ word8 0xF7++systemRealTime :: Parser SystemRealTime+systemRealTime = anyWord8 >>= \case+    0xF8 -> pure TimingClock +    0xFA -> pure Start +    0xFB -> pure Continue +    0xFC -> pure Stop +    0xFE -> pure ActiveSensing +    0xFF -> pure SystemReset +    _    -> empty++systemExclusive :: Parser SystemExclusive+systemExclusive = Exclusive+    <$> (word8 0xF0 *> vendorId) +    <*> takeTill (`testBit` 7)++vendorId :: Parser VendorId+vendorId = longId <|> shortId+    where longId  = VendorIdLong  <$> (word8 0x00 *> anyWord8) <*> anyWord8+          shortId = VendorIdShort <$> anyWord8++-- | Parse a 'Pitch', no check for bit 7 is performed!+pitch :: Parser Pitch+pitch = Pitch <$> anyWord8++-- | Parse a 'Pitch', no check for bit 7 is performed!+patch :: Parser Patch+patch = Patch <$> anyWord8++-- | Parse a 'Velocity', no check for bit 7 is performed!+velocity :: Parser Velocity+velocity = Velocity <$> anyWord8++-- | Parse a 'Touch', no check for bit 7 is performed!+touch :: Parser Touch+touch = Touch <$> anyWord8++-- | Parse a 'Controller', no check for bit 7 is performed!+controller :: Parser Controller+controller = Controller <$> anyWord8
+ src/Sound/MIDI/Serialize.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE LambdaCase #-}+-- | ByteString builders for MIDI messages and their components. For information+-- on how to use the resulting 'Builder's, see "Data.ByteString.Builder". The+-- type signatures in this module should serve as sufficient documentation. For+-- most use cases the 'encodeMidi' function in "Sound.MIDI" should suffice.+module Sound.MIDI.Serialize where++import Sound.MIDI.Types+import Data.ByteString.Builder+import Data.Monoid+import Data.Word+import Data.Bits++midiMessage :: MidiMessage -> Builder+midiMessage = \case+    ChannelVoice x    -> channelVoice x+    ChannelMode x     -> channelMode x+    SystemCommon x    -> systemCommon x+    SystemRealTime x  -> systemRealTime x+    SystemExclusive x -> systemExclusive x++channelVoice :: ChannelVoice -> Builder+channelVoice = \case+    NoteOff c p v -> +        channelStatus 0x80 c <> pitch p <> velocity v+    NoteOn c p v -> +        channelStatus 0x90 c <> pitch p <> velocity v+    Aftertouch c p t -> +        channelStatus 0xA0 c <> pitch p <> touch t+    ControlChange c n d -> +        channelStatus 0xB0 c <> controller n <> word8 d+    PatchChange c p -> +        channelStatus 0xC0 c <> patch p+    ChannelPressure c t -> +        channelStatus 0xD0 c <> touch t+    PitchBend c v -> +        channelStatus 0xE0 c <> word14 v++channelStatus :: Word8 -> Channel -> Builder+channelStatus p c = word8 $ p .|. getChannel c+{-# INLINE channelStatus #-}++-- | Build a 14 bit word as it is used in the MIDI specifications, i.e. it is+-- built as two 8 bit words with the 7th bit not set respectively.+word14 :: Word16 -> Builder+word14 v =+    let l = fromIntegral $ v .&. 0x007f+        m = fromIntegral $ unsafeShiftR (v .&. 0x3f80) 7+     in word8 l <> word8 m+{-# INLINE word14 #-}++channelMode :: ChannelMode -> Builder+channelMode = \case+    AllSoundOff c ->+        channelStatus 0xB0 c <> word8 0x78 <> word8 0x00+    ResetAllControllers c ->+        channelStatus 0xB0 c <> word8 0x79 <> word8 0x00+    LocalControl c b ->+        channelStatus 0xB0 c <> word8 0x7A <> bool' b+    AllNotesOff c ->+        channelStatus 0xB0 c <> word8 0x7B <> word8 0x00+    OmniOff c ->+        channelStatus 0xB0 c <> word8 0x7C <> word8 0x00+    OmniOn c ->+        channelStatus 0xB0 c <> word8 0x7D <> word8 0x00+    MonoOn c n ->+        channelStatus 0xB0 c <> word8 0x7E <> word8 n+    PolyOn c ->+        channelStatus 0xB0 c <> word8 0x7F <> word8 0x00++    where bool' True  = word8 0x7F+          bool' False = word8 0x00++systemCommon :: SystemCommon -> Builder+systemCommon = \case+    MTCQuarter v -> word8 0xF1 <> word8 v+    SongPosition pp -> word8 0xF2 <> word14 (getPositionPointer pp)+    SongSelect x -> word8 0xF3 <> word8 x+    TuneRequest -> word8 0xF6+    EOX -> word8 0xF7++systemRealTime :: SystemRealTime -> Builder+systemRealTime = \case+    TimingClock -> word8 0xF8+    Start -> word8 0xFA+    Continue -> word8 0xFB+    Stop -> word8 0xFC+    ActiveSensing -> word8 0xFE+    SystemReset -> word8 0xFF++systemExclusive :: SystemExclusive -> Builder+systemExclusive (Exclusive v x) =+    word8 0xF0 <> vendorId v <> byteString x <> systemCommon EOX++vendorId :: VendorId -> Builder+vendorId (VendorIdShort x)  = word8 x+vendorId (VendorIdLong a b) = word8 0x00 <> word8 a <> word8 b++pitch :: Pitch -> Builder+pitch = word8 . getPitch+{-# INLINE pitch #-}++patch :: Patch -> Builder+patch = word8 . getPatch+{-# INLINE patch #-}++velocity :: Velocity -> Builder+velocity = word8 . getVelocity+{-# INLINE velocity #-}++touch :: Touch -> Builder+touch = word8 . getTouch+{-# INLINE touch #-}++controller :: Controller -> Builder+controller = word8 . getController+{-# INLINE controller #-}
+ src/Sound/MIDI/Types.hs view
@@ -0,0 +1,216 @@+{-# LANGUAGE DeriveGeneric #-}+{-# OPTIONS_GHC -funbox-strict-fields #-}+module Sound.MIDI.Types+(+    -- * MIDI messages+    MidiMessage (..),++    -- * Basic MIDI types+    ChannelVoice (..),+    ChannelMode (..),+    SystemCommon (..),+    SystemRealTime (..),+    SystemExclusive (..),++    VendorId (..),++    -- * Numeric MIDI data+    --+    -- | Only use the direct constructors when you can assure that the values+    -- fit into 7 bits! In general you should prefer the smart constructors. For+    -- values outside of the 7 bit range, the numbers should generally wrap+    -- around, but no guarantees are made!+    Channel (..),+    mkChannel,+    Pitch (..),+    mkPitch,+    middleC,+    Patch (..),+    mkPatch,+    Velocity (..),+    mkVelocity,+    Touch (..),+    mkTouch,+    Controller (..),+    mkController,+    PositionPointer (..),+    mkPositionPointer,+    toClocks,++    -- * Helper functions+    to4Bit,+    to7Bit,+    to14Bit+)+where++import Data.Word+import Data.ByteString (ByteString)+import Data.Bits+import GHC.Generics++-- | A data type representing midi messages. Messages can be categorized into 5+-- subcategories+--+--     1. __Channel Voice Messages__. Start, stop, or alter sounds being played.+--     2. __Channel Mode Messages__. Control messages affecting the entire+--     channel.+--     3. __System Real-Time Messages__. Used by sequencers to regulate and+--     synchronize timing.+--     4. __System Common Messages__. Used for song selection, position+--     pointers, etc.+--     5. __System Exclusive Messages__. Used for device-specific extensions to+--     the MIDI protocol.+--+data MidiMessage+    = ChannelVoice ChannelVoice+    | ChannelMode ChannelMode+    | SystemCommon SystemCommon+    | SystemRealTime SystemRealTime+    | SystemExclusive SystemExclusive+    deriving (Eq, Show, Ord, Read, Generic)++-- | Type holding channel voice messages. Channel Voice messages transmit+-- real-time performance data over a single channel. Examples include "note-on"+-- messages which contain a MIDI note number that specifies the note's pitch, a+-- velocity value that indicates how forcefully the note was played, and the+-- channel number; "note-off" messages that end a note; program change messages+-- that change a device's patch; and control changes that allow adjustment of an+-- instrument's parameters.+data ChannelVoice+    = NoteOff !Channel !Pitch !Velocity+    | NoteOn !Channel !Pitch !Velocity+    | Aftertouch !Channel !Pitch !Touch+    | ControlChange !Channel !Controller !Word8+    | PatchChange !Channel !Patch+    | ChannelPressure !Channel !Touch+    | PitchBend !Channel !Word16+    deriving (Eq, Show, Ord, Read, Generic)++-- | A type for channel mode messages. Mode messages determine how an instrument+-- will receive all subsequent voice messages. This includes whether the+-- receiver will play notes monophonically or polyphonically and whether it will+-- respond only to data sent on one specific voice channel or all of them.+data ChannelMode+    = AllSoundOff !Channel+    | ResetAllControllers !Channel+    | LocalControl !Channel !Bool+    | AllNotesOff !Channel+    | OmniOff !Channel+    | OmniOn !Channel+    | MonoOn !Channel !Word8+    | PolyOn !Channel+    deriving (Eq, Show, Ord, Read, Generic)++-- | A type for system common messages. System common messages are intended for+-- all receivers in the system.+data SystemCommon+    = MTCQuarter !Word8+    | SongPosition !PositionPointer+    | SongSelect !Word8+    | TuneRequest+    | EOX+    deriving (Eq, Show, Ord, Read, Generic)++-- | System real time messages. The MIDI System Real Time messages are used to+-- synchronize all of the MIDI clock-based equipment within a system, such as+-- sequencers and drum machines. Most of the System Real Time messages are+-- normally ignored by keyboard instruments and synthesizers. To help ensure+-- accurate timing, System Real Time messages are given priority over other+-- messages, and these single-byte messages may occur anywhere in the data+-- stream (a Real Time message may appear between the status byte and data byte+-- of some other MIDI message).+data SystemRealTime+    = TimingClock+    | Start+    | Continue+    | Stop+    | ActiveSensing+    | SystemReset+    deriving (Eq, Show, Ord, Read, Generic)++-- | System exclusive messages. System Exclusive messages may be used to send+-- data such as patch parameters or sample data between MIDI devices.+-- Manufacturers of MIDI equipment may define their own formats for System+-- Exclusive data. Manufacturers are granted unique identification (ID) numbers+-- by the MMA or the JMSC, and the manufacturer ID number is included as part of+-- the System Exclusive message. See 'VendorId'.+--+-- The representation used here is deliberately generic. Special sets of system+-- exclusive messages can be implemented on top of this type.+data SystemExclusive+    = Exclusive !VendorId ByteString+    deriving (Eq, Show, Ord, Read, Generic)++-- | Data type encapsulating vendor ID numbers as used in 'SystemExclusive'.+-- They have one of two possible formats:+--+-- 1. A one byte ID (represented by 'VendorIdShort')+-- 2. A three byte ID, which must begin with @0x00@. ('VendorIdLong')+data VendorId+    = VendorIdShort !Word8+    | VendorIdLong  !Word8 !Word8+    deriving (Eq, Show, Ord, Read, Generic)++to7Bit :: Integral a => a -> Word8+to7Bit = (.&. 0x7F) . fromIntegral++to4Bit :: Integral a => a -> Word8+to4Bit = (.&. 0x0F) . fromIntegral++newtype Channel = Channel { getChannel :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkChannel :: Integral a => a -> Channel+mkChannel = Channel . to4Bit++newtype Pitch = Pitch { getPitch :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkPitch :: Integral a => a -> Pitch +mkPitch = Pitch . to7Bit++-- | The middle C on a piano as defined by the MIDI specification. This can+-- serve as a reference value for working with pitches.+middleC :: Pitch+middleC = Pitch 60++newtype Velocity = Velocity { getVelocity :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkVelocity :: Integral a => a -> Velocity +mkVelocity = Velocity . to7Bit++newtype Touch = Touch { getTouch :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkTouch :: Integral a => a -> Touch +mkTouch = Touch . to7Bit++newtype Controller = Controller { getController :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkController :: Integral a => a -> Controller +mkController = Controller . to7Bit++newtype Patch = Patch { getPatch :: Word8 }+    deriving (Eq, Show, Ord, Read)++mkPatch :: Integral a => a -> Patch +mkPatch = Patch . to7Bit++newtype PositionPointer = PositionPointer { getPositionPointer :: Word16 }+    deriving (Eq, Show, Ord, Read)++to14Bit :: Integral a => a -> Word16+to14Bit = (.&. 0x3FFF) . fromIntegral++mkPositionPointer :: Integral a => a -> PositionPointer+mkPositionPointer = PositionPointer . to14Bit++-- | Convert a 'PositionPointer', used to indicate song position, to the MIDI+-- clock. Song Position Pointer is always multiplied by 6 times the MIDI clocks+-- (F8H). Thus the smallest Song Position change is 6 MIDI clocks, or 1/16 note.+toClocks :: PositionPointer -> Int+toClocks = (* 6) . fromIntegral . getPositionPointer+{-# INLINEABLE toClocks #-}
+ test/Test.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -Wno-orphans #-}+module Main where++import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as B+import qualified Data.Attoparsec.ByteString as A+import Data.ByteString.Lazy (toStrict)+import Data.Word+import Test.Tasty+import Test.Tasty.QuickCheck+import Test.Tasty.Hspec+import Test.Hspec.Attoparsec++import Sound.MIDI+import Sound.MIDI.Types+import qualified Sound.MIDI.Serialize as S+import qualified Sound.MIDI.Parser as P++main :: IO ()+main = do+    st <- specTests+    defaultMain (testGroup "Tests" [ tests, st ])++tests :: TestTree+tests = testGroup "QuickCheck"+    [ testProperty "word14: parse . serialize == id" $+          \(w16 :: Word16) ->+              let w14  = to14Bit w16+                  w14' = A.parseOnly P.anyWord14 . toStrict . B.toLazyByteString +                       . S.word14 $ w14+               in Right w14 == w14'+    , testProperty "parse . serialize == id" $+          \(msg :: MidiMessage) ->+              decodeMidi1 (encodeMidi1' msg) == Right msg+    , testProperty "parse . serialize == id (long)" $+          \(msg :: NonEmptyList MidiMessage) ->+              let msg' = getNonEmpty msg+               in fmap mergeEOX (decodeMidi (encodeMidi' msg')) == Right msg'+    ]++-- | The parser will separate EOXs by design, hence they need to be merged back+-- into the exclusive message during property testing.+mergeEOX :: [MidiMessage] -> [MidiMessage]+mergeEOX [] = []+mergeEOX (x@(SystemExclusive _) : SystemCommon EOX : xs) = x : mergeEOX xs+mergeEOX (x:xs) = x : mergeEOX xs++specTests :: IO TestTree+specTests = testSpec "Hspec" . sequence_ . map go $ specCases+    where go (SC n msg str) =+              describe n $ do+                  it "parses" $ decodeMidi1 str `shouldParse` msg+                  +                  it "serializes" $ encodeMidi1' msg `shouldBe` str++data SpecCase = SC String MidiMessage B.ByteString++specCases :: [SpecCase]+specCases = +    [ -- Channel Voice tests+      SC "Note Off"+        (ChannelVoice (NoteOff (Channel 0) (Pitch 60) (Velocity 127)))+        "\x80\x3c\x7f"+    , SC "Note On"+        (ChannelVoice (NoteOn (Channel 0) (Pitch 60) (Velocity 0)))+        "\x90\x3c\x00"+    , SC "Aftertouch"+        (ChannelVoice (Aftertouch (Channel 1) (Pitch 0) (Touch 64)))+        "\xa1\x00\x40"+    , SC "Control Change"+        (ChannelVoice (ControlChange (Channel 0) (Controller 4) (to7Bit 0)))+        "\xb0\x04\x00"+    , SC "Patch Change"+        (ChannelVoice (PatchChange (Channel 4) (Patch 8)))+        "\xc4\x08"+    , SC "Channel Pressure"+        (ChannelVoice (ChannelPressure (Channel 4) (Touch 64)))+        "\xd4\x40"+    , SC "Pitch Bend"+        (ChannelVoice (PitchBend (Channel 0) (to14Bit 8)))+        "\xe0\x08\x00"+      -- Channel Mode test+    , SC "All Sound Off"+        (ChannelMode (AllSoundOff (Channel 0)))+        "\xb0\x78\x00"+    , SC "Reset Controllers"+        (ChannelMode (ResetAllControllers (Channel 0)))+        "\xb0\x79\x00"+    , SC "LocalControl True"+        (ChannelMode (LocalControl (Channel 1) True))+        "\xb1\x7a\x7f"+    , SC "LocalControl False"+        (ChannelMode (LocalControl (Channel 1) False))+        "\xb1\x7a\x00"+    , SC "All Notes Off"+        (ChannelMode (AllNotesOff (Channel 0)))+        "\xb0\x7b\x00"+    , SC "Omni Off"+        (ChannelMode (OmniOff (Channel 0)))+        "\xb0\x7c\x00"+    , SC "Omni On"+        (ChannelMode (OmniOn (Channel 0)))+        "\xb0\x7d\x00"+    , SC "Mono On"+        (ChannelMode (MonoOn (Channel 0) (to7Bit 3)))+        "\xb0\x7e\x03"+    , SC "Poly On"+        (ChannelMode (PolyOn (Channel 0)))+        "\xb0\x7f\x00"+      -- System Common+    , SC "MTC Quarter"+        (SystemCommon (MTCQuarter (to7Bit 0)))+        "\xf1\x00"+    , SC "Song Position"+        (SystemCommon (SongPosition (mkPositionPointer 8)))+        "\xf2\x08\x00"+    , SC "Song Select"+        (SystemCommon (SongSelect (to7Bit 0)))+        "\xf3\x00"+    , SC "Tune Request"+        (SystemCommon TuneRequest)+        "\xf6"+    , SC "EOX"+        (SystemCommon EOX)+        "\xf7"+      -- System Real Time+    , SC "Timing Clock"+        (SystemRealTime TimingClock)+        "\xf8"+    , SC "Start"+        (SystemRealTime Start)+        "\xfa"+    , SC "Continue"+        (SystemRealTime Continue)+        "\xfb"+    , SC "Stop"+        (SystemRealTime Stop)+        "\xfc"+    , SC "Active Sensing"+        (SystemRealTime ActiveSensing)+        "\xfe"+    , SC "System Reset"+        (SystemRealTime SystemReset)+        "\xff"+      -- System Exclusive+    , SC "System Exclusive, short vendor"+        (SystemExclusive (Exclusive (VendorIdShort (to7Bit 8)) "000"))+        "\xf0\x08\x30\x30\x30\xf7"+    , SC "System Exclusive, long vendor"+        (SystemExclusive (Exclusive (VendorIdLong (to7Bit 8) (to7Bit 8)) "000"))+        "\xf0\x00\x08\x08\x30\x30\x30\xf7"+    ]++{- Arbitrary instances for MidiMessage -}+instance Arbitrary MidiMessage where+    arbitrary = oneof [ ChannelVoice    <$> arbitrary+                      , ChannelMode     <$> arbitrary+                      , SystemCommon    <$> arbitrary+                      , SystemRealTime  <$> arbitrary+                      , SystemExclusive <$> arbitrary ]++instance Arbitrary ChannelVoice where+    arbitrary = oneof [ NoteOff <$> arbitrary <*> arbitrary <*> arbitrary+                      , NoteOn <$> arbitrary <*> arbitrary <*> arbitrary+                      , Aftertouch <$> arbitrary <*> arbitrary <*> arbitrary+                      , ControlChange <$> arbitrary <*> arbitrary +                                      <*> (to7Bit <$> (arbitrary :: Gen Word8))+                      , PatchChange <$> arbitrary <*> arbitrary+                      , ChannelPressure <$> arbitrary <*> arbitrary+                      , PitchBend <$> arbitrary <*> +                            (to14Bit <$> (arbitrary :: Gen Word16)) ]++instance Arbitrary ChannelMode where+    arbitrary = oneof [ AllSoundOff <$> arbitrary+                      , ResetAllControllers <$> arbitrary+                      , LocalControl <$> arbitrary <*> arbitrary+                      , AllNotesOff <$> arbitrary+                      , OmniOff <$> arbitrary+                      , OmniOn <$> arbitrary+                      , MonoOn <$> arbitrary +                               <*> (to7Bit <$> (arbitrary :: Gen Word8))+                      , PolyOn <$> arbitrary ]++instance Arbitrary SystemCommon where+    arbitrary = oneof [ MTCQuarter <$> (to7Bit <$> (arbitrary :: Gen Word8))+                      , SongPosition <$> arbitrary+                      , SongSelect <$> (to7Bit <$> (arbitrary :: Gen Word8))+                      , pure TuneRequest+                      , pure EOX ]++instance Arbitrary SystemExclusive where+    arbitrary = Exclusive <$> arbitrary <*> +        (B.pack . map to7Bit . getNonEmpty +            <$> (arbitrary :: Gen (NonEmptyList Word8)))++instance Arbitrary SystemRealTime where+    arbitrary = elements [ TimingClock, Start, Continue, Stop+                         , ActiveSensing, SystemReset ]++instance Arbitrary VendorId where+    arbitrary = oneof [ VendorIdShort <$> (to7Bit' <$> (arbitrary :: Gen Word8))+                      , VendorIdLong  <$> (to7Bit <$> (arbitrary :: Gen Word8))+                                      <*> (to7Bit' <$> (arbitrary :: Gen Word8))+                      ]+        where to7Bit' x = if to7Bit x == 0 then 1 else to7Bit x++instance Arbitrary Channel where+    arbitrary = mkChannel <$> (arbitrary :: Gen Word8)++instance Arbitrary Pitch where+    arbitrary = mkPitch <$> (arbitrary :: Gen Word8)++instance Arbitrary Velocity where+    arbitrary = mkVelocity <$> (arbitrary :: Gen Word8)++instance Arbitrary Touch where+    arbitrary = mkTouch <$> (arbitrary :: Gen Word8)++instance Arbitrary Controller where+    arbitrary = do+        x <- to7Bit <$> (arbitrary :: Gen Word8)+        let x' = if x >= 0x78 && x <= 0x7F+                 then 0x00+                 else x+        pure $ mkController x'++instance Arbitrary Patch where+    arbitrary = mkPatch <$> (arbitrary :: Gen Word8)++instance Arbitrary PositionPointer where+    arbitrary = mkPositionPointer <$> (arbitrary :: Gen Word16)