{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Conformance.ConformanceSpec (spec) where

import Cardano.Ledger.Crypto (StandardCrypto)
import Cardano.Ledger.TxIn (TxId)
import Data.List (isInfixOf)
import Data.Typeable (Proxy (..), Typeable, typeRep)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Conformance (FixupSpecRep, SpecTranslate (..), runSpecTransM, toTestRep)
import Test.Cardano.Ledger.Conformance.Spec.Conway ()

hashDisplayProp ::
  forall a.
  ( Typeable a
  , Arbitrary a
  , SpecTranslate () a
  , FixupSpecRep (SpecRep a)
  , ToExpr (SpecRep a)
  , ToExpr a
  ) =>
  Spec
hashDisplayProp :: forall a.
(Typeable a, Arbitrary a, SpecTranslate () a,
 FixupSpecRep (SpecRep a), ToExpr (SpecRep a), ToExpr a) =>
Spec
hashDisplayProp = forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy @a)) forall a b. (a -> b) -> a -> b
$ do
  a
someHash <- forall a. Arbitrary a => Gen a
arbitrary @a
  let
    specRes :: SpecRep a
specRes =
      case forall ctx a.
ctx -> SpecTransM ctx a -> Either SpecTranslationError a
runSpecTransM () (forall ctx a.
(SpecTranslate ctx a, FixupSpecRep (SpecRep a)) =>
a -> SpecTransM ctx (SpecRep a)
toTestRep a
someHash) of
        Left SpecTranslationError
e -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Failed to translate hash: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show SpecTranslationError
e
        Right SpecRep a
x -> SpecRep a
x
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => String -> prop -> Property
counterexample (String
"impl expr: " forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr a
someHash)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall prop. Testable prop => String -> prop -> Property
counterexample (String
"spec expr: " forall a. Semigroup a => a -> a -> a
<> forall a. ToExpr a => a -> String
showExpr SpecRep a
specRes)
    forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'"') (forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'"') (forall a. ToExpr a => a -> String
showExpr SpecRep a
specRes)) forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` forall a. ToExpr a => a -> String
showExpr a
someHash

-- TODO think of a more sensible way to test this

spec :: Spec
spec :: Spec
spec =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Translation" forall a b. (a -> b) -> a -> b
$ do
    forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hashes are displayed in the same way in the implementation and in the spec" forall a b. (a -> b) -> a -> b
$ do
      forall a.
(Typeable a, Arbitrary a, SpecTranslate () a,
 FixupSpecRep (SpecRep a), ToExpr (SpecRep a), ToExpr a) =>
Spec
hashDisplayProp @(TxId StandardCrypto)