dahdit-test (empty) → 0.5.0
raw patch · 5 files changed
+485/−0 lines, 5 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, dahdit, dahdit-test, daytripper, directory, falsify, tasty, text
Files
- README.md +3/−0
- dahdit-test.cabal +116/−0
- src/Test/Dahdit/Daytripper.hs +48/−0
- src/Test/Dahdit/GenDefault.hs +269/−0
- test/Main.hs +49/−0
+ README.md view
@@ -0,0 +1,3 @@+# dahdit-test++Test utils for Dahdit serde
+ dahdit-test.cabal view
@@ -0,0 +1,116 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.36.0.+--+-- see: https://github.com/sol/hpack++name: dahdit-test+version: 0.5.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+bug-reports: https://github.com/ejconlon/dahdit-test/issues+author: Eric Conlon+maintainer: ejconlon@gmail.com+copyright: (c) 2023 Eric Conlon+license: BSD3+build-type: Simple+tested-with:+ GHC == 9.2.7+extra-source-files:+ README.md++source-repository head+ type: git+ location: https://github.com/ejconlon/dahdit-test++library+ exposed-modules:+ Test.Dahdit.Daytripper+ Test.Dahdit.GenDefault+ other-modules:+ Paths_dahdit_test+ hs-source-dirs:+ src+ default-extensions:+ BangPatterns+ ConstraintKinds+ DataKinds+ DeriveFunctor+ DeriveFoldable+ DeriveGeneric+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ KindSignatures+ MultiParamTypeClasses+ Rank2Types+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeApplications+ TypeOperators+ TypeFamilies+ 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.*+ , containers ==0.6.*+ , dahdit ==0.5.*+ , daytripper ==0.3.*+ , directory ==1.3.*+ , falsify ==0.2.*+ , text >=1.2 && <2.1+ default-language: GHC2021++test-suite dahdit-test-test+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ Paths_dahdit_test+ hs-source-dirs:+ test+ default-extensions:+ BangPatterns+ ConstraintKinds+ DataKinds+ DeriveFunctor+ DeriveFoldable+ DeriveGeneric+ DeriveTraversable+ DerivingStrategies+ DerivingVia+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ GeneralizedNewtypeDeriving+ LambdaCase+ KindSignatures+ MultiParamTypeClasses+ Rank2Types+ ScopedTypeVariables+ StandaloneDeriving+ TupleSections+ TypeApplications+ TypeOperators+ TypeFamilies+ 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.*+ , containers ==0.6.*+ , dahdit ==0.5.*+ , dahdit-test+ , daytripper ==0.3.*+ , directory ==1.3.*+ , falsify ==0.2.*+ , tasty ==1.4.*+ , text >=1.2 && <2.1+ default-language: GHC2021
+ src/Test/Dahdit/Daytripper.hs view
@@ -0,0 +1,48 @@+module Test.Dahdit.Daytripper+ ( Cmp+ , expectCodec+ , expectCodecOk+ , expectCodecErr+ , expectBytes+ , expectText+ , expectStatic+ )+where++import Dahdit (Binary, ByteCount (..), GetError, StaticByteSized (..), decodeEnd, encode)+import Data.ByteString (ByteString)+import Data.ByteString qualified as BS+import Data.Either (isLeft, isRight)+import Data.Proxy (Proxy (..))+import Data.Text (Text)+import Data.Text.Encoding qualified as TE+import Data.Word (Word8)+import Test.Daytripper (Expect, MonadExpect (..), 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 = mkExpect enc dec+ where+ enc = expectLiftIO . encode+ dec = expectLiftIO . 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)))++expectCodecErr :: (MonadExpect m, Binary a) => Expect m a ByteString (Either GetError a)+expectCodecErr = expectCodec (const (expectAssertBool "expected error" . isLeft))++expectBytes :: (MonadExpect m) => [Word8] -> Expect m a ByteString c -> Expect m a ByteString c+expectBytes ws = expectDuring (\_ bs -> expectAssertEq 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))++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 ex =+ let len = unByteCount (staticByteSize (proxyBefore ex))+ in expectDuring (\_ bs -> expectAssertEq (BS.length bs) len) ex
+ src/Test/Dahdit/GenDefault.hs view
@@ -0,0 +1,269 @@+{-# LANGUAGE UndecidableInstances #-}++module Test.Dahdit.GenDefault+ ( genSigned+ , genUnsigned+ , genFractional+ , genEnum+ , genSum+ , genList+ , genSeq+ , genString+ , genSBS+ , genText+ , ViaSigned (..)+ , ViaUnsigned (..)+ , ViaFractional (..)+ , LengthBounds (..)+ , DahditTag+ )+where++import Dahdit+ ( BoolByte (..)+ , DoubleBE (..)+ , DoubleLE (..)+ , ExactBytes (..)+ , FloatBE (..)+ , FloatLE (..)+ , Int16BE (..)+ , Int16LE (..)+ , Int32BE (..)+ , Int32LE (..)+ , Int64BE (..)+ , Int64LE (..)+ -- , StaticBytes (..)+ -- , StaticSeq (..)+ , TermBytes16 (..)+ , TermBytes8 (..)+ , Word16BE (..)+ , Word16LE (..)+ , Word32BE (..)+ , Word32LE (..)+ , Word64BE (..)+ , Word64LE (..)+ )+import Data.Bits (FiniteBits (..))+import Data.ByteString.Internal (w2c)+import Data.ByteString.Short (ShortByteString)+import Data.ByteString.Short qualified as BSS+import Data.Int (Int16, Int32, Int64, Int8)+import Data.IntMap (IntMap)+import Data.IntMap qualified as IntMap+import Data.IntSet (IntSet)+import Data.IntSet qualified as IntSet+import Data.List.NonEmpty (NonEmpty (..))+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Proxy (Proxy (..))+import Data.Ratio ((%))+import Data.Sequence (Seq)+import Data.Sequence qualified as Seq+import Data.Set (Set)+import Data.Set qualified as Set+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++genPrintableChar :: Gen Char+genPrintableChar = fmap w2c (FG.inRange (FR.between (32, 126)))++genSigned :: (Integral a, FiniteBits a, Bounded a) => Gen a+genSigned = FG.inRange (FR.withOrigin (minBound, maxBound) 0)++genUnsigned :: (Integral a, FiniteBits a, Bounded a) => Gen a+genUnsigned = FG.inRange (FR.between (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)+ 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])++genSum :: NonEmpty (Gen a) -> Gen a+genSum (g :| gs) = foldr FG.choose g gs++genList :: Word -> Word -> Gen a -> Gen [a]+genList mn mx = FG.list (FR.between (mn, mx))++genSeq :: Word -> Word -> Gen a -> Gen (Seq a)+genSeq mn mx = fmap Seq.fromList . genList mn mx++genString :: Word -> Word -> Gen String+genString mn mx = genList mn mx genPrintableChar++genSBS :: Word -> Word -> Gen ShortByteString+genSBS mn mx = fmap BSS.pack (genList mn mx genUnsigned)++genText :: Word -> Word -> Gen Text+genText mn mx = fmap T.pack (genString mn mx)++newtype ViaSigned a = ViaSigned {unViaSigned :: a}++instance (Integral a, FiniteBits 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+ genDefault _ = fmap ViaUnsigned genUnsigned++newtype ViaFractional a = ViaFractional {unViaFractional :: a}++instance (Fractional a) => GenDefault p (ViaFractional a) where+ genDefault _ = fmap ViaFractional genFractional++class LengthBounds p a where+ lengthBounds :: Proxy p -> Proxy a -> (Word, Word)++proxyForRange :: (x -> b) -> Proxy b+proxyForRange _ = Proxy++genListLike :: (LengthBounds p b, GenDefault p a) => ([a] -> b) -> Proxy p -> Gen b+genListLike f p =+ let (mn, mx) = lengthBounds p (proxyForRange f)+ in fmap f (genList mn mx (genDefault p))++data DahditTag p++type D = DahditTag++deriving via (ViaUnsigned Word8) instance GenDefault (D p) Word8++deriving via (ViaSigned Int8) instance GenDefault (D p) Int8++deriving via (ViaUnsigned Word16) instance GenDefault (D p) Word16++deriving via (ViaSigned Int16) instance GenDefault (D p) Int16++deriving via (ViaUnsigned Word32) instance GenDefault (D p) Word32++deriving via (ViaSigned Int32) instance GenDefault (D p) Int32++deriving via (ViaUnsigned Word64) instance GenDefault (D p) Word64++deriving via (ViaSigned Int64) instance GenDefault (D p) Int64++deriving via (ViaFractional Float) instance GenDefault (D p) Float++deriving via (ViaFractional Double) instance GenDefault (D p) Double++deriving via (ViaSigned Int) instance GenDefault (D p) Int++deriving newtype instance GenDefault (D p) Word16LE++deriving newtype instance GenDefault (D p) Int16LE++deriving newtype instance GenDefault (D p) Word32LE++deriving newtype instance GenDefault (D p) Int32LE++deriving newtype instance GenDefault (D p) Word64LE++deriving newtype instance GenDefault (D p) Int64LE++deriving newtype instance GenDefault (D p) FloatLE++deriving newtype instance GenDefault (D p) DoubleLE++deriving newtype instance GenDefault (D p) Word16BE++deriving newtype instance GenDefault (D p) Int16BE++deriving newtype instance GenDefault (D p) Word32BE++deriving newtype instance GenDefault (D p) Int32BE++deriving newtype instance GenDefault (D p) Word64BE++deriving newtype instance GenDefault (D p) Int64BE++deriving newtype instance GenDefault (D p) FloatBE++deriving newtype instance GenDefault (D p) DoubleBE++instance GenDefault (D p) Char where+ genDefault = fmap w2c . genDefault++deriving via (ViaGeneric (D p) ()) instance GenDefault (D p) ()++deriving via+ (ViaGeneric (D p) Bool)+ instance+ GenDefault (D p) Bool++deriving via+ (ViaGeneric (D p) (Maybe a))+ instance+ (GenDefault (D p) a) => GenDefault (D p) (Maybe a)++deriving via+ (ViaGeneric (D p) (Either a b))+ instance+ (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (Either a b)++deriving via+ (ViaGeneric (D p) (a, b))+ instance+ (GenDefault (D p) a, GenDefault (D p) b) => GenDefault (D p) (a, b)++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)++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)++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 (LengthBounds (D p) [a], GenDefault (D p) a) => GenDefault (D p) [a] where+ genDefault = genListLike id++instance (LengthBounds (D p) (Seq a), GenDefault (D p) a) => GenDefault (D p) (Seq a) where+ genDefault = genListLike Seq.fromList++instance (LengthBounds (D p) (Map a b), GenDefault (D p) a, GenDefault (D p) b, Ord a) => GenDefault (D p) (Map a b) where+ genDefault = genListLike Map.fromList++instance (LengthBounds (D p) (Set a), GenDefault (D p) a, Ord a) => GenDefault (D p) (Set a) where+ genDefault = genListLike Set.fromList++instance (LengthBounds (D p) IntSet) => GenDefault (D p) IntSet where+ genDefault = genListLike IntSet.fromList++instance (LengthBounds (D p) (IntMap a), GenDefault (D p) a) => GenDefault (D p) (IntMap a) where+ genDefault = genListLike IntMap.fromList++instance (LengthBounds (D p) TermBytes8) => GenDefault (D p) TermBytes8 where+ genDefault = genListLike (TermBytes8 . BSS.pack)++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 (LengthBounds (D p), GenDefault (D p) a) => GenDefault (D p) (StaticSeq n a) where+-- genDefault = genListLike (StaticSeq . Seq.fromList)++instance GenDefault (D p) BoolByte where+ genDefault = fmap BoolByte . genDefault++instance GenDefault (D p) (ExactBytes n s) where+ genDefault _ = pure (ExactBytes ())
+ test/Main.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}++module Main+ ( main+ )+where++import Dahdit (Binary, StaticByteSized (..), ViaGeneric (..), ViaStaticGeneric (..), Word16LE)+import Data.Proxy (Proxy (..))+import Data.Word (Word8)+import GHC.Generics (Generic)+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)++data DynFoo = DynFoo !Word8 !Word16LE+ deriving stock (Eq, Show, Generic)+ deriving (Binary) via (ViaGeneric DynFoo)+ deriving (FD.GenDefault I) via (FD.ViaGeneric I DynFoo)++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)++main :: IO ()+main =+ daytripperMain $+ testGroup "DahditTest" $+ fmap+ testRT+ [ 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))+ , mkPropRT "StaFoo prop" expectCodecOk (genDefaultI @StaFoo)+ , mkUnitRT "StaFoo unit" (expectText "\ETX\EOT\NUL" expectCodecOk) (StaFoo 3 4)+ , mkFileRT "DynFoo file" expectCodecOk "testdata/stafoo.bin" (Just (StaFoo 1 2))+ ]