module Test.Cardano.Ledger.Generic.PrettyTest (testwidth, prettyTest) where
import Cardano.Ledger.Core (Tx, TxBody)
import Cardano.Ledger.Shelley (Shelley)
import Cardano.Ledger.Shelley.LedgerState (LedgerState)
import Cardano.Ledger.UTxO (UTxO)
import Prettyprinter (defaultLayoutOptions, layoutPretty)
import Prettyprinter.Render.Text (renderStrict)
import Prettyprinter.Util (putDocW)
import Test.Cardano.Ledger.Generic.PrettyCore
import Test.Cardano.Ledger.Generic.Proof (Proof (Shelley))
import Test.Cardano.Ledger.Shelley.Arbitrary ()
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Tasty
import Test.Tasty.QuickCheck (Arbitrary (..), Gen, generate, testProperty, withMaxSuccess, (===))
txbody :: Gen (TxBody Shelley)
txbody :: Gen (TxBody Shelley)
txbody = forall a. Arbitrary a => Gen a
arbitrary
tx :: Gen (Tx Shelley)
tx :: Gen (Tx Shelley)
tx = forall a. Arbitrary a => Gen a
arbitrary
utxo :: Gen (UTxO Shelley)
utxo :: Gen (UTxO Shelley)
utxo = forall a. Arbitrary a => Gen a
arbitrary
ls :: Gen (LedgerState Shelley)
ls :: Gen (LedgerState Shelley)
ls = forall a. Arbitrary a => Gen a
arbitrary
testwidth :: Int -> Gen a -> (a -> PDoc) -> IO ()
testwidth :: forall a. Int -> Gen a -> (a -> PDoc) -> IO ()
testwidth Int
n Gen a
gen a -> PDoc
pp = do
a
b <- forall a. Gen a -> IO a
generate Gen a
gen
let doc :: PDoc
doc = a -> PDoc
pp a
b
forall ann. Int -> Doc ann -> IO ()
putDocW Int
n PDoc
doc
String -> IO ()
putStrLn String
""
testPP :: String -> (t -> PDoc) -> Gen t -> TestTree
testPP :: forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
name t -> PDoc
ppT Gen t
gen = forall a. Testable a => String -> a -> TestTree
testProperty String
name (do t
t <- Gen t
gen; forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
25 (forall {ann}. Doc ann -> Text
toText (t -> PDoc
ppT t
t) forall a. (Eq a, Show a) => a -> a -> Property
=== forall {ann}. Doc ann -> Text
toText (t -> PDoc
ppT t
t))))
where
toText :: Doc ann -> Text
toText Doc ann
doc = forall ann. SimpleDocStream ann -> Text
renderStrict (forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Doc ann
doc)
prettyTest :: TestTree
prettyTest :: TestTree
prettyTest =
String -> [TestTree] -> TestTree
testGroup
String
"Pretty printer tests"
[ forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"UTxO" (forall era. Proof era -> UTxO era -> PDoc
pcUTxO Proof Shelley
proof) Gen (UTxO Shelley)
utxo
, forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"TxBody" (forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof Shelley
proof) Gen (TxBody Shelley)
txbody
, forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"Tx" (forall era. Proof era -> Tx era -> PDoc
pcTx Proof Shelley
proof) Gen (Tx Shelley)
tx
, forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"LedgerState" (forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof Shelley
proof) Gen (LedgerState Shelley)
ls
]
where
proof :: Proof Shelley
proof = Proof Shelley
Shelley