large-records-0.1.0.0: test/Test/Record/Size/Sanity.hs
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -F -pgmF=record-dot-preprocessor #-}
-- | Sanity checks that we generate correct code for in the @Sized.*@ modules
--
-- The real test of the @Size.*@ moduels of course is not this module, but
-- rather their compiled size.
module Test.Record.Size.Sanity (tests) where
import Data.Aeson
import Data.Functor.Identity
import qualified Data.Record.Generic.SOP as SOP
import qualified Data.Record.Generic.LowerBound as LR
import qualified Test.Record.Size.Before.R010 as Before010
import qualified Test.Record.Size.After.R0010 as After0010
import qualified Test.Record.Size.After.HK010 as AfterHK10
#if USE_GHC_DUMP
import Test.Record.Size.Infra (T(..))
import qualified Test.Record.Size.Before.R020 as Before020
import qualified Test.Record.Size.Before.R030 as Before030
import qualified Test.Record.Size.Before.R040 as Before040
import qualified Test.Record.Size.Before.R050 as Before050
import qualified Test.Record.Size.Before.R060 as Before060
import qualified Test.Record.Size.Before.R070 as Before070
import qualified Test.Record.Size.Before.R080 as Before080
import qualified Test.Record.Size.Before.R090 as Before090
import qualified Test.Record.Size.Before.R100 as Before100
import qualified Test.Record.Size.After.R0020 as After0020
import qualified Test.Record.Size.After.R0030 as After0030
import qualified Test.Record.Size.After.R0040 as After0040
import qualified Test.Record.Size.After.R0050 as After0050
import qualified Test.Record.Size.After.R0060 as After0060
import qualified Test.Record.Size.After.R0070 as After0070
import qualified Test.Record.Size.After.R0080 as After0080
import qualified Test.Record.Size.After.R0090 as After0090
import qualified Test.Record.Size.After.R0100 as After0100
import qualified Test.Record.Size.After.R0200 as After0200
import qualified Test.Record.Size.After.R0300 as After0300
import qualified Test.Record.Size.After.R0400 as After0400
import qualified Test.Record.Size.After.R0500 as After0500
import qualified Test.Record.Size.After.R0600 as After0600
import qualified Test.Record.Size.After.R0700 as After0700
import qualified Test.Record.Size.After.R0800 as After0800
import qualified Test.Record.Size.After.R0900 as After0900
import qualified Test.Record.Size.After.R1000 as After1000
import qualified Test.Record.Size.After.HK020 as AfterHK20
import qualified Test.Record.Size.After.HK030 as AfterHK30
import qualified Test.Record.Size.After.HK040 as AfterHK40
import qualified Test.Record.Size.After.HK050 as AfterHK50
import qualified Test.Record.Size.After.HK060 as AfterHK60
import qualified Test.Record.Size.After.HK070 as AfterHK70
import qualified Test.Record.Size.After.HK080 as AfterHK80
import qualified Test.Record.Size.After.HK090 as AfterHK90
import qualified Test.Record.Size.After.HK100 as AfterH100
#endif
import Test.Tasty
import Test.Tasty.HUnit
tests :: TestTree
tests = testGroup "Test.Record.Size.Sanity" [
testCase "sameValue" test_sameValue
, testCase "sameField" test_sameField
, testCase "showHK" test_showHK
#if USE_GHC_DUMP
, testCase "reallyBig" test_reallyBig
#endif
]
-- | Test that @generics-sop@ and @large-records@ generates the same structure
test_sameValue :: Assertion
test_sameValue = do
assertEqual "10"
(toJSON (SOP.glowerBound :: Before010.R))
(toJSON ( LR.glowerBound :: After0010.R))
#if USE_GHC_DUMP
assertEqual "20"
(toJSON (SOP.glowerBound :: Before020.R))
(toJSON ( LR.glowerBound :: After0020.R))
assertEqual "30"
(toJSON (SOP.glowerBound :: Before030.R))
(toJSON ( LR.glowerBound :: After0030.R))
assertEqual "40"
(toJSON (SOP.glowerBound :: Before040.R))
(toJSON ( LR.glowerBound :: After0040.R))
assertEqual "50"
(toJSON (SOP.glowerBound :: Before050.R))
(toJSON ( LR.glowerBound :: After0050.R))
assertEqual "60"
(toJSON (SOP.glowerBound :: Before060.R))
(toJSON ( LR.glowerBound :: After0060.R))
assertEqual "70"
(toJSON (SOP.glowerBound :: Before070.R))
(toJSON ( LR.glowerBound :: After0070.R))
assertEqual "80"
(toJSON (SOP.glowerBound :: Before080.R))
(toJSON ( LR.glowerBound :: After0080.R))
assertEqual "90"
(toJSON (SOP.glowerBound :: Before090.R))
(toJSON ( LR.glowerBound :: After0090.R))
assertEqual "100"
(toJSON (SOP.glowerBound :: Before100.R))
(toJSON ( LR.glowerBound :: After0100.R))
#endif
-- | Test that we have the necessary @HasField@ instances
test_sameField :: Assertion
test_sameField = do
assertEqual "HasField" sop010.field1 lr010.field1
#if USE_GHC_DUMP
assertEqual "HasField" sop020.field11 lr020.field11
assertEqual "HasField" sop030.field21 lr030.field21
assertEqual "HasField" sop040.field31 lr040.field31
assertEqual "HasField" sop050.field41 lr050.field41
assertEqual "HasField" sop060.field51 lr060.field51
assertEqual "HasField" sop070.field61 lr070.field61
assertEqual "HasField" sop080.field71 lr080.field71
assertEqual "HasField" sop090.field81 lr090.field81
assertEqual "HasField" sop100.field91 lr100.field91
#endif
where
sop010 = SOP.glowerBound :: Before010.R
lr010 = LR.glowerBound :: After0010.R
#if USE_GHC_DUMP
sop020 = SOP.glowerBound :: Before020.R
sop030 = SOP.glowerBound :: Before030.R
sop040 = SOP.glowerBound :: Before040.R
sop050 = SOP.glowerBound :: Before050.R
sop060 = SOP.glowerBound :: Before060.R
sop070 = SOP.glowerBound :: Before070.R
sop080 = SOP.glowerBound :: Before080.R
sop090 = SOP.glowerBound :: Before090.R
sop100 = SOP.glowerBound :: Before100.R
lr020 = LR.glowerBound :: After0020.R
lr030 = LR.glowerBound :: After0030.R
lr040 = LR.glowerBound :: After0040.R
lr050 = LR.glowerBound :: After0050.R
lr060 = LR.glowerBound :: After0060.R
lr070 = LR.glowerBound :: After0070.R
lr080 = LR.glowerBound :: After0080.R
lr090 = LR.glowerBound :: After0090.R
lr100 = LR.glowerBound :: After0100.R
#endif
-- | Check that we can 'Show' the higher-kinded records
test_showHK :: Assertion
test_showHK = do
assertBool "some output" (not . null $ show lr010)
#if USE_GHC_DUMP
assertBool "some output" (not . null $ show lr020)
assertBool "some output" (not . null $ show lr030)
assertBool "some output" (not . null $ show lr040)
assertBool "some output" (not . null $ show lr050)
assertBool "some output" (not . null $ show lr060)
assertBool "some output" (not . null $ show lr070)
assertBool "some output" (not . null $ show lr080)
assertBool "some output" (not . null $ show lr090)
assertBool "some output" (not . null $ show lr100)
#endif
where
lr010 = LR.glowerBound :: AfterHK10.HKR Identity
#if USE_GHC_DUMP
lr020 = LR.glowerBound :: AfterHK20.HKR Identity
lr030 = LR.glowerBound :: AfterHK30.HKR Identity
lr040 = LR.glowerBound :: AfterHK40.HKR Identity
lr050 = LR.glowerBound :: AfterHK50.HKR Identity
lr060 = LR.glowerBound :: AfterHK60.HKR Identity
lr070 = LR.glowerBound :: AfterHK70.HKR Identity
lr080 = LR.glowerBound :: AfterHK80.HKR Identity
lr090 = LR.glowerBound :: AfterHK90.HKR Identity
lr100 = LR.glowerBound :: AfterH100.HKR Identity
#endif
#if USE_GHC_DUMP
-- | Check the value of the last field in the truly big records
test_reallyBig :: Assertion
test_reallyBig = do
assertEqual "HasField" lr0100.field100 (MkT 100)
assertEqual "HasField" lr0200.field200 (MkT 200)
assertEqual "HasField" lr0300.field300 (MkT 300)
assertEqual "HasField" lr0400.field400 (MkT 400)
assertEqual "HasField" lr0500.field500 (MkT 500)
assertEqual "HasField" lr0600.field600 (MkT 600)
assertEqual "HasField" lr0700.field700 (MkT 700)
assertEqual "HasField" lr0800.field800 (MkT 800)
assertEqual "HasField" lr0900.field900 (MkT 900)
assertEqual "HasField" lr1000.field1000 (MkT 1000)
where
lr0100 = LR.glowerBound :: After0100.R
lr0200 = LR.glowerBound :: After0200.R
lr0300 = LR.glowerBound :: After0300.R
lr0400 = LR.glowerBound :: After0400.R
lr0500 = LR.glowerBound :: After0500.R
lr0600 = LR.glowerBound :: After0600.R
lr0700 = LR.glowerBound :: After0700.R
lr0800 = LR.glowerBound :: After0800.R
lr0900 = LR.glowerBound :: After0900.R
lr1000 = LR.glowerBound :: After1000.R
#endif