Skip to content

Commit 2b1f6a4

Browse files
committed
Improve roundtrip functions to report annotations on callsite
1 parent 4236853 commit 2b1f6a4

File tree

3 files changed

+23
-6
lines changed

3 files changed

+23
-6
lines changed

cardano-api/cardano-api.cabal

+1
Original file line numberDiff line numberDiff line change
@@ -203,6 +203,7 @@ library gen
203203
, cardano-ledger-shelley ^>= 0.1
204204
, containers
205205
, hedgehog
206+
, hedgehog-extras
206207
, text
207208

208209
test-suite cardano-api-test
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,44 @@
11
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE RankNTypes #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
4+
{-# LANGUAGE TypeApplications #-}
25

36
module Test.Hedgehog.Roundtrip.CBOR
47
( roundtrip_CBOR
58
, roundtrip_CDDL_Tx
69
) where
710

811
import Cardano.Api
9-
import Hedgehog (Gen, Property)
1012

13+
import Data.Proxy (Proxy (..))
14+
import Data.Typeable (typeRep)
15+
import GHC.Stack (HasCallStack)
16+
import qualified GHC.Stack as GHC
17+
import Hedgehog (Gen, Property)
1118
import qualified Hedgehog as H
19+
import qualified Hedgehog.Extras.Test.Base as H
1220

1321
{- HLINT ignore "Use camelCase" -}
1422

1523
roundtrip_CBOR
16-
:: (SerialiseAsCBOR a, Eq a, Show a)
17-
=> AsType a -> Gen a -> Property
24+
:: forall a. (SerialiseAsCBOR a, Eq a, Show a, HasCallStack)
25+
=> AsType a
26+
-> Gen a
27+
-> Property
1828
roundtrip_CBOR typeProxy gen =
1929
H.property $ do
30+
GHC.withFrozenCallStack $ H.noteShow_ $ typeRep $ Proxy @a
2031
val <- H.forAll gen
2132
H.tripping val serialiseToCBOR (deserialiseFromCBOR typeProxy)
2233

2334

2435
roundtrip_CDDL_Tx
25-
:: IsCardanoEra era => CardanoEra era -> Gen (Tx era) -> Property
36+
:: (IsCardanoEra era, HasCallStack)
37+
=> CardanoEra era
38+
-> Gen (Tx era)
39+
-> Property
2640
roundtrip_CDDL_Tx era gen =
2741
H.property $ do
42+
GHC.withFrozenCallStack $ H.noteShow_ era
2843
val <- H.forAll gen
2944
H.tripping val serialiseTxLedgerCddl (deserialiseTxLedgerCddl era)

cardano-api/src/Cardano/Api/HasTypeProxy.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -8,11 +8,12 @@ module Cardano.Api.HasTypeProxy
88
, FromSomeType(..)
99
) where
1010

11+
import Data.Kind (Constraint, Type)
1112
import Data.Proxy (Proxy (..))
12-
import Data.Kind (Type, Constraint)
13+
import Data.Typeable (Typeable)
1314

1415

15-
class HasTypeProxy t where
16+
class Typeable t => HasTypeProxy t where
1617
-- | A family of singleton types used in this API to indicate which type to
1718
-- use where it would otherwise be ambiguous or merely unclear.
1819
--

0 commit comments

Comments
 (0)