dahdit-test 0.5.1 → 0.6.0

raw patch · 4 files changed

+144/−121 lines, 4 filesdep +hedgehogdep +prop-unitdep −falsifydep ~bytestringdep ~dahditdep ~daytripperPVP ok

version bump matches the API change (PVP)

Dependencies added: hedgehog, prop-unit

Dependencies removed: falsify

Dependency ranges changed: bytestring, dahdit, daytripper, tasty, text

API changes (from Hackage documentation)

Files

• dahdit-test.cabal +16/−14
• src/Test/Dahdit/Daytripper.hs +16/−14
• src/Test/Dahdit/GenDefault.hs +101/−84
• test/Main.hs +11/−9

@@ -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-test-version:        0.5.1+version:        0.6.0 synopsis:       Test utils for Dahdit serde description:    Please see the README on GitHub at <https://github.com/ejconlon/dahdit-test#readme> homepage:       https://github.com/ejconlon/dahdit-test#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 @@ -60,13 +60,14 @@   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.*-    , daytripper ==0.3.*+    , dahdit ==0.6.*+    , daytripper ==0.4.*     , directory ==1.3.*-    , falsify ==0.2.*-    , text >=1.2 && <2.1+    , hedgehog ==1.5.*+    , prop-unit ==0.2.*+    , text >=1.2 && <2.2   default-language: GHC2021  test-suite dahdit-test-test@@ -104,13 +105,14 @@   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-test-    , daytripper ==0.3.*+    , daytripper ==0.4.*     , directory ==1.3.*-    , falsify ==0.2.*-    , tasty ==1.4.*-    , text >=1.2 && <2.1+    , hedgehog ==1.5.*+    , prop-unit ==0.2.*+    , tasty >=1.4 && <1.6+    , text >=1.2 && <2.2   default-language: GHC2021

@@ -9,6 +9,7 @@   ) where +import Control.Monad.IO.Class (MonadIO (..)) import Dahdit (Binary, ByteCount (..), GetError, StaticByteSized (..), decodeEnd, encode) import Data.ByteString (ByteString) import Data.ByteString qualified as BS@@ -17,32 +18,33 @@ import Data.Text (Text) import Data.Text.Encoding qualified as TE import Data.Word (Word8)-import Test.Daytripper (Expect, MonadExpect (..), expectDuring, mkExpect)+import PropUnit (MonadTest, assert, (===))+import Test.Daytripper (Expect, expectDuring, mkExpect)  type Cmp m a = Maybe a -> Either GetError a -> m () -expectCodec :: (MonadExpect m, Binary a) => Cmp m a -> Expect m a ByteString (Either GetError a)+expectCodec :: (MonadTest m, MonadIO m, Binary a) => Cmp m a -> Expect m a ByteString (Either GetError a) expectCodec = mkExpect enc dec  where-  enc = expectLiftIO . encode-  dec = expectLiftIO . fmap fst . decodeEnd+  enc = liftIO . encode+  dec = liftIO . fmap fst . decodeEnd -expectCodecOk :: (MonadExpect m, Binary a, Eq a, Show a) => Expect m a ByteString (Either GetError a)-expectCodecOk = expectCodec (maybe (expectAssertBool "expected ok" . isRight) (\a x -> expectAssertEq x (Right a)))+expectCodecOk :: (MonadTest m, MonadIO m, Binary a, Eq a, Show a) => Expect m a ByteString (Either GetError a)+expectCodecOk = expectCodec (maybe (assert . isRight) (\a x -> x === Right a)) -expectCodecErr :: (MonadExpect m, Binary a) => Expect m a ByteString (Either GetError a)-expectCodecErr = expectCodec (const (expectAssertBool "expected error" . isLeft))+expectCodecErr :: (MonadTest m, MonadIO m, Binary a) => Expect m a ByteString (Either GetError a)+expectCodecErr = expectCodec (const (assert . isLeft)) -expectBytes :: (MonadExpect m) => [Word8] -> Expect m a ByteString c -> Expect m a ByteString c-expectBytes ws = expectDuring (\_ bs -> expectAssertEq bs (BS.pack ws))+expectBytes :: (MonadTest m) => [Word8] -> Expect m a ByteString c -> Expect m a ByteString c+expectBytes ws = expectDuring (\_ bs -> bs === BS.pack ws) -expectText :: (MonadExpect m) => Text -> Expect m a ByteString c -> Expect m a ByteString c-expectText t = expectDuring (\_ bs -> expectAssertEq bs (TE.encodeUtf8 t))+expectText :: (MonadTest m) => Text -> Expect m a ByteString c -> Expect m a ByteString c+expectText t = expectDuring (\_ bs -> bs === TE.encodeUtf8 t)  proxyBefore :: Expect m a b c -> Proxy a proxyBefore _ = Proxy -expectStatic :: (MonadExpect m, StaticByteSized a) => Expect m a ByteString c -> Expect m a ByteString c+expectStatic :: (MonadTest m, StaticByteSized a) => Expect m a ByteString c -> Expect m a ByteString c expectStatic ex =   let len = unByteCount (staticByteSize (proxyBefore ex))-  in  expectDuring (\_ bs -> expectAssertEq (BS.length bs) len) ex+  in  expectDuring (\_ bs -> BS.length bs === len) ex

@@ -11,9 +11,6 @@   , genString   , genSBS   , genText-  , ViaSigned (..)-  , ViaUnsigned (..)-  , ViaFractional (..)   , LengthBounds (..)   , DahditTag   )@@ -32,8 +29,8 @@   , Int32LE (..)   , Int64BE (..)   , Int64LE (..)-  -- , StaticBytes (..)-  -- , StaticSeq (..)+  , StaticBytes (..)+  , StaticSeq (..)   , TermBytes16 (..)   , TermBytes8 (..)   , Word16BE (..)@@ -43,7 +40,6 @@   , Word64BE (..)   , Word64LE (..)   )-import Data.Bits (FiniteBits (..)) import Data.ByteString.Internal (w2c) import Data.ByteString.Short (ShortByteString) import Data.ByteString.Short qualified as BSS@@ -64,37 +60,38 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Word (Word16, Word32, Word64, Word8)-import Test.Falsify.GenDefault (GenDefault (..), ViaGeneric (..))-import Test.Falsify.Generator (Gen)-import Test.Falsify.Generator qualified as FG-import Test.Falsify.Range qualified as FR+import GHC.TypeLits (KnownNat, natVal)+import Hedgehog (Gen)+import Hedgehog.Gen qualified as Gen+import Hedgehog.Range qualified as Range+import PropUnit (GenDefault (..), genDefaultGeneric)  genPrintableChar :: Gen Char-genPrintableChar = fmap w2c (FG.inRange (FR.between (32, 126)))+genPrintableChar = fmap w2c (Gen.integral (Range.constant 32 126)) -genSigned :: (Integral a, FiniteBits a, Bounded a) => Gen a-genSigned = FG.inRange (FR.withOrigin (minBound, maxBound) 0)+genSigned :: (Integral a, Bounded a) => Gen a+genSigned = Gen.integral (Range.constantFrom 0 minBound maxBound) -genUnsigned :: (Integral a, FiniteBits a, Bounded a) => Gen a-genUnsigned = FG.inRange (FR.between (0, maxBound))+genUnsigned :: (Integral a, Bounded a) => Gen a+genUnsigned = Gen.integral (Range.constant 0 maxBound)  genFractional :: (Fractional a) => Gen a genFractional = do   -- Picked so bound**2 fits in int   let bound = 3037000499 :: Int-  n <- FG.inRange (FR.between (0, bound))-  b <- FG.inRange (FR.between (1, bound))-  a <- FG.inRange (FR.withOrigin ((-n) * b, n * b) 0)+  n <- Gen.integral (Range.constant 0 bound)+  b <- Gen.integral (Range.constant 1 bound)+  a <- Gen.integral (Range.constantFrom 0 ((-n) * b) (n * b))   return (fromRational (fromIntegral a % fromIntegral b))  genEnum :: (Enum a, Bounded a) => Gen a-genEnum = let b = minBound in FG.elem (b :| drop 1 [b .. maxBound])+genEnum = Gen.enumBounded  genSum :: NonEmpty (Gen a) -> Gen a-genSum (g :| gs) = foldr FG.choose g gs+genSum (g :| gs) = Gen.choice (g : gs)  genList :: Word -> Word -> Gen a -> Gen [a]-genList mn mx = FG.list (FR.between (mn, mx))+genList mn mx = Gen.list (Range.constant (fromIntegral mn) (fromIntegral mx))  genSeq :: Word -> Word -> Gen a -> Gen (Seq a) genSeq mn mx = fmap Seq.fromList . genList mn mx@@ -110,12 +107,12 @@  newtype ViaSigned a = ViaSigned {unViaSigned :: a} -instance (Integral a, FiniteBits a, Bounded a) => GenDefault p (ViaSigned a) where+instance (Integral a, Bounded a) => GenDefault p (ViaSigned a) where   genDefault _ = fmap ViaSigned genSigned  newtype ViaUnsigned a = ViaUnsigned {unViaUnsigned :: a} -instance (Integral a, FiniteBits a, Bounded a) => GenDefault p (ViaUnsigned a) where+instance (Integral a, Bounded a) => GenDefault p (ViaUnsigned a) where   genDefault _ = fmap ViaUnsigned genUnsigned  newtype ViaFractional a = ViaFractional {unViaFractional :: a}@@ -138,100 +135,116 @@  type D = DahditTag -deriving via (ViaUnsigned Word8) instance GenDefault (D p) Word8+instance GenDefault (D p) Word8 where+  genDefault _ = genUnsigned -deriving via (ViaSigned Int8) instance GenDefault (D p) Int8+instance GenDefault (D p) Int8 where+  genDefault _ = genSigned -deriving via (ViaUnsigned Word16) instance GenDefault (D p) Word16+instance GenDefault (D p) Word16 where+  genDefault _ = genUnsigned -deriving via (ViaSigned Int16) instance GenDefault (D p) Int16+instance GenDefault (D p) Int16 where+  genDefault _ = genSigned -deriving via (ViaUnsigned Word32) instance GenDefault (D p) Word32+instance GenDefault (D p) Word32 where+  genDefault _ = genUnsigned -deriving via (ViaSigned Int32) instance GenDefault (D p) Int32+instance GenDefault (D p) Int32 where+  genDefault _ = genSigned -deriving via (ViaUnsigned Word64) instance GenDefault (D p) Word64+instance GenDefault (D p) Word64 where+  genDefault _ = genUnsigned -deriving via (ViaSigned Int64) instance GenDefault (D p) Int64+instance GenDefault (D p) Int64 where+  genDefault _ = genSigned -deriving via (ViaFractional Float) instance GenDefault (D p) Float+instance GenDefault (D p) Float where+  genDefault _ = genFractional -deriving via (ViaFractional Double) instance GenDefault (D p) Double+instance GenDefault (D p) Double where+  genDefault _ = genFractional -deriving via (ViaSigned Int) instance GenDefault (D p) Int+instance GenDefault (D p) Int where+  genDefault _ = genSigned -deriving newtype instance GenDefault (D p) Word16LE+instance GenDefault (D p) Word16LE where+  genDefault = fmap Word16LE . genDefault -deriving newtype instance GenDefault (D p) Int16LE+instance GenDefault (D p) Int16LE where+  genDefault = fmap Int16LE . genDefault -deriving newtype instance GenDefault (D p) Word32LE+instance GenDefault (D p) Word32LE where+  genDefault = fmap Word32LE . genDefault -deriving newtype instance GenDefault (D p) Int32LE+instance GenDefault (D p) Int32LE where+  genDefault = fmap Int32LE . genDefault -deriving newtype instance GenDefault (D p) Word64LE+instance GenDefault (D p) Word64LE where+  genDefault = fmap Word64LE . genDefault -deriving newtype instance GenDefault (D p) Int64LE+instance GenDefault (D p) Int64LE where+  genDefault = fmap Int64LE . genDefault -deriving newtype instance GenDefault (D p) FloatLE+instance GenDefault (D p) FloatLE where+  genDefault = fmap FloatLE . genDefault -deriving newtype instance GenDefault (D p) DoubleLE+instance GenDefault (D p) DoubleLE where+  genDefault = fmap DoubleLE . genDefault -deriving newtype instance GenDefault (D p) Word16BE+instance GenDefault (D p) Word16BE where+  genDefault = fmap Word16BE . genDefault -deriving newtype instance GenDefault (D p) Int16BE+instance GenDefault (D p) Int16BE where+  genDefault = fmap Int16BE . genDefault -deriving newtype instance GenDefault (D p) Word32BE+instance GenDefault (D p) Word32BE where+  genDefault = fmap Word32BE . genDefault -deriving newtype instance GenDefault (D p) Int32BE+instance GenDefault (D p) Int32BE where+  genDefault = fmap Int32BE . genDefault -deriving newtype instance GenDefault (D p) Word64BE+instance GenDefault (D p) Word64BE where+  genDefault = fmap Word64BE . genDefault -deriving newtype instance GenDefault (D p) Int64BE+instance GenDefault (D p) Int64BE where+  genDefault = fmap Int64BE . genDefault -deriving newtype instance GenDefault (D p) FloatBE+instance GenDefault (D p) FloatBE where+  genDefault = fmap FloatBE . genDefault -deriving newtype instance GenDefault (D p) DoubleBE+instance GenDefault (D p) DoubleBE where+  genDefault = fmap DoubleBE . genDefault  instance GenDefault (D p) Char where   genDefault = fmap w2c . genDefault -deriving via (ViaGeneric (D p) ()) instance GenDefault (D p) ()+instance GenDefault (D p) () where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) Bool)-  instance-    GenDefault (D p) Bool+instance GenDefault (D p) Bool where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (Maybe a))-  instance-    (GenDefault (D p) a) => GenDefault (D p) (Maybe a)+instance (GenDefault (D p) a) => GenDefault (D p) (Maybe a) where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (Either a b))-  instance-    (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (Either a b)+instance (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (Either a b) where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (a, b))-  instance-    (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (a, b)+instance (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (a, b) where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (a, b, c))-  instance-    (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c) => GenDefault (D p) (a, b, c)+instance (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c) => GenDefault (D p) (a, b, c) where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (a, b, c, d))-  instance-    (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d) => GenDefault (D p) (a, b, c, d)+instance (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d) => GenDefault (D p) (a, b, c, d) where+  genDefault = genDefaultGeneric -deriving via-  (ViaGeneric (D p) (a, b, c, d, e))-  instance-    (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d, GenDefault (D p) e)-    => GenDefault (D p) (a, b, c, d, e)+instance+  (GenDefault (D p) a, GenDefault (D p) b, GenDefault (D p) c, GenDefault (D p) d, GenDefault (D p) e)+  => GenDefault (D p) (a, b, c, d, e)+  where+  genDefault = genDefaultGeneric  instance (LengthBounds (D p) [a], GenDefault (D p) a) => GenDefault (D p) [a] where   genDefault = genListLike id@@ -257,11 +270,15 @@ instance (LengthBounds (D p) TermBytes16) => GenDefault (D p) TermBytes16 where   genDefault = genListLike (TermBytes16 . BSS.pack) --- instance LengthBounds (D p) => GenDefault (D p) (StaticBytes n) where---   genDefault = genListLike (StaticBytes . BSS.pack)+instance (KnownNat n) => GenDefault (D p) (StaticBytes n) where+  genDefault _ =+    let mn = fromInteger (natVal (Proxy @n))+    in  fmap (StaticBytes . BSS.pack) (genList mn mn (genDefault @(D p) Proxy)) --- instance (LengthBounds (D p), GenDefault (D p) a) => GenDefault (D p) (StaticSeq n a) where---   genDefault = genListLike (StaticSeq . Seq.fromList)+instance (KnownNat n, GenDefault (D p) a) => GenDefault (D p) (StaticSeq n a) where+  genDefault _ =+    let mn = fromInteger (natVal (Proxy @n))+    in  fmap (StaticSeq . Seq.fromList) (genList mn mn (genDefault @(D p) Proxy))  instance GenDefault (D p) BoolByte where   genDefault = fmap BoolByte . genDefault

@@ -10,36 +10,38 @@ import Data.Proxy (Proxy (..)) import Data.Word (Word8) import GHC.Generics (Generic)+import PropUnit (Gen, GenDefault (..), genDefaultGeneric, testGroup) import Test.Dahdit.Daytripper (expectBytes, expectCodecOk, expectText) import Test.Dahdit.GenDefault (DahditTag) import Test.Daytripper (daytripperMain, mkFileRT, mkPropRT, mkUnitRT, testRT)-import Test.Falsify.GenDefault qualified as FD-import Test.Falsify.Generator (Gen)-import Test.Tasty (testGroup)  data P  type I = DahditTag P -genDefaultI :: (FD.GenDefault I a) => Gen a-genDefaultI = FD.genDefault (Proxy @I)+genDefaultI :: (GenDefault I a) => Gen a+genDefaultI = genDefault (Proxy @I)  data DynFoo = DynFoo !Word8 !Word16LE   deriving stock (Eq, Show, Generic)   deriving (Binary) via (ViaGeneric DynFoo)-  deriving (FD.GenDefault I) via (FD.ViaGeneric I DynFoo) +instance GenDefault I DynFoo where+  genDefault = genDefaultGeneric+ data StaFoo = StaFoo !Word8 !Word16LE   deriving stock (Eq, Show, Generic)   deriving (StaticByteSized, Binary) via (ViaStaticGeneric StaFoo)-  deriving (FD.GenDefault I) via (FD.ViaGeneric I StaFoo) +instance GenDefault I StaFoo where+  genDefault = genDefaultGeneric+ main :: IO () main =-  daytripperMain $+  daytripperMain $ \lim ->     testGroup "DahditTest" $       fmap-        testRT+        (testRT lim)         [ mkPropRT "DynFoo prop" expectCodecOk (genDefaultI @DynFoo)         , mkUnitRT "DynFoo unit" (expectBytes [1, 2, 0] expectCodecOk) (DynFoo 1 2)         , mkFileRT "DynFoo file" expectCodecOk "testdata/dynfoo.bin" (Just (DynFoo 1 2))