module Plutarch.Show (
  PShow (pshow'),
  pshow,
  pshowAndErr,
) where

import Data.Char (intToDigit)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NE
import Data.Semigroup (sconcat)
import Data.String (IsString (fromString))
import Data.Text qualified as T
import Generics.SOP (
  All,
  All2,
  ConstructorName,
  K (K),
  NP,
  NS,
  Proxy (Proxy),
  SOP (SOP),
  constructorInfo,
  constructorName,
  hcmap,
  hcollapse,
  hindex,
  hmap,
 )
import Generics.SOP.GGP (gdatatypeInfo)
import Plutarch.Bool (PBool, PEq, pif, pif', (#<), (#==))
import Plutarch.ByteString (PByteString, pconsBS, pindexBS, plengthBS, psliceBS)
import Plutarch.Integer (PInteger, PIntegral (pquot, prem))
import Plutarch.Internal (
  Term,
  perror,
  phoistAcyclic,
  plet,
  punsafeCoerce,
  (#),
  (#$),
  (:-->),
 )
import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom)
import Plutarch.Internal.Other (
  pfix,
 )
import Plutarch.Internal.PLam (plam)
import Plutarch.Internal.PlutusType (PlutusType, pmatch)
import Plutarch.Lift (pconstant)
import Plutarch.String (PString, pdecodeUtf8, pencodeUtf8)

class PShow t where
  -- | Return the string representation of a Plutarch value
  --
  --  If the wrap argument is True, optionally wrap the output in `(..)` if it
  --  represents multiple parameters.
  pshow' :: Bool -> Term s t -> Term s PString
  default pshow' :: (PGeneric t, PlutusType t, All2 PShow (PCode t)) => Bool -> Term s t -> Term s PString
  pshow' Bool
wrap Term s t
x = forall (a :: PType) (s :: S).
(PGeneric a, PlutusType a, All2 @PType PShow (PCode a)) =>
Bool -> Term s (a :--> PString)
gpshow Bool
wrap forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s t
x

-- | Return the string representation of a Plutarch value
pshow :: PShow a => Term s a -> Term s PString
pshow :: forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow = forall (t :: PType) (s :: S).
PShow t =>
Bool -> Term s t -> Term s PString
pshow' Bool
False

instance PShow PString where
  pshow' :: forall (s :: S). Bool -> Term s PString -> Term s PString
pshow' Bool
_ Term s PString
x = forall (s :: S). Term s (PString :--> PString)
pshowStr forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
x
    where
      pshowStr :: Term s (PString :--> PString)
      pshowStr :: forall (s :: S). Term s (PString :--> PString)
pshowStr = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PString
s ->
          Term s PString
"\"" forall a. Semigroup a => a -> a -> a
<> (forall (s :: S). Term s (PByteString :--> PString)
pdecodeUtf8 forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S). Term s (PByteString :--> PByteString)
pshowUtf8Bytes forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S). Term s (PString :--> PByteString)
pencodeUtf8 forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
s) forall a. Semigroup a => a -> a -> a
<> Term s PString
"\""
      pshowUtf8Bytes :: Term s (PByteString :--> PByteString)
      pshowUtf8Bytes :: forall (s :: S). Term s (PByteString :--> PByteString)
pshowUtf8Bytes = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PByteString :--> PByteString)
self Term s PByteString
bs ->
          forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PInteger :--> (PByteString :--> a)) :--> a)))
pelimBS
            # bs
            # bs
              #$ plam
            $ \x xs ->
              -- Non-ascii byte sequence will not use bytes < 128.
              -- So we are safe to rewrite the lower byte values.
              -- https://en.wikipedia.org/wiki/UTF-8#Encoding
              let doubleQuote :: Term _ PInteger = 34 -- `"`
                  escapeSlash :: Term _ PInteger = 92 -- `\`
                  rec_ = pconsBS # x #$ self # xs
               in pif
                    (x #== doubleQuote)
                    (pconsBS # escapeSlash # rec_)
                    rec_

instance PShow PBool where
  pshow' :: forall (s :: S). Bool -> Term s PBool -> Term s PString
pshow' Bool
_ Term s PBool
x = forall (s :: S). Term s (PBool :--> PString)
pshowBool forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PBool
x
    where
      pshowBool :: Term s (PBool :--> PString)
      pshowBool :: forall (s :: S). Term s (PBool :--> PString)
pshowBool = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PBool
x ->
          -- Delegate to Haskell's Show instance
          forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s PBool
x forall a b. (a -> b) -> a -> b
$ forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant @PString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance PShow PInteger where
  pshow' :: forall (s :: S). Bool -> Term s PInteger -> Term s PString
pshow' Bool
_ Term s PInteger
x = forall (s :: S). Term s (PInteger :--> PString)
pshowInt forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
x
    where
      pshowInt :: Term s (PInteger :--> PString)
      pshowInt :: forall (s :: S). Term s (PInteger :--> PString)
pshowInt = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PInteger :--> PString)
self Term s PInteger
n ->
          let sign :: Term s PString
sign = forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
n forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s PInteger
0) Term s PString
"-" Term s PString
""
           in Term s PString
sign
                forall a. Semigroup a => a -> a -> a
<> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet
                  (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pquot forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall a. Num a => a -> a
abs Term s PInteger
n forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
10)
                  ( \Term s PInteger
q ->
                      forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
prem forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall a. Num a => a -> a
abs Term s PInteger
n forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
10) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
r ->
                        forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
                          (Term s PInteger
q forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0)
                          (forall (s :: S). Term s (PInteger :--> PString)
pshowDigit forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
r)
                          ( forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PInteger :--> PString)
self forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
q) forall a b. (a -> b) -> a -> b
$ \Term s PString
prefix ->
                              Term s PString
prefix forall a. Semigroup a => a -> a -> a
<> forall (s :: S). Term s (PInteger :--> PString)
pshowDigit forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
r
                          )
                  )
      pshowDigit :: Term s (PInteger :--> PString)
      pshowDigit :: forall (s :: S). Term s (PInteger :--> PString)
pshowDigit = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PInteger
digit ->
          forall (a :: PType) (s :: S) (b :: PType).
PEq a =>
Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b
pcase forall (s :: S) (a :: PType). Term s a
perror Term s PInteger
digit forall a b. (a -> b) -> a -> b
$
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Integer
0 .. Integer
9] forall a b. (a -> b) -> a -> b
$ \(Integer
x :: Integer) ->
              (forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Integer
x, forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Integer
x))

instance PShow PByteString where
  pshow' :: forall (s :: S). Bool -> Term s PByteString -> Term s PString
pshow' Bool
_ Term s PByteString
x = forall (s :: S). Term s (PByteString :--> PString)
showByteString forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
x
    where
      showByteString :: Term s (PByteString :--> PString)
      showByteString :: forall (s :: S). Term s (PByteString :--> PString)
showByteString = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PByteString
bs ->
          Term s PString
"0x" forall a. Semigroup a => a -> a -> a
<> forall (s :: S). Term s (PByteString :--> PString)
showByteString' forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs
      showByteString' :: Term s (PByteString :--> PString)
      showByteString' :: forall (s :: S). Term s (PByteString :--> PString)
showByteString' = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PByteString :--> PString)
self Term s PByteString
bs ->
          forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PInteger :--> (PByteString :--> a)) :--> a)))
pelimBS
            # bs
            # pconstant @PString ""
              #$ plam
            $ \x xs -> showByte # x <> self # xs
      showByte :: Term s (PInteger :--> PString)
      showByte :: forall (s :: S). Term s (PInteger :--> PString)
showByte = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
          forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
pquot forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
n forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
16) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
a ->
            forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (a :: PType) (s :: S).
PIntegral a =>
Term s (a :--> (a :--> a))
prem forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
n forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
16) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
b ->
              forall (s :: S). Term s (PInteger :--> PString)
showNibble forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
a forall a. Semigroup a => a -> a -> a
<> forall (s :: S). Term s (PInteger :--> PString)
showNibble forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
b
      showNibble :: Term s (PInteger :--> PString)
      showNibble :: forall (s :: S). Term s (PInteger :--> PString)
showNibble = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
          forall (a :: PType) (s :: S) (b :: PType).
PEq a =>
Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b
pcase forall (s :: S) (a :: PType). Term s a
perror Term s PInteger
n forall a b. (a -> b) -> a -> b
$
            forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int
0 .. Int
15] forall a b. (a -> b) -> a -> b
$ \(Int
x :: Int) ->
              ( forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Int
x
              , forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant @PString forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack [Int -> Char
intToDigit Int
x]
              )

-- | Case matching on bytestring, as if a list.
pelimBS ::
  Term
    s
    ( PByteString
        :--> a -- If bytestring is empty
        :--> (PInteger :--> PByteString :--> a) -- If bytestring is non-empty
        :--> a
    )
pelimBS :: forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PInteger :--> (PByteString :--> a)) :--> a)))
pelimBS = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s PByteString
bs Term s a
z Term s (PInteger :--> (PByteString :--> a))
f ->
    forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
      forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
n forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0) Term s a
z forall a b. (a -> b) -> a -> b
$
        forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (s :: S). Term s (PByteString :--> (PInteger :--> PInteger))
pindexBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
0) forall a b. (a -> b) -> a -> b
$ \Term s PInteger
x ->
          forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (forall (s :: S).
Term
  s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
psliceBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
1 forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# (Term s PInteger
n forall a. Num a => a -> a -> a
- Term s PInteger
1) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs) forall a b. (a -> b) -> a -> b
$ \Term s PByteString
xs ->
            Term s (PInteger :--> (PByteString :--> a))
f forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
xs

pcase :: PEq a => Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b
pcase :: forall (a :: PType) (s :: S) (b :: PType).
PEq a =>
Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b
pcase Term s b
y Term s a
x = \case
  [] -> Term s b
y
  ((Term s a
x', Term s b
r) : [(Term s a, Term s b)]
cs) -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
x forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s a
x') Term s b
r forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S) (b :: PType).
PEq a =>
Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s b
pcase Term s b
y Term s a
x [(Term s a, Term s b)]
cs

-- | Generic version of `pshow`
gpshow ::
  forall a s.
  (PGeneric a, PlutusType a, All2 PShow (PCode a)) =>
  Bool ->
  Term s (a :--> PString)
gpshow :: forall (a :: PType) (s :: S).
(PGeneric a, PlutusType a, All2 @PType PShow (PCode a)) =>
Bool -> Term s (a :--> PString)
gpshow Bool
wrap =
  let [String]
constructorNames :: [ConstructorName] =
        forall k l (h :: (k -> Type) -> l -> Type) (xs :: l) a.
(HCollapse @k @l h, SListIN @k @l h xs) =>
h (K @k a) xs -> CollapseTo @k @l h a
hcollapse forall a b. (a -> b) -> a -> b
$ forall {k} {l} (h :: (k -> Type) -> l -> Type) (xs :: l)
       (f :: k -> Type) (f' :: k -> Type).
(SListIN @k @l (Prod @k @l h) xs, HAp @k @l h) =>
(forall (a :: k). f a -> f' a) -> h f xs -> h f' xs
hmap (forall k a (b :: k). a -> K @k a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (xs :: [Type]). ConstructorInfo xs -> String
constructorName) forall a b. (a -> b) -> a -> b
$ forall (xss :: [[Type]]).
DatatypeInfo xss -> NP @[Type] ConstructorInfo xss
constructorInfo forall a b. (a -> b) -> a -> b
$ forall (proxy :: Type -> Type) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (forall {k} (t :: k). Proxy @k t
Proxy @(a s))
   in forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
        forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s a
x ->
          forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s a
x forall a b. (a -> b) -> a -> b
$ \a s
x' ->
            forall a. (Monoid a, IsString a) => Bool -> a -> NonEmpty a -> a
productGroup Bool
wrap Term s PString
" " forall a b. (a -> b) -> a -> b
$ forall (a :: [[PType]]) (s :: S).
All2 @PType PShow a =>
[String] -> SOP @PType (Term s) a -> NonEmpty (Term s PString)
gpshow' [String]
constructorNames (forall (a :: PType) (s :: S).
PGeneric a =>
a s -> SOP @PType (Term s) (PCode a)
gpfrom a s
x')

-- | Like `gpshow`, but returns the individual parameters list
gpshow' ::
  forall a s.
  All2 PShow a =>
  [ConstructorName] ->
  SOP (Term s) a ->
  NonEmpty (Term s PString)
gpshow' :: forall (a :: [[PType]]) (s :: S).
All2 @PType PShow a =>
[String] -> SOP @PType (Term s) a -> NonEmpty (Term s PString)
gpshow' [String]
constructorNames (SOP NS @[PType] (NP @PType (Term s)) a
x) =
  let cName :: String
cName = [String]
constructorNames forall a. [a] -> Int -> a
!! forall k l (h :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (xs :: l).
HIndex @k @l h =>
h f xs -> Int
hindex NS @[PType] (NP @PType (Term s)) a
x
   in forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant @PString (String -> Text
T.pack String
cName) forall a. a -> [a] -> NonEmpty a
:| NS @[PType] (NP @PType (Term s)) a -> [Term s PString]
showSum NS @[PType] (NP @PType (Term s)) a
x
  where
    showSum :: NS (NP (Term s)) a -> [Term s PString]
    showSum :: NS @[PType] (NP @PType (Term s)) a -> [Term s PString]
showSum =
      forall k l (h :: (k -> Type) -> l -> Type) (xs :: l) a.
(HCollapse @k @l h, SListIN @k @l h xs) =>
h (K @k a) xs -> CollapseTo @k @l h a
hcollapse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> Type) -> l -> Type)
       (c :: k -> Constraint) (xs :: l)
       (proxy :: (k -> Constraint) -> Type) (f :: k -> Type)
       (f' :: k -> Type).
(AllN @k @l (Prod @k @l h) c xs, HAp @k @l h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy @k t
Proxy @(All PShow)) forall (xs :: [PType]).
All @PType PShow xs =>
NP @PType (Term s) xs -> K @[PType] [Term s PString] xs
showProd
    showProd :: All PShow xs => NP (Term s) xs -> K [Term s PString] xs
    showProd :: forall (xs :: [PType]).
All @PType PShow xs =>
NP @PType (Term s) xs -> K @[PType] [Term s PString] xs
showProd =
      forall k a (b :: k). a -> K @k a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k l (h :: (k -> Type) -> l -> Type) (xs :: l) a.
(HCollapse @k @l h, SListIN @k @l h xs) =>
h (K @k a) xs -> CollapseTo @k @l h a
hcollapse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {l} (h :: (k -> Type) -> l -> Type)
       (c :: k -> Constraint) (xs :: l)
       (proxy :: (k -> Constraint) -> Type) (f :: k -> Type)
       (f' :: k -> Type).
(AllN @k @l (Prod @k @l h) c xs, HAp @k @l h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy @k t
Proxy @PShow) forall (b :: PType).
PShow b =>
Term s b -> K @PType (Term s PString) b
showTerm
    showTerm :: forall b. PShow b => Term s b -> K (Term s PString) b
    showTerm :: forall (b :: PType).
PShow b =>
Term s b -> K @PType (Term s PString) b
showTerm =
      forall k a (b :: k). a -> K @k a b
K forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: PType) (s :: S).
PShow t =>
Bool -> Term s t -> Term s PString
pshow' Bool
True

-- | Group parameters list, preparing for final PShow output
productGroup :: (Monoid a, IsString a) => Bool -> a -> NonEmpty a -> a
productGroup :: forall a. (Monoid a, IsString a) => Bool -> a -> NonEmpty a -> a
productGroup Bool
wrap a
sep = \case
  a
x :| [] -> a
x
  NonEmpty a
xs ->
    let xs' :: a
xs' = forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse a
sep NonEmpty a
xs
     in if Bool
wrap then forall a. IsString a => String -> a
fromString String
"(" forall a. Semigroup a => a -> a -> a
<> a
xs' forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString String
")" else a
xs'

{- | Causes an error where the input is shown in the message.
 Works for all types.
-}
pshowAndErr :: Term s a -> Term s b
pshowAndErr :: forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
pshowAndErr Term s a
x = forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce forall a b. (a -> b) -> a -> b
$ forall (s :: S). Term s (PByteString :--> (PInteger :--> PInteger))
pindexBS forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce (forall (s :: S) (a :: PType).
Term s (PBool :--> (a :--> (a :--> a)))
pif' forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s a
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
0