Add tuple instances for Simulate, Drivable, Backpressure and Test

clash-protocols/clash-protocols.cabal

@@ -145,11 +145,11 @@ library
     Protocols.Axi4.WriteData
     Protocols.Axi4.WriteResponse
     Protocols.Df
-    Protocols.Internal
     Protocols.DfConv
     Protocols.Hedgehog
     Protocols.Hedgehog.Internal
     Protocols.Idle
+    Protocols.Internal
     Protocols.Internal.TH
     Protocols.Wishbone
     Protocols.Wishbone.Standard
@@ -165,8 +165,9 @@ library
   autogen-modules:    Paths_clash_protocols
 
   other-modules:
-    Protocols.Internal.Types
     Paths_clash_protocols
+    Protocols.Hedgehog.Types
+    Protocols.Internal.Types
 
   default-language: Haskell2010
 

clash-protocols/src/Protocols/Avalon/Stream.hs

@@ -29,7 +29,7 @@ import qualified Clash.Prelude as C
 
 import qualified Protocols.Df as Df
 import qualified Protocols.DfConv as DfConv
-import Protocols.Hedgehog.Internal
+import Protocols.Hedgehog
 import Protocols.Idle
 import Protocols.Internal
 

clash-protocols/src/Protocols/Axi4/Stream.hs

@@ -26,7 +26,7 @@
 
 import qualified Protocols.Df as Df
 import qualified Protocols.DfConv as DfConv
-import Protocols.Hedgehog.Internal
+import Protocols.Hedgehog
 import Protocols.Idle
 import Protocols.Internal
 
@@ -103,7 +103,7 @@
 the '_tready' signal.
 -}
 newtype Axi4StreamS2M = Axi4StreamS2M {_tready :: Bool}
   deriving (Generic, C.NFDataX, C.ShowX, Eq, NFData, Show, Bundle)
 
 -- | Type for AXI4 Stream protocol.
 data Axi4Stream (dom :: Domain) (conf :: Axi4StreamConfig) (userType :: Type)

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

@@ -3,12 +3,16 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 {- |
 Internals for "Protocols.Hedgehog".
 -}
-module Protocols.Hedgehog.Internal where
+module Protocols.Hedgehog.Internal (
+  module Protocols.Hedgehog.Internal,
+  module Protocols.Hedgehog.Types,
+) where
 
 -- base
 import Data.Proxy (Proxy (Proxy))
@@ -18,40 +22,17 @@ import Prelude
 -- 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 (<=))
 import qualified Clash.Prelude as C
 
--- deepseq
-import Control.DeepSeq
-
 -- hedgehog
 import qualified Hedgehog as H
 import qualified Hedgehog.Internal.Property as H
 
--- | Options for 'expectN' function. See individual fields for more information.
-data ExpectOptions = ExpectOptions
-  { eoStopAfterEmpty :: Int
-  -- ^ Stop sampling after seeing /n/ consecutive empty samples
-  , eoSampleMax :: Int
-  -- ^ Produce an error if the circuit produces more than /n/ valid samples. This
-  -- is used to terminate (potentially) infinitely running circuits.
-  --
-  -- This number is used to generate stall information, so setting it to
-  -- unreasonable values will result in long runtimes.
-  , eoResetCycles :: Int
-  -- ^ Ignore first /n/ cycles
-  , eoDriveEarly :: Bool
-  -- ^ Start driving the circuit with its reset asserted. Circuits should
-  -- never acknowledge data while this is happening.
-  , eoTimeoutMs :: Maybe Int
-  -- ^ Terminate the test after /n/ milliseconds.
-  , eoTrace :: Bool
-  -- ^ Trace data generation for debugging purposes
-  }
-
 {- | 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.
@@ -72,45 +53,6 @@ defExpectOptions =
     , eoTrace = False
     }
 
--- | Superclass class to reduce syntactical noise.
-class (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
-
-instance (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
-
-{- | Provides a way of comparing expected data with data produced by a
-protocol component.
--}
-class
-  ( Drivable a
-  , TestType (SimulateFwdType a)
-  , TestType (ExpectType a)
-  , -- Foldable requirement on Vec :(
-    1 <= SimulateChannels a
-  ) =>
-  Test a
-  where
-  -- | Trim each channel to the lengths given as the third argument. See
-  -- result documentation for failure modes.
-  expectN ::
-    (HasCallStack, H.MonadTest m) =>
-    Proxy a ->
-    -- | Options, see 'ExpectOptions'
-    ExpectOptions ->
-    -- | Raw sampled data
-    SimulateFwdType a ->
-    -- | Depending on "ExpectOptions", fails the test if:
-    --
-    --   * Circuit produced less data than expected
-    --   * Circuit produced more data than expected
-    --
-    -- If it does not fail, /SimulateFwdType a/ will contain exactly the number
-    -- of expected data packets.
-    --
-    -- TODO:
-    --   Should probably return a 'Vec (SimulateChannels) Failures'
-    --   in order to produce pretty reports.
-    m (ExpectType a)
-
 instance (TestType a, C.KnownDomain dom) => Test (Df dom a) where
   expectN ::
     forall m.
@@ -184,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/Hedgehog/Types.hs

@@ -0,0 +1,79 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+-- These types should be re-exported from the Protocols.Hedgehog module
+module Protocols.Hedgehog.Types where
+
+-- deepseq
+import Control.DeepSeq
+
+import qualified Clash.Prelude as C
+import Data.Proxy
+import GHC.Stack (HasCallStack)
+import Protocols.Internal.Types
+
+-- hedgehog
+import qualified Hedgehog as H
+
+-- | Superclass class to reduce syntactical noise.
+class (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
+
+instance (NFData a, C.NFDataX a, C.ShowX a, C.Show a, Eq a) => TestType a
+
+-- | Options for 'expectN' function. See individual fields for more information.
+data ExpectOptions = ExpectOptions
+  { eoStopAfterEmpty :: Int
+  -- ^ Stop sampling after seeing /n/ consecutive empty samples
+  , eoSampleMax :: Int
+  -- ^ Produce an error if the circuit produces more than /n/ valid samples. This
+  -- is used to terminate (potentially) infinitely running circuits.
+  --
+  -- This number is used to generate stall information, so setting it to
+  -- unreasonable values will result in long runtimes.
+  , eoResetCycles :: Int
+  -- ^ Ignore first /n/ cycles
+  , eoDriveEarly :: Bool
+  -- ^ Start driving the circuit with its reset asserted. Circuits should
+  -- never acknowledge data while this is happening.
+  , eoTimeoutMs :: Maybe Int
+  -- ^ Terminate the test after /n/ milliseconds.
+  , eoTrace :: Bool
+  -- ^ Trace data generation for debugging purposes
+  }
+
+{- | Provides a way of comparing expected data with data produced by a
+protocol component.
+-}
+class
+  ( Drivable a
+  , TestType (SimulateFwdType a)
+  , TestType (ExpectType a)
+  , -- Foldable requirement on Vec :(
+    1 C.<= SimulateChannels a
+  ) =>
+  Test a
+  where
+  -- | Trim each channel to the lengths given as the third argument. See
+  -- result documentation for failure modes.
+  expectN ::
+    (HasCallStack, H.MonadTest m) =>
+    Proxy a ->
+    -- | Options, see 'ExpectOptions'
+    ExpectOptions ->
+    -- | Raw sampled data
+    SimulateFwdType a ->
+    -- | Depending on "ExpectOptions", fails the test if:
+    --
+    --   * Circuit produced less data than expected
+    --   * Circuit produced more data than expected
+    --
+    -- If it does not fail, /SimulateFwdType a/ will contain exactly the number
+    -- of expected data packets.
+    --
+    -- TODO:
+    --   Should probably return a 'Vec (SimulateChannels) Failures'
+    --   in order to produce pretty reports.
+    m (ExpectType a)