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, (===))

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

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

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