-- SPDX-FileCopyrightText: 2022 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -- | Tests on 'Lorentz.Test.DupableScan' module. module Test.Lorentz.DupableScan ( test_checkDupablesDistribution , test_testDupablesDistribution ) where import Data.Constraint (Dict(..)) import Data.Typeable (typeRep) import Test.Tasty (TestTree) import Test.Tasty.HUnit (testCase, (@?=)) import Lorentz.Layouts import Lorentz.Test.DupableScan import Lorentz.Value data ProperSample = ProperSample { _s1a :: Integer , _s1b :: MText , _s1c :: Ticket () , _s1d :: Ticket Natural } deriving stock (Generic) data MisplacedDupableSample = MisplacedDupableSample { _s2a :: Integer , _s2b :: MText , _s2c :: Natural , _s2d :: Ticket Natural } deriving stock (Generic) data MisplacedNonDupableSample = MisplacedNonDupableSample { _s3a :: Ticket ByteString , _s3b :: MText , _s3c :: Ticket () , _s3d :: Ticket Natural } deriving stock (Generic) data CombGenericSample = CombGenericSample { _s4a :: Integer , _s4b :: Ticket () , _s4c :: Ticket Integer , _s4d :: Ticket Natural } customGeneric "CombGenericSample" rightComb test_checkDupablesDistribution :: [TestTree] test_checkDupablesDistribution = [ testCase "Good type" $ checkDupablesDistribution @ProperSample @?= Right () , testCase "Misplaced dupable" $ checkDupablesDistribution @MisplacedDupableSample @?= Left BadElement { beExpectedDupability = False , beRecName = Just "_s2c" , beRecType = typeRep (Proxy @Natural) } , testCase "Misplaced non-dupable" $ checkDupablesDistribution @MisplacedNonDupableSample @?= Left BadElement { beExpectedDupability = True , beRecName = Just "_s3a" , beRecType = typeRep (Proxy @(Ticket ByteString)) } , testCase "Comb generic" $ checkDupablesDistribution @CombGenericSample @?= Right () ] -- Two ways to test product type layout test_testDupablesDistribution :: TestTree test_testDupablesDistribution = testDupablesDistribution @ProperSample _test_typeVerifyDupablesDistribution :: Dict (VerifyDupablesDistribution ProperSample) _test_typeVerifyDupablesDistribution = Dict -- Checking that deriveSemiDupableGeneric matches with our test utilities ---------------------------------------------------------------------------- data MegaType = MegaType { _mt1 :: Integer , _mt2 :: Natural , _mt3 :: () , _mt4 :: MText , _mt5 :: ByteString , _mt6 :: Ticket Natural , _mt7 :: Ticket Integer } deriveSemiDupableGeneric "MegaType" 2 _test_MegaType_layout :: Dict (VerifyDupablesDistribution MegaType) _test_MegaType_layout = Dict