Fix some issues and inconsistencies related to pretty-printing (#6515)

plutus-core/changelog.d/20240924_105256_unsafeFixIO_pretty.md

@@ -0,0 +1,12 @@
+
+### Removed
+
+- Removed `PlutusIR.Core.Instance.Pretty.Readable.PrettyPir`.
+ Use `PlutusCore.Pretty.Readable.PrettyReadable` instead.
+
+### Changed
+
+- Renamed `PlutusIR.Core.Instance.Pretty.Readable.prettyPirReadable`
+ to `PlutusCore.Pretty.Readable.prettyReadable`.
+- Renamed `PlutusIR.Core.Instance.Pretty.Readable.prettyPirReadableSimple`
+ to `PlutusCore.Pretty.Readable.prettyReadableSimple`.

plutus-core/plutus-core/src/PlutusCore/Pretty.hs

@@ -50,6 +50,8 @@ module PlutusCore.Pretty
  -- * Readable view
  , ShowKinds (..)
  , PrettyConfigReadable (..)
+ , prettyReadable
+ , prettyReadableSimple
  , pcrConfigName
  , pcrRenderContext
  , pcrShowKinds

plutus-core/plutus-core/src/PlutusCore/Pretty/Readable.hs

@@ -272,3 +272,11 @@ iterInterAppPrettyM fun args =
  let ppArg (Left ty) = prettyArg $ inBraces ty
  ppArg (Right term) = prettyArg term
  in prettyFun fun :| map ppArg args
+
+-- | Pretty-print something with the @PrettyConfigReadable@ config.
+prettyReadable :: (PrettyReadable a) => a -> Doc ann
+prettyReadable = prettyBy (botPrettyConfigReadable prettyConfigName def)
+
+-- | Pretty-print something with the @PrettyConfigReadableSimple@ config.
+prettyReadableSimple :: (PrettyReadable a) => a -> Doc ann
+prettyReadableSimple = prettyBy (botPrettyConfigReadable prettyConfigNameSimple def)

plutus-core/plutus-ir/src/PlutusIR/Core/Instance/Pretty/Readable.hs

@@ -11,11 +11,7 @@
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Eta reduce" #-} -- breaks type inference
 
-module PlutusIR.Core.Instance.Pretty.Readable
- ( prettyPirReadable
- , prettyPirReadableSimple
- , PrettyPir
- ) where
+module PlutusIR.Core.Instance.Pretty.Readable () where
 
 import PlutusCore.Pretty
 import PlutusIR.Core.Type
@@ -25,16 +21,6 @@ import Data.Profunctor
 import Prettyprinter
 import Prettyprinter.Custom
 
-type PrettyPir = PrettyBy (PrettyConfigReadable PrettyConfigName)
-
--- | Pretty-print something with the @PrettyConfigReadable@ config.
-prettyPirReadable :: PrettyPir a => a -> Doc ann
-prettyPirReadable = prettyBy (botPrettyConfigReadable prettyConfigName def)
-
--- | Pretty-print something with the @PrettyConfigReadableSimple@ config.
-prettyPirReadableSimple :: PrettyPir a => a -> Doc ann
-prettyPirReadableSimple = prettyBy (botPrettyConfigReadable prettyConfigNameSimple def)
-
 -- | Split an iterated 'LamAbs' (if any) into a list of variables that it binds and its body.
 viewLamAbs
  :: Term tyname name uni fun ann

plutus-core/plutus-ir/test/PlutusIR/Core/Tests.hs

@@ -1,8 +1,8 @@
 module PlutusIR.Core.Tests where
 
 import PlutusCore qualified as PLC
+import PlutusCore.Pretty
 import PlutusIR
-import PlutusIR.Core.Instance.Pretty.Readable
 import PlutusIR.Parser (pTerm)
 import PlutusIR.Test
 
@@ -25,7 +25,7 @@ test_prettyprintingReadable :: TestTree
 test_prettyprintingReadable =
  runTestNested ["plutus-ir", "test", "PlutusIR", "Core", "prettyprintingReadable"] $
  map
- (goldenPirDoc prettyPirReadableSimple pTerm)
+ (goldenPirDoc prettyReadableSimple pTerm)
  [ "basic"
  , "maybe"
  , "letInLet"
@@ -60,4 +60,3 @@ roundTripPirTerm = decodeOrError . unflat . flat . void
  where
  decodeOrError (Right tm) = tm
  decodeOrError (Left err) = error (show err)
-

plutus-core/plutus-ir/test/PlutusIR/Generators/QuickCheck/Tests.hs

@@ -17,12 +17,12 @@ import PlutusCore.Default
 import PlutusCore.Evaluation.Machine.ExBudget
 import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParametersForTesting)
 import PlutusCore.Name.Unique
+import PlutusCore.Pretty
 import PlutusCore.Quote
 import PlutusCore.Rename
 import PlutusCore.Test (toUPlc)
 import PlutusCore.Version (latestVersion)
 import PlutusIR
-import PlutusIR.Core.Instance.Pretty.Readable
 import PlutusIR.Test ()
 import UntypedPlutusCore qualified as UPLC
 import UntypedPlutusCore.Evaluation.Machine.Cek (restricting, runCekNoEmit,
@@ -142,7 +142,7 @@ prop_stats_leaves :: Property
 prop_stats_leaves = withMaxSuccess 10 $
  -- No shrinking here because we are only collecting stats
  forAllDoc "_,tm" genTypeAndTerm_ (const []) $ \ (_, tm) ->
- tabulate "leaves" (map (filter isAlpha . show . prettyPirReadable) $ leaves tm) $ property True
+ tabulate "leaves" (map (filter isAlpha . show . prettyReadable) $ leaves tm) $ property True
  where
  -- Figure out what's at the leaves of the AST,
  -- including variable names, error, and builtins.

plutus-core/testlib/PlutusCore/Generators/QuickCheck/GenerateTypes.hs

@@ -13,9 +13,9 @@ import PlutusCore.Core
 import PlutusCore.Default
 import PlutusCore.Name.Unique
 import PlutusCore.Normalize
+import PlutusCore.Pretty
 import PlutusCore.Quote (runQuote)
 import PlutusIR
-import PlutusIR.Core.Instance.Pretty.Readable
 
 import Control.Monad (replicateM, when)
 import Control.Monad.Reader (asks, local)
@@ -89,9 +89,9 @@ genType k = do
  Right _ -> pure ()
  Left err ->
  error . show $ fold
- [ "genType - checkInvariants: type " <> prettyPirReadable ty
- , " does not match kind " <> prettyPirReadable k
- , " in context " <> prettyPirReadable ctx
+ [ "genType - checkInvariants: type " <> prettyReadable ty
+ , " does not match kind " <> prettyReadable k
+ , " in context " <> prettyReadable ctx
  , " with error message " <> fromString err
  ]
  pure ty

plutus-core/testlib/PlutusCore/Generators/QuickCheck/Utils.hs

@@ -14,7 +14,6 @@ import PlutusCore.Pretty
 import PlutusCore.Quote
 import PlutusIR
 import PlutusIR.Compiler.Datatype
-import PlutusIR.Core.Instance.Pretty.Readable
 import PlutusIR.Subst
 
 import Data.Kind qualified as GHC
@@ -43,31 +42,31 @@ ceDoc d = counterexample (render d)
 -- | Bind a value to a name in a property so that
 -- it is displayed as a `name = thing` binding if the
 -- property fails.
-letCE :: (PrettyPir a, Testable p)
+letCE :: (PrettyReadable a, Testable p)
  => String
  -> a
  -> (a -> p)
  -> Property
-letCE name x k = ceDoc (fromString name <+> "=" <+> prettyPirReadable x) (k x)
+letCE name x k = ceDoc (fromString name <+> "=" <+> prettyReadable x) (k x)
 
 -- | Like `forAllShrink` but displays the bound value as
 -- a named pretty-printed binding like `letCE`
-forAllDoc :: (PrettyPir a, Testable p)
+forAllDoc :: (PrettyReadable a, Testable p)
  => String
  -> Gen a
  -> (a -> [a])
  -> (a -> p)
  -> Property
 forAllDoc name g shr k =
  forAllShrinkBlind g shr $ \ x ->
- ceDoc (fromString name <+> "=" <+> prettyPirReadable x)
+ ceDoc (fromString name <+> "=" <+> prettyReadable x)
  (k x)
 
 -- | Check that a list of potential counterexamples is empty and display the
 -- list as a QuickCheck counterexample if its not.
-assertNoCounterexamples :: PrettyPir a => [a] -> Property
+assertNoCounterexamples :: (PrettyReadable a) => [a] -> Property
 assertNoCounterexamples [] = property True
-assertNoCounterexamples bad = ceDoc (prettyPirReadable bad) False
+assertNoCounterexamples bad = ceDoc (prettyReadable bad) False
 
 -- * Containers (zipper-ish, very useful for shrinking).
 

plutus-core/testlib/PlutusIR/Generators/QuickCheck/GenerateTerms.hs

@@ -32,10 +32,10 @@ import PlutusCore.Core (argsFunKind)
 import PlutusCore.Default
 import PlutusCore.MkPlc (mkConstantOf)
 import PlutusCore.Name.Unique
+import PlutusCore.Pretty
 import PlutusCore.Subst (typeSubstClosedType)
 import PlutusIR
 import PlutusIR.Compiler
-import PlutusIR.Core.Instance.Pretty.Readable
 import PlutusIR.Subst
 
 import Control.Lens ((<&>))
@@ -55,7 +55,6 @@ import Data.Set.Lens (setOf)
 import Data.String
 import GHC.Stack
 import Prettyprinter
-import Text.PrettyBy
 
 -- | This type keeps track of what kind of argument, term argument (`InstArg`) or
 -- type argument (`InstApp`) is required for a function. This type is used primarily
@@ -264,10 +263,10 @@ genTerm mty = checkInvariants $ do
  if debug then
  case typeCheckTermInContext tyctx tmctx tm ty of
  Left err ->
- (error . show $ "genTerm - checkInvariants: term " <> prettyPirReadable tm
- <> " does not type check at type " <> prettyPirReadable ty
- <> " in type context " <> prettyPirReadable tyctx
- <> " and term context " <> prettyPirReadable tmctx
+ (error . show $ "genTerm - checkInvariants: term " <> prettyReadable tm
+ <> " does not type check at type " <> prettyReadable ty
+ <> " in type context " <> prettyReadable tyctx
+ <> " and term context " <> prettyReadable tmctx
  <> " with error message " <> fromString err)
  _ -> return (ty, tm)
  else

plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NegativeLiterals.pir.golden

@@ -1,20 +1,18 @@
-program
- 1.1.0
- (\(x : integer) ->
-  addInteger
- 24680135792468013579
+\(x : integer) ->
+ addInteger
+  24680135792468013579
+ (addInteger
+ -99887766554433221100
  (addInteger
- -99887766554433221100
+ 98765432109876543210
  (addInteger
- 98765432109876543210
+ -654
  (addInteger
- -654
+ 456
  (addInteger
- 456
+ 13579246801357924680
  (addInteger
- 13579246801357924680
+ -11223344556677889900
  (addInteger
- -11223344556677889900
- (addInteger
- 12345678901234567890
- (addInteger -321 (multiplyInteger 123 x))))))))))
+ 12345678901234567890
+ (addInteger -321 (multiplyInteger 123 x)))))))))

plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-NoStrict-NoNegativeLiterals.pir.golden

@@ -1,20 +1,18 @@
-program
- 1.1.0
- (\(x : integer) ->
-  addInteger
- 24680135792468013579
+\(x : integer) ->
+ addInteger
+  24680135792468013579
+ (addInteger
+ -99887766554433221100
  (addInteger
- -99887766554433221100
+ 98765432109876543210
  (addInteger
- 98765432109876543210
+ -654
  (addInteger
- -654
+ 456
  (addInteger
- 456
+ 13579246801357924680
  (addInteger
- 13579246801357924680
+ -11223344556677889900
  (addInteger
- -11223344556677889900
- (addInteger
- 12345678901234567890
- (addInteger -321 (multiplyInteger 123 x))))))))))
+ 12345678901234567890
+ (addInteger -321 (multiplyInteger 123 x)))))))))

plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NegativeLiterals.pir.golden

@@ -1,20 +1,18 @@
-program
- 1.1.0
- (\(x : integer) ->
-  addInteger
- 24680135792468013579
+\(x : integer) ->
+ addInteger
+  24680135792468013579
+ (addInteger
+ -99887766554433221100
  (addInteger
- -99887766554433221100
+ 98765432109876543210
  (addInteger
- 98765432109876543210
+ -654
  (addInteger
- -654
+ 456
  (addInteger
- 456
+ 13579246801357924680
  (addInteger
- 13579246801357924680
+ -11223344556677889900
  (addInteger
- -11223344556677889900
- (addInteger
- 12345678901234567890
- (addInteger -321 (multiplyInteger 123 x))))))))))
+ 12345678901234567890
+ (addInteger -321 (multiplyInteger 123 x)))))))))

plutus-tx-plugin/test/IntegerLiterals/9.6/integerLiterals-Strict-NoNegativeLiterals.pir.golden

@@ -1,20 +1,18 @@
-program
- 1.1.0
- (\(x : integer) ->
-  addInteger
- 24680135792468013579
+\(x : integer) ->
+ addInteger
+  24680135792468013579
+ (addInteger
+ -99887766554433221100
  (addInteger
- -99887766554433221100
+ 98765432109876543210
  (addInteger
- 98765432109876543210
+ -654
  (addInteger
- -654
+ 456
  (addInteger
- 456
+ 13579246801357924680
  (addInteger
- 13579246801357924680
+ -11223344556677889900
  (addInteger
- -11223344556677889900
- (addInteger
- 12345678901234567890
- (addInteger -321 (multiplyInteger 123 x))))))))))
+ 12345678901234567890
+ (addInteger -321 (multiplyInteger 123 x)))))))))

plutus-tx-plugin/test/IntegerLiterals/NoStrict/NegativeLiterals/Spec.hs

@@ -21,7 +21,7 @@ import Test.Tasty.Extras
 
 tests :: TestNested
 tests = testNested "IntegerLiterals" . pure $ testNestedGhc
- [ goldenPir "integerLiterals-NoStrict-NegativeLiterals" integerLiterals
+ [ goldenPirReadable "integerLiterals-NoStrict-NegativeLiterals" integerLiterals
  ]
 
 integerLiterals :: CompiledCode (Integer -> Integer)

plutus-tx-plugin/test/IntegerLiterals/NoStrict/NoNegativeLiterals/Spec.hs

@@ -20,7 +20,7 @@ import Test.Tasty.Extras
 
 tests :: TestNested
 tests = testNested "IntegerLiterals" . pure $ testNestedGhc
- [ goldenPir "integerLiterals-NoStrict-NoNegativeLiterals" integerLiterals
+ [ goldenPirReadable "integerLiterals-NoStrict-NoNegativeLiterals" integerLiterals
  ]
 
 integerLiterals :: CompiledCode (Integer -> Integer)

plutus-tx-plugin/test/IntegerLiterals/Strict/NegativeLiterals/Spec.hs

@@ -21,7 +21,7 @@ import Test.Tasty.Extras
 
 tests :: TestNested
 tests = testNested "IntegerLiterals" . pure $ testNestedGhc
- [ goldenPir "integerLiterals-Strict-NegativeLiterals" integerLiterals
+ [ goldenPirReadable "integerLiterals-Strict-NegativeLiterals" integerLiterals
  ]
 
 integerLiterals :: CompiledCode (Integer -> Integer)

plutus-tx-plugin/test/IntegerLiterals/Strict/NoNegativeLiterals/Spec.hs

@@ -20,7 +20,7 @@ import Test.Tasty.Extras
 
 tests :: TestNested
 tests = testNested "IntegerLiterals" . pure $ testNestedGhc
- [ goldenPir "integerLiterals-Strict-NoNegativeLiterals" integerLiterals
+ [ goldenPirReadable "integerLiterals-Strict-NoNegativeLiterals" integerLiterals
  ]
 
 integerLiterals :: CompiledCode (Integer -> Integer)