Simulate tuple instances

clash-protocols/clash-protocols.cabal

@@ -149,6 +149,7 @@ library
     Protocols.DfConv
     Protocols.Hedgehog
     Protocols.Hedgehog.Internal
+    Protocols.Hedgehog.Types
     Protocols.Idle
     Protocols.Internal.TH
     Protocols.Wishbone

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.hs

@@ -55,6 +55,9 @@ import qualified Hedgehog.Range as Range
 -- lifted-async
 import Control.Concurrent.Async.Lifted (race)
 
+-- me
+import Protocols.Hedgehog.Types
+
 -- | Whether to stall or not. Used in 'idWithModel'.
 data StallMode = NoStall | Stall
   deriving (Show, Enum, Bounded)

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

@@ -3,6 +3,7 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE UndecidableSuperClasses #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 
 {- |
@@ -20,37 +21,15 @@ import Protocols
 import qualified Protocols.Df as Df
 
 -- 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
-  }
+-- 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
@@ -72,45 +51,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.

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

@@ -0,0 +1,77 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+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)