LawsSpec.hs

{-# LANGUAGE OverloadedStrings #-}

module Binrep.LawsSpec where

import Test.Hspec
import Test.Hspec.QuickCheck
import Test.QuickCheck.Instances.ByteString()
import Generic.Random
import Test.QuickCheck
import ArbitraryOrphans()

import Binrep
import Binrep.Generic
import Binrep.Type.Int
import Binrep.Type.Common ( Endianness(..) )
import Binrep.Type.ByteString
import Data.Word ( Word8 )
import Data.ByteString qualified as B
import GHC.Generics ( Generic )

import Control.Exception ( evaluate )

spec :: Spec
spec = do
    prop "put is identity on ByteString" $ do
      \(bs :: B.ByteString) -> runPut bs  `shouldBe` bs
    prop "parse-print roundtrip isomorphism (ByteString)" $ do
      \(bs :: B.ByteString) -> runGet (runPut bs) `shouldBe` Right (bs, "")
    prop "parse-print roundtrip isomorphism (generic, sum tag via nullterm constructor)" $ do
      \(d :: D) -> runGet (runPut d) `shouldBe` Right (d, "")
    prop "serializing a type with an incorrect generic derivation throws an exception" $ do
      \(d :: DNoSum) -> do
        let evaluateShouldThrow a = evaluate a `shouldThrow` (\case EDerivedSumInstanceWithNonSumCfg -> True)
        evaluateShouldThrow (blen d)
        evaluateShouldThrow (runPut d)
    prop "parsing a type with an incorrect generic derivation fails" $ do
      \(bs :: B.ByteString) -> do
        let e = EGeneric "DNoSum" $ EGenericSum $ EGenericSumTag $ EBase ENoVoid
        runGet @DNoSum bs `shouldBe` Left e

--------------------------------------------------------------------------------

type W1   = (I 'U 'I1 'LE)
type W2LE = (I 'U 'I2 'LE)
type W8BE = (I 'U 'I8 'BE)

data D
  = D01Bla     Word8 W1 W8BE
  | D23        W2LE  B.ByteString -- dangerous bytestring, must be last
  | DUnicode例 Word8
  | DSymbols_#
    deriving stock (Generic, Eq, Show)
deriving via (GenericArbitraryU `AndShrinking` D) instance Arbitrary D

dCfg :: Cfg (AsByteString 'C)
dCfg = cfg cSumTagNullTerm

instance BLen D where blen = blenGeneric dCfg
instance Put  D where put  = putGeneric  dCfg
instance Get  D where get  = getGeneric  dCfg

data DNoSum = DNoSum Word8 W1 W2LE W8BE
  | DNoSumBad
    deriving stock (Generic, Eq, Show)
deriving via (GenericArbitraryU `AndShrinking` DNoSum) instance Arbitrary DNoSum

instance BLen DNoSum where blen = blenGeneric cNoSum
instance Put  DNoSum where put  = putGeneric  cNoSum
instance Get  DNoSum where get  = getGeneric  cNoSum