Remove SimpleShow, add non-record Show instances

Author: jaccokrijnen

plutus-core/executables/plutus/AnyProgram/Compile.hs

@@ -35,7 +35,6 @@ import Control.Monad.Reader
 import Data.Singletons.Decide
 import Data.Text
 import PlutusPrelude hiding ((%~))
-import Text.SimpleShow
 
 -- Note that we use for erroring the original term's annotation
 compileProgram :: (?opts :: Opts, e ~ PIR.Provenance (FromAnn (US_ann s1)),
@@ -76,7 +75,7 @@ compileProgram = curry $ \case
 
     -- pir to plc
     ----------------------------------------
-    (SPir n1@SName a1, SPlc n2 SUnit) -> withA @Ord a1 $ withA @Pretty a1 $ withA @SimpleShow a1 $
+    (SPir n1@SName a1, SPlc n2 SUnit) -> withA @Ord a1 $ withA @Pretty a1 $ withA @Show a1 $
         -- Note: PIR.compileProgram subsumes pir typechecking
         (PLC.runQuoteT . flip runReaderT compCtx . PIR.compileProgram (const (return ())))
         >=> plcToOutName n1 n2

plutus-core/plutus-core.cabal

@@ -190,7 +190,6 @@ library
     PlutusCore.Version
     PlutusPrelude
     Prettyprinter.Custom
-    Text.SimpleShow
     Universe
     UntypedPlutusCore
     UntypedPlutusCore.Check.Scope

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

@@ -23,12 +23,10 @@ import Data.MonoTraversable
 import Data.Semigroup (Any (..))
 import Data.Set (Set)
 import Data.Set qualified as Set
-import Data.Text qualified as T
 import Flat (Flat (..))
 import GHC.Generics
 import Prettyprinter
 import Text.Megaparsec.Pos as Megaparsec
-import Text.SimpleShow
 
 newtype InlineHints name a = InlineHints { shouldInline :: a -> name -> Bool }
     deriving (Semigroup, Monoid) via (a -> name -> Any)
@@ -42,7 +40,7 @@ data Ann = Ann
     , annSrcSpans :: SrcSpans
     }
     deriving stock (Eq, Ord, Generic, Show)
-    deriving anyclass (Hashable, SimpleShow)
+    deriving anyclass (Hashable)
 
 data Inline
     = -- | When calling @PlutusIR.Compiler.Definitions.defineTerm@ to add a new term definition,
@@ -57,7 +55,6 @@ data Inline
     | MayInline
     deriving stock (Eq, Ord, Generic, Show)
     deriving anyclass (Hashable)
-    deriving anyclass (SimpleShow)
 
 instance Pretty Ann where
     pretty = viaShow
@@ -90,13 +87,6 @@ data SrcSpan = SrcSpan
     deriving stock (Eq, Ord, Generic)
     deriving anyclass (Flat, Hashable, NFData)
 
--- Cannot directly derive SimpleShow using Generic, since an instance of SimpleShow FilePath
--- ( = String) results in overlapping instances, which do not work well with
--- QuantifiedConstraints (needed for instances of uni)
--- Workaround: print as tuple and use Text instance
-instance SimpleShow SrcSpan where
-  simpleShow (SrcSpan f l c l' c') = simpleShow (T.pack f, l, c, l', c')
-
 instance Show SrcSpan where
     showsPrec _ s =
         showString (srcSpanFile s)
@@ -115,7 +105,7 @@ instance Pretty SrcSpan where
 newtype SrcSpans = SrcSpans {unSrcSpans :: Set SrcSpan}
     deriving newtype (Eq, Ord, Hashable, Semigroup, Monoid, MonoFoldable, NFData)
     deriving stock (Generic)
-    deriving anyclass (Flat, SimpleShow)
+    deriving anyclass (Flat)
 
 type instance Element SrcSpans = SrcSpan
 

plutus-core/plutus-core/src/PlutusCore/Core/Type.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE MultiParamTypeClasses    #-}
 {-# LANGUAGE PatternSynonyms          #-}
 {-# LANGUAGE PolyKinds                #-}
-{-# LANGUAGE QuantifiedConstraints    #-}
 {-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TemplateHaskell          #-}
 {-# LANGUAGE TypeApplications         #-}
@@ -70,14 +69,13 @@ import Data.List.NonEmpty qualified as NE
 import Data.Word
 import Instances.TH.Lift ()
 import Language.Haskell.TH.Lift
-import Text.SimpleShow
 import Universe
 
 data Kind ann
     = Type ann
     | KindArrow ann (Kind ann) (Kind ann)
     deriving stock (Eq, Show, Functor, Generic, Lift)
-    deriving anyclass (NFData, Hashable, SimpleShow)
+    deriving anyclass (NFData, Hashable)
 
 -- | The kind of a pattern functor (the first 'Type' argument of 'TyIFix') at a given kind (of the
 -- second 'Type' argument of 'TyIFix'):
@@ -111,14 +109,6 @@ data Type tyname uni ann
     deriving stock (Show, Functor, Generic)
     deriving anyclass (NFData)
 
-deriving anyclass instance
-  ( SimpleShow tyname
-  , forall t. SimpleShow (uni t)
-  , Everywhere uni SimpleShow
-  , SimpleShow a
-  ) =>
-  SimpleShow (Type tyname uni a)
-
 -- | Get recursively all the domains and codomains of a type.
 -- @splitFunTyParts (A->B->C) = [A, B, C]@
 -- @splitFunTyParts (X) = [X]@
@@ -195,30 +185,40 @@ data TyVarDecl tyname ann = TyVarDecl
     { _tyVarDeclAnn  :: ann
     , _tyVarDeclName :: tyname
     , _tyVarDeclKind :: Kind ann
-    } deriving stock (Functor, Show, Generic)
-makeLenses ''TyVarDecl
+    } deriving stock (Functor, Generic)
+
+instance (Show tn, Show ann) => Show (TyVarDecl tn ann) where
+  showsPrec p (TyVarDecl x y z) =
+    showParen (p >= 11) $
+      showString "TyVarDecl" .
+      showString " " .
+      showsPrec 11 x .
+      showString " " .
+      showsPrec 11 y .
+      showString " " .
+      showsPrec 11 z
 
-deriving anyclass instance
-  ( SimpleShow tyname
-  , SimpleShow a
-  ) => SimpleShow (TyVarDecl tyname a)
+makeLenses ''TyVarDecl
 
 -- | A "variable declaration", i.e. a name and a type for a variable.
 data VarDecl tyname name uni ann = VarDecl
     { _varDeclAnn  :: ann
     , _varDeclName :: name
     , _varDeclType :: Type tyname uni ann
-    } deriving stock (Functor, Show, Generic)
-makeLenses ''VarDecl
+    } deriving stock (Functor, Generic)
+
+instance (Show tn, Show ann, GShow uni, Show n) => Show (VarDecl tn n uni ann) where
+  showsPrec p (VarDecl x y z) =
+    showParen (p >= 11) $
+      showString "VarDecl" .
+      showString " " .
+      showsPrec 11 x .
+      showString " " .
+      showsPrec 11 y .
+      showString " " .
+      showsPrec 11 z
 
-deriving anyclass instance
-  ( SimpleShow tyname
-  , SimpleShow name
-  , forall t. SimpleShow (uni t)
-  , Everywhere uni SimpleShow
-  , SimpleShow a
-  ) =>
-  SimpleShow (VarDecl tyname name uni a)
+makeLenses ''VarDecl
 
 -- | A "type declaration", i.e. a kind for a type.
 data TyDecl tyname uni ann = TyDecl

plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/G1.hs

@@ -31,10 +31,8 @@ import Data.ByteString (ByteString, length)
 import Data.Coerce (coerce)
 import Data.Hashable
 import Data.Proxy (Proxy (..))
-import Data.Text qualified as T
 import Flat
 import Prettyprinter
-import Text.SimpleShow
 
 {- Note [Wrapping the BLS12-381 types in Plutus Core].  In the Haskell bindings
 to the `blst` library in cardano-crypto-class, points in G1 and G2 are
@@ -75,9 +73,6 @@ instance NFData Element where
 instance Hashable Element where
     hashWithSalt salt = hashWithSalt salt . compress
 
-instance SimpleShow Element where
-    simpleShow = T.pack . show
-
 -- | Add two G1 group elements
 add :: Element -> Element -> Element
 add = coerce (BlstBindings.blsAddOrDouble @BlstBindings.Curve1)

plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/G2.hs

@@ -31,10 +31,8 @@ import Data.ByteString (ByteString, length)
 import Data.Coerce (coerce)
 import Data.Hashable
 import Data.Proxy (Proxy (..))
-import Data.Text qualified as T
 import Flat
 import Prettyprinter
-import Text.SimpleShow
 
 {- | See Note [Wrapping the BLS12-381 types in Plutus Core]. -}
 newtype Element = Element { unElement :: BlstBindings.Point2 }
@@ -61,9 +59,6 @@ instance NFData Element where
 instance Hashable Element where
     hashWithSalt salt = hashWithSalt salt . compress
 
-instance SimpleShow Element where
-    simpleShow = T.pack . show
-
 -- | Add two G2 group elements
 add :: Element -> Element -> Element
 add = coerce (BlstBindings.blsAddOrDouble @BlstBindings.Curve2)

plutus-core/plutus-core/src/PlutusCore/Crypto/BLS12_381/Pairing.hs

@@ -22,10 +22,8 @@ import Text.PrettyBy (PrettyBy, prettyBy)
 import Control.DeepSeq (NFData, rnf)
 import Data.Coerce (coerce)
 import Data.Hashable
-import Data.Text qualified as T
 import Flat
 import Prettyprinter
-import Text.SimpleShow
 
 {- | This type represents the result of computing a pairing using the Miller
    loop.  Values of this type are ephemeral, only created during script
@@ -55,9 +53,6 @@ instance NFData MlResult where
 instance Hashable MlResult where
     hashWithSalt salt = const salt
 
-instance SimpleShow MlResult where
-    simpleShow = T.pack . show
-
 millerLoop :: G1.Element -> G2.Element -> MlResult
 millerLoop = coerce BlstBindings.millerLoop
 

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

@@ -29,7 +29,6 @@ import GHC.Generics
 import NoThunks.Class
 import Prelude
 import Prettyprinter
-import Text.SimpleShow
 
 -- Attempting to make this strict made code slower by 2%,
 -- see https://github.com/IntersectMBO/plutus/pull/4622
@@ -59,8 +58,6 @@ instance Pretty Data where
             -- Base64 encode the ByteString since it may contain arbitrary bytes
             pretty (Text.decodeLatin1 (Base64.encode b))
 
-deriving anyclass instance SimpleShow Data
-
 {- Note [Encoding via Term]
 We want to write a custom encoder/decoder for Data (i.e. not use the Generic version), but actually
 doing this is a pain. So instead we go via the CBOR 'Term' representation, which lets us process a

plutus-core/plutus-core/src/PlutusCore/Default/Builtins.hs

@@ -48,7 +48,6 @@ import Flat.Decoder (Get, dBEBits8)
 import Flat.Encoder as Flat (Encoding, NumBits, eBits)
 import NoThunks.Class (NoThunks)
 import Prettyprinter (viaShow)
-import Text.SimpleShow
 
 -- See Note [Pattern matching on built-in types].
 -- TODO: should we have the commonest built-in functions at the front to have more compact encoding?
@@ -175,7 +174,7 @@ data DefaultFun
     | Ripemd_160
     | ExpModInteger
     deriving stock (Show, Eq, Ord, Enum, Bounded, Generic, Ix)
-    deriving anyclass (NFData, Hashable, PrettyBy PrettyConfigPlc, SimpleShow)
+    deriving anyclass (NFData, Hashable, PrettyBy PrettyConfigPlc)
 
 {- Note [Textual representation of names of built-in functions]. The plc parser
  parses builtin names by looking at an enumeration of all of the built-in

plutus-core/plutus-core/src/PlutusCore/Default/Universe.hs

@@ -62,7 +62,6 @@ import Data.Typeable (typeRep)
 import Data.Word
 import GHC.Exts (inline, oneShot)
 import Text.PrettyBy.Fixity
-import Text.SimpleShow
 import Universe as Export
 
 {- Note [PLC types and universes]
@@ -179,12 +178,6 @@ instance GEq DefaultUni where
         geqRec = geqStep
         {-# OPAQUE geqRec #-}
 
-instance SimpleShow (DefaultUni a) where
-  simpleShow x = parens True (Text.pack (show x))
-
-instance SimpleShow (Some (ValueOf DefaultUni)) where
-  simpleShow (Some x) = parens True (simpleShow x)
-
 -- | For pleasing the coverage checker.
 noMoreTypeFunctions :: DefaultUni (Esc (f :: a -> b -> c -> d)) -> any
 noMoreTypeFunctions (f `DefaultUniApply` _) = noMoreTypeFunctions f