module Test.Cardano.Ledger.Generic.PrettyTest (testwidth, prettyTest) where

import Cardano.Ledger.Core (Tx, TxBody)
import Cardano.Ledger.Shelley (ShelleyEra)
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, (===))

-- ====================================================
-- a few generators to generate random UTxO, TxBody, Tx and LedgerState

txbody :: Gen (TxBody ShelleyEra)
txbody :: Gen (TxBody ShelleyEra)
txbody = forall a. Arbitrary a => Gen a
arbitrary

tx :: Gen (Tx ShelleyEra)
tx :: Gen (Tx ShelleyEra)
tx = forall a. Arbitrary a => Gen a
arbitrary

utxo :: Gen (UTxO ShelleyEra)
utxo :: Gen (UTxO ShelleyEra)
utxo = forall a. Arbitrary a => Gen a
arbitrary

ls :: Gen (LedgerState ShelleyEra)
ls :: Gen (LedgerState ShelleyEra)
ls = forall a. Arbitrary a => Gen a
arbitrary

-- | Used to test pretty printing things with different widths
--   for example: testwidth 120 ls ppLedgerState
--   prints a random LedgerState with a max width of 120 columns
--   one can use this to observe the how "pretty" a printer is at different widths
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
""

-- | The idea is to see that the pretty printer actually produces some output
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 ShelleyEra
proof) Gen (UTxO ShelleyEra)
utxo
    , forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"TxBody" (forall era. Proof era -> TxBody era -> PDoc
pcTxBody Proof ShelleyEra
proof) Gen (TxBody ShelleyEra)
txbody
    , forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"Tx" (forall era. Proof era -> Tx era -> PDoc
pcTx Proof ShelleyEra
proof) Gen (Tx ShelleyEra)
tx
    , forall t. String -> (t -> PDoc) -> Gen t -> TestTree
testPP String
"LedgerState" (forall era. Proof era -> LedgerState era -> PDoc
pcLedgerState Proof ShelleyEra
proof) Gen (LedgerState ShelleyEra)
ls
    ]
  where
    proof :: Proof ShelleyEra
proof = Proof ShelleyEra
Shelley