Add TH function testTupleInstances

Includes tuple instances of `Test` up to 9 tuples

clash-protocols/src/Protocols/Hedgehog/Internal.hs

@@ -16,9 +16,14 @@ import Data.Proxy (Proxy (Proxy))
 import GHC.Stack (HasCallStack)
 import Prelude
 
+-- clash-protocols-base
+-- import Protocols.Plugin.Cpp
+
 -- clash-protocols
 import Protocols
 import qualified Protocols.Df as Df
+import Protocols.Hedgehog.Types
+import Protocols.Internal.TH
 
 -- clash-prelude
 import Clash.Prelude (type (*), type (+), type (<=))
@@ -28,9 +33,6 @@ import qualified Clash.Prelude as C
 import qualified Hedgehog as H
 import qualified Hedgehog.Internal.Property as H
 
--- me
-import Protocols.Hedgehog.Types
-
 {- | Resets for 30 cycles, checks for superfluous data for 50 cycles after
 seeing last valid data cycle, and times out after seeing 1000 consecutive
 empty cycles.
@@ -124,3 +126,8 @@ instance
     trimmedA <- expectN (Proxy @a) opts sampledA
     trimmedB <- expectN (Proxy @b) opts sampledB
     pure (trimmedA, trimmedB)
+
+-- XXX: We only generate up to 9 tuples instead of maxTupleSize because NFData
+-- instances are only available up to 9-tuples.
+-- see https://hackage.haskell.org/package/deepseq-1.5.1.0/docs/src/Control.DeepSeq.html#line-1125
+testTupleInstances 3 9

clash-protocols/src/Protocols/Internal/TH.hs

@@ -7,6 +7,7 @@ import Control.Monad.Extra (concatMapM)
 import Data.Proxy
 import GHC.TypeNats
 import Language.Haskell.TH
+import Protocols.Hedgehog.Types
 import Protocols.Internal.Types
 import Protocols.Plugin
 
@@ -175,3 +176,27 @@ backPressureTupleInstance n =
   circTys = map (\i -> varT $ mkName $ "c" <> show i) [1 .. n]
   instCtx = foldl appT (tupleT n) $ map (\ty -> [t|Backpressure $ty|]) circTys
   instTy = foldl appT (tupleT n) circTys
+
+testTupleInstances :: Int -> Int -> DecsQ
+testTupleInstances n m = concatMapM testTupleInstance [n .. m]
+
+testTupleInstance :: Int -> DecsQ
+testTupleInstance n =
+  [d|
+    instance ($instCtx) => Test $instTy where
+      expectN Proxy $(varP $ mkName "opts") $(tupP sampledPats) = $(doE stmts)
+    |]
+ where
+  circStrings = map (\i -> "c" <> show i) [1 .. n]
+  circTys = map (varT . mkName) circStrings
+  instCtx = foldl appT (tupleT n) $ map (\ty -> [t|Test $ty|]) circTys
+  instTy = foldl appT (tupleT n) circTys
+
+  sampledPats = map (varP . mkName . ("sampled" <>)) circStrings
+  sampledExprs = map (varE . mkName . ("sampled" <>)) circStrings
+  trimmedPats = map (varP . mkName . ("trimmed" <>)) circStrings
+  trimmedExprs = map (varE . mkName . ("trimmed" <>)) circStrings
+
+  mkTrimStmt trim ty sam = bindS trim [e|expectN (Proxy @($ty)) opts $sam|]
+  expectResult = noBindS [e|pure $(tupE trimmedExprs)|]
+  stmts = zipWith3 mkTrimStmt trimmedPats circTys sampledExprs <> [expectResult]