Sanity.hs

module Test.RecoverRTTI.Sanity (tests) where

import Data.SOP.BasicFunctors
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)

import Debug.RecoverRTTI

import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck (testProperty)
import Test.QuickCheck (Property)
import Test.QuickCheck qualified as QC

import Test.RecoverRTTI.ConcreteClassifier
import Test.RecoverRTTI.QuickCheck.DepGen
import Test.RecoverRTTI.QuickCheck.Sized qualified as SG

tests :: TestTree
tests = testGroup "Test.RecoverRTTI.Sanity" [
     testProperty "typeSize"            prop_typeSize
   , testCase     "derivingVia"         test_derivingVia
   , testCase     "BoxAnythingToString" test_BoxAnythingToString
   ]

prop_typeSize :: Property
prop_typeSize =
    QC.forAll (QC.Blind <$> SG.run 10 arbitraryConcrete) $
      \(QC.Blind (Some (DepGen classifier _))) ->
          QC.counterexample ("classifier: " ++ show classifier)
        $ QC.counterexample ("size: " ++ show (sizeConcrete classifier))
        $ sizeConcrete classifier <= 100

{-------------------------------------------------------------------------------
  Deriving-via support
-------------------------------------------------------------------------------}

data T1 = T1 Int Bool

data T2 = T2 T1
  deriving Show via AnythingToString T2

test_derivingVia :: Assertion
test_derivingVia = assertEqual "" "T2 (T1 1 True)" $ show (T2 (T1 1 True))

{-------------------------------------------------------------------------------
  BoxAnythingToString
-------------------------------------------------------------------------------}

data T3 f = T3 [f Any]

deriving instance Show a => Show (T3 (K a))

t3BadExample :: T3 I
t3BadExample = T3 [unsafeCoerce (1 :: Int), unsafeCoerce False]

t3GoodExample :: T3 (K BoxAnything)
t3GoodExample = T3 [K $ BoxAnything (1 :: Int), K $ BoxAnything False]

test_BoxAnythingToString :: Assertion
test_BoxAnythingToString = do
    assertBool "bad" $
      anythingToString t3BadExample /= "T3 [1,False]"
    assertEqual "good - show" "T3 [K 1,K False]" $
      show t3GoodExample
    assertEqual "good - anythingToString" "T3 [BoxAnything 1,BoxAnything False]" $
      anythingToString t3GoodExample