dahdit-midi 0.5.5 → 0.6.0
raw patch · 3 files changed
+118/−84 lines, 3 filesdep +hedgehogdep +prop-unitdep −falsifydep −tastydep ~bytestringdep ~dahditdep ~daytripperPVP ok
version bump matches the API change (PVP)
Dependencies added: hedgehog, prop-unit
Dependencies removed: falsify, tasty
Dependency ranges changed: bytestring, dahdit, daytripper, primitive, text
API changes (from Hackage documentation)
Files
- dahdit-midi.cabal +14/−14
- test/Main.hs +15/−16
- test/Test/Dahdit/Midi/GenDefault.hs +89/−54
dahdit-midi.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack name: dahdit-midi-version: 0.5.5+version: 0.6.0 synopsis: MIDI and OSC parsing/printing with dahdit description: Please see the README on GitHub at <https://github.com/ejconlon/dahdit#readme> homepage: https://github.com/ejconlon/dahdit#readme@@ -16,7 +16,7 @@ license: BSD3 build-type: Simple tested-with:- GHC == 9.2.7+ GHC == 9.8.4 extra-source-files: README.md @@ -64,15 +64,15 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds build-depends: base >=4.12 && <5- , bytestring ==0.11.*+ , bytestring >=0.11 && <0.13 , containers ==0.6.*- , dahdit ==0.5.*+ , dahdit ==0.6.* , data-sword >=0.2.0.3 && <0.3 , hashable ==1.4.* , nanotime ==0.3.* , newtype ==0.2.*- , primitive >=0.7 && <0.9- , text >=1.2 && <2.1+ , primitive >=0.7 && <0.10+ , text >=1.2 && <2.2 , vector >=0.12 && <0.14 default-language: GHC2021 @@ -113,21 +113,21 @@ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.12 && <5- , bytestring ==0.11.*+ , bytestring >=0.11 && <0.13 , containers ==0.6.*- , dahdit ==0.5.*+ , dahdit ==0.6.* , dahdit-midi , dahdit-test , data-sword >=0.2.0.3 && <0.3- , daytripper+ , daytripper ==0.4.* , directory- , falsify , filepath , hashable ==1.4.*+ , hedgehog ==1.5.* , nanotime ==0.3.* , newtype ==0.2.*- , primitive >=0.7 && <0.9- , tasty- , text >=1.2 && <2.1+ , primitive >=0.7 && <0.10+ , prop-unit ==0.2.*+ , text >=1.2 && <2.2 , vector >=0.12 && <0.14 default-language: GHC2021
test/Main.hs view
@@ -2,6 +2,7 @@ module Main (main) where +import Control.Monad.IO.Class (MonadIO) import Dahdit (Binary (..), ByteCount (..), GetError, StaticByteSized, decodeFileEnd) import Dahdit.Midi.Binary ( MidiInt14@@ -18,15 +19,15 @@ import Data.Proxy (Proxy (..)) import Data.Sequence qualified as Seq import Data.Word (Word8)+import PropUnit (MonadTest, PropertyT, testGroup, testMain) import System.Directory (listDirectory) import System.FilePath (takeExtension, (</>)) import Test.Dahdit.Daytripper (expectBytes, expectCodecErr, expectCodecOk, expectStatic) import Test.Dahdit.Midi.GenDefault (genDefaultI)-import Test.Daytripper (Expect, MonadExpect, RT, mkFileRT, mkPropRT, mkUnitRT, testRT)-import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Daytripper (Expect, RT, mkFileRT, mkPropRT, mkUnitRT, testRT) expectStaticOk- :: (MonadExpect m, Binary a, Eq a, Show a, StaticByteSized a) => Expect m a ByteString (Either GetError a)+ :: (MonadTest m, MonadIO m, Binary a, Eq a, Show a, StaticByteSized a) => Expect m a ByteString (Either GetError a) expectStaticOk = expectStatic expectCodecOk genCases :: [RT]@@ -71,9 +72,6 @@ , mkPropRT "Packet" expectCodecOk (genDefaultI @MO.Packet) ] -testGenCases :: TestTree-testGenCases = testGroup "Gen" (fmap testRT genCases)- findFiles :: IO [FilePath] findFiles = do let tdDir = "testdata"@@ -90,7 +88,7 @@ let xs = fmap (\p -> BSC.pack ("/test-" ++ p ++ "-")) ["illegal", "non-midi", "corrupt"] in any (`BSC.isInfixOf` BSC.pack fn) xs -suiteFileExpect :: (Binary a, Eq a, Show a) => FilePath -> Expect IO a ByteString (Either GetError a)+suiteFileExpect :: (Binary a, Eq a, Show a) => FilePath -> Expect (PropertyT IO) a ByteString (Either GetError a) suiteFileExpect fn = if shouldFail fn then expectCodecErr@@ -127,12 +125,13 @@ main = do files <- findFiles fileCases <- traverse suiteFileRT files- let testFileCases = testGroup "File" (fmap testRT fileCases)- testUnitCases = testGroup "Unit" (fmap testRT unitCases)- defaultMain $- testGroup- "Midiot"- [ testGenCases- , testUnitCases- , testFileCases- ]+ testMain $ \lim ->+ let testGenCases = testGroup "Gen" (fmap (testRT lim) genCases)+ testFileCases = testGroup "File" (fmap (testRT lim) fileCases)+ testUnitCases = testGroup "Unit" (fmap (testRT lim) unitCases)+ in testGroup+ "dahdit-midi"+ [ testGenCases+ , testUnitCases+ , testFileCases+ ]
test/Test/Dahdit/Midi/GenDefault.hs view
@@ -13,13 +13,14 @@ import Data.ByteString.Short qualified as BSS import Data.List.NonEmpty qualified as NE import Data.Proxy (Proxy (..))-import Data.ShortWord (Int7, Word7) import Data.Text qualified as T+import Hedgehog (Gen)+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range import Nanotime (NtpTime (..))+import PropUnit (GenDefault (..), genDefaultEnum, genDefaultGeneric) import Test.Dahdit.GenDefault ( DahditTag- , ViaSigned (..)- , ViaUnsigned (..) , genFractional , genList , genSBS@@ -28,10 +29,6 @@ , genSum , genUnsigned )-import Test.Falsify.GenDefault (GenDefault (..), ViaEnum (..), ViaGeneric (..))-import Test.Falsify.Generator (Gen)-import Test.Falsify.Generator qualified as FG-import Test.Falsify.Range qualified as FR data P @@ -42,16 +39,20 @@ -- Binary -deriving via (ViaUnsigned Word7) instance GenDefault I MB.MidiWord7+instance GenDefault I MB.MidiWord7 where+ genDefault _ = fmap MB.MidiWord7 genUnsigned -deriving via (ViaSigned Int7) instance GenDefault I MB.MidiInt7+instance GenDefault I MB.MidiInt7 where+ genDefault _ = fmap MB.MidiInt7 genSigned -deriving via (ViaUnsigned MB.Word14) instance GenDefault I MB.MidiWord14+instance GenDefault I MB.MidiWord14 where+ genDefault _ = fmap MB.MidiWord14 genUnsigned -deriving via (ViaSigned MB.Int14) instance GenDefault I MB.MidiInt14+instance GenDefault I MB.MidiInt14 where+ genDefault _ = fmap MB.MidiInt14 genSigned instance GenDefault I MB.VarWord where- genDefault _ = fmap MB.VarWord (FG.inRange (FR.between (0, 0x00FFFFFF)))+ genDefault _ = fmap MB.VarWord (Gen.integral (Range.constant 0 0x00FFFFFF)) -- OscAddr @@ -59,31 +60,42 @@ instance GenDefault I MOA.RawAddrPat where genDefault _ = MOA.RawAddrPat . ("/" <>) . T.intercalate "/" <$> genList 1 3 g where- g = FG.choose (pure "x") (pure "y")+ g = Gen.element ["x", "y"] -- Midi -deriving via (ViaEnum MM.Channel) instance GenDefault I MM.Channel+instance GenDefault I MM.Channel where+ genDefault _ = genDefaultEnum Proxy -deriving newtype instance GenDefault I MM.ChannelCount+instance GenDefault I MM.ChannelCount where+ genDefault = fmap MM.ChannelCount . genDefault -deriving newtype instance GenDefault I MM.Note+instance GenDefault I MM.Note where+ genDefault = fmap MM.Note . genDefault -deriving newtype instance GenDefault I MM.Velocity+instance GenDefault I MM.Velocity where+ genDefault = fmap MM.Velocity . genDefault -deriving newtype instance GenDefault I MM.ControlNum+instance GenDefault I MM.ControlNum where+ genDefault = fmap MM.ControlNum . genDefault -deriving newtype instance GenDefault I MM.ControlVal+instance GenDefault I MM.ControlVal where+ genDefault = fmap MM.ControlVal . genDefault -deriving newtype instance GenDefault I MM.Pressure+instance GenDefault I MM.Pressure where+ genDefault = fmap MM.Pressure . genDefault -deriving newtype instance GenDefault I MM.ProgramNum+instance GenDefault I MM.ProgramNum where+ genDefault = fmap MM.ProgramNum . genDefault -deriving newtype instance GenDefault I MM.PitchBend+instance GenDefault I MM.PitchBend where+ genDefault = fmap MM.PitchBend . genDefault -deriving newtype instance GenDefault I MM.Song+instance GenDefault I MM.Song where+ genDefault = fmap MM.Song . genDefault -deriving newtype instance GenDefault I MM.Position+instance GenDefault I MM.Position where+ genDefault = fmap MM.Position . genDefault instance GenDefault I MM.ShortManf where genDefault p = go@@ -94,28 +106,38 @@ then go else pure (MM.ShortManf i) -deriving newtype instance (GenDefault I MM.LongManf)+instance (GenDefault I MM.LongManf) where+ genDefault = fmap MM.LongManf . genDefault -deriving via (ViaGeneric I MM.Manf) instance GenDefault I MM.Manf+instance GenDefault I MM.Manf where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.QuarterTimeUnit) instance GenDefault I MM.QuarterTimeUnit+instance GenDefault I MM.QuarterTimeUnit where+ genDefault = genDefaultGeneric instance GenDefault I MM.QuarterTime where genDefault p = MM.QuarterTime <$> genDefault p <*> genUnsigned -deriving via (ViaEnum MM.ChanStatusType) instance GenDefault I MM.ChanStatusType+instance GenDefault I MM.ChanStatusType where+ genDefault = genDefaultEnum -deriving via (ViaEnum MM.CommonStatus) instance GenDefault I MM.CommonStatus+instance GenDefault I MM.CommonStatus where+ genDefault = genDefaultEnum -deriving via (ViaEnum MM.RtStatus) instance GenDefault I MM.RtStatus+instance GenDefault I MM.RtStatus where+ genDefault = genDefaultEnum -deriving via (ViaGeneric I MM.ChanStatus) instance GenDefault I MM.ChanStatus+instance GenDefault I MM.ChanStatus where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.LiveStatus) instance GenDefault I MM.LiveStatus+instance GenDefault I MM.LiveStatus where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.RecStatus) instance GenDefault I MM.RecStatus+instance GenDefault I MM.RecStatus where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.ShortStatus) instance GenDefault I MM.ShortStatus+instance GenDefault I MM.ShortStatus where+ genDefault = genDefaultGeneric instance GenDefault I MM.ChanVoiceData where genDefault p = genCVD@@ -131,43 +153,53 @@ , MM.ChanVoiceChanAftertouch <$> genDefault p , MM.ChanVoicePitchBend <$> genDefault p ]- genCN = fmap (MM.ControlNum . MB.MidiWord7) (FG.inRange (FR.between (0x00, 0x77)))+ genCN = fmap (MM.ControlNum . MB.MidiWord7) (Gen.integral (Range.constant 0x00 0x77)) instance GenDefault I MM.MetaString where genDefault _ = fmap MM.MetaString (genSBS 0 3) -deriving via (ViaGeneric I MM.MetaData) instance GenDefault I MM.MetaData+instance GenDefault I MM.MetaData where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.ChanModeData) instance GenDefault I MM.ChanModeData+instance GenDefault I MM.ChanModeData where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.ChanData) instance GenDefault I MM.ChanData+instance GenDefault I MM.ChanData where+ genDefault = genDefaultGeneric -- Generate a bytestring not including the delimiter genPayload :: Gen ShortByteString genPayload = fmap (BSS.pack . fmap fromIntegral) (genList 0 3 (genDefault @I @MB.MidiWord7 (Proxy @I))) instance GenDefault I MM.UnivSysEx where- genDefault _ = MM.UnivSysEx <$> FG.choose (pure 0x7E) (pure 0x7F) <*> genPayload+ genDefault _ = MM.UnivSysEx <$> Gen.element [0x7E, 0x7F] <*> genPayload instance GenDefault I MM.ManfSysEx where genDefault p = MM.ManfSysEx <$> genDefault p <*> genPayload -deriving via (ViaGeneric I MM.SysExData) instance GenDefault I MM.SysExData+instance GenDefault I MM.SysExData where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.CommonData) instance GenDefault I MM.CommonData+instance GenDefault I MM.CommonData where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.LiveMsg) instance GenDefault I MM.LiveMsg+instance GenDefault I MM.LiveMsg where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.RecMsg) instance GenDefault I MM.RecMsg+instance GenDefault I MM.RecMsg where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.ShortMsg) instance GenDefault I MM.ShortMsg+instance GenDefault I MM.ShortMsg where+ genDefault = genDefaultGeneric -deriving via (ViaGeneric I MM.Event) instance GenDefault I MM.Event+instance GenDefault I MM.Event where+ genDefault = genDefaultGeneric instance GenDefault I MM.Track where genDefault = fmap MM.Track . genSeq 0 3 . genDefault -deriving via (ViaEnum MM.MidFileType) instance GenDefault I MM.MidFileType+instance GenDefault I MM.MidFileType where+ genDefault = genDefaultEnum instance GenDefault I MM.MidFile where genDefault p = MM.MidFile <$> genDefault p <*> genDefault p <*> genSeq 0 3 (genDefault p)@@ -177,24 +209,26 @@ -- Osc -deriving via (ViaEnum MO.DatumType) instance GenDefault I MO.DatumType+instance GenDefault I MO.DatumType where+ genDefault = genDefaultEnum -deriving newtype instance GenDefault I MO.Port+instance GenDefault I MO.Port where+ genDefault = fmap MO.Port . genDefault -deriving via (ViaGeneric I MO.PortMsg) instance GenDefault I MO.PortMsg+instance GenDefault I MO.PortMsg where+ genDefault = genDefaultGeneric instance GenDefault I MO.Sig where genDefault = fmap MO.Sig . genSeq 0 3 . genDefault instance GenDefault I MO.Datum where genDefault p =- foldr1- FG.choose+ Gen.choice [ MO.DatumInt32 <$> genSigned , MO.DatumInt64 <$> genSigned , MO.DatumFloat <$> genFractional , MO.DatumDouble <$> genFractional- , MO.DatumString . T.pack <$> genList 0 3 (FG.choose (pure 'x') (pure 'y'))+ , MO.DatumString . T.pack <$> genList 0 3 (Gen.element ['x', 'y']) , MO.DatumBlob <$> genSBS 0 3 , MO.DatumTime . NtpTime <$> genUnsigned , MO.DatumMidi <$> genDefault p@@ -204,6 +238,7 @@ genDefault p = MO.Msg <$> genDefault p <*> genSeq 0 3 (genDefault p) instance GenDefault I MO.Bundle where- genDefault p = MO.Bundle <$> (NtpTime <$> genUnsigned) <*> genSeq 0 3 (genDefault p)+ genDefault p = (MO.Bundle . NtpTime <$> genUnsigned) <*> genSeq 0 3 (genDefault p) -deriving via (ViaGeneric I MO.Packet) instance GenDefault I MO.Packet+instance GenDefault I MO.Packet where+ genDefault = genDefaultGeneric