{-# LANGUAGE UndecidableInstances #-}

module Plutarch.Internal.Show (
  PShow (pshow'),
  pshow,
  pshowAndErr,
  pshowList,
) 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.Builtin.Bool (PBool, pif, pif')
import Plutarch.Builtin.ByteString (
  PByte,
  PByteString,
  pbyteToInteger,
  pconsBS,
  pindexBS,
  pintegerToByte,
  plengthBS,
  psliceBS,
 )
import Plutarch.Builtin.Data (
  PAsData,
  PBuiltinList,
  PBuiltinPair,
  PData,
  pasByteStr,
  pasConstr,
  pasInt,
  pasList,
  pasMap,
  pchooseData,
  pfstBuiltin,
  psndBuiltin,
 )
import Plutarch.Builtin.Integer (PInteger)
import Plutarch.Builtin.String (
  PString,
  pdecodeUtf8,
  pencodeUtf8,
 )
import Plutarch.Builtin.Unit (PUnit)
import Plutarch.Internal.Eq (PEq ((#==)))
import Plutarch.Internal.Fix (pfix)
import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom)
import Plutarch.Internal.IsData (PIsData, pfromData)
import Plutarch.Internal.Lift (PlutusRepr, pconstant)
import Plutarch.Internal.ListLike (
  PIsListLike,
  PListLike (pelimList),
  pfoldr',
  pmap,
  precList,
 )
import Plutarch.Internal.Numeric (PPositive, pquot, prem)
import Plutarch.Internal.Ord (POrd ((#<)))
import Plutarch.Internal.PLam (PLamN (plam))
import Plutarch.Internal.PlutusType (PlutusType, pmatch)
import Plutarch.Internal.Term (
  Term,
  pdelay,
  perror,
  pforce,
  phoistAcyclic,
  plet,
  punsafeCoerce,
  (#),
  (#$),
  type (:-->),
 )
import Plutarch.Maybe (PMaybe, PMaybeSoP)

import PlutusCore qualified as PLC

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 = Bool -> Term s (t :--> PString)
forall (a :: PType) (s :: S).
(PGeneric a, PlutusType a, All2 @PType PShow (PCode a)) =>
Bool -> Term s (a :--> PString)
gpshow Bool
wrap Term s (t :--> PString) -> Term s t -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s t
x

pshowList :: forall list a s. (PShow a, PIsListLike list a) => Term s (list a :--> PString)
pshowList :: forall (list :: PType -> PType) (a :: PType) (s :: S).
(PShow a, PIsListLike list a) =>
Term s (list a :--> PString)
pshowList =
  ClosedTerm (list a :--> PString) -> Term s (list a :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm (list a :--> PString) -> Term s (list a :--> PString))
-> ClosedTerm (list a :--> PString) -> Term s (list a :--> PString)
forall a b. (a -> b) -> a -> b
$
    (Term s (list a) -> Term s PString) -> Term s (list a :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s (list a) -> Term s PString)
 -> Term s (list a :--> PString))
-> (Term s (list a) -> Term s PString)
-> Term s (list a :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s (list a)
list ->
      Term s PString
"[" Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> forall (list :: PType -> PType) (a :: PType) (s :: S).
(PShow a, PIsListLike list a) =>
Term s (list a :--> PString)
pshowList' @list @a Term s (list a :--> PString) -> Term s (list a) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (list a)
list Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
"]"

pshowList' :: forall list a s. (PShow a, PIsListLike list a) => Term s (list a :--> PString)
pshowList' :: forall (list :: PType -> PType) (a :: PType) (s :: S).
(PShow a, PIsListLike list a) =>
Term s (list a :--> PString)
pshowList' =
  ClosedTerm (list a :--> PString) -> Term s (list a :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm (list a :--> PString) -> Term s (list a :--> PString))
-> ClosedTerm (list a :--> PString) -> Term s (list a :--> PString)
forall a b. (a -> b) -> a -> b
$
    (Term s (list a :--> PString)
 -> Term s a -> Term s (list a) -> Term s PString)
-> (Term s (list a :--> PString) -> Term s PString)
-> Term s (list a :--> PString)
forall (list :: PType -> PType) (a :: PType) (s :: S) (r :: PType).
PIsListLike list a =>
(Term s (list a :--> r) -> Term s a -> Term s (list a) -> Term s r)
-> (Term s (list a :--> r) -> Term s r) -> Term s (list a :--> r)
precList
      ( \Term s (list a :--> PString)
self Term s a
x Term s (list a)
xs ->
          (Term s a -> Term s (list a) -> Term s PString)
-> Term s PString -> Term s (list a) -> Term s PString
forall (a :: PType) (s :: S) (r :: PType).
PElemConstraint list a =>
(Term s a -> Term s (list a) -> Term s r)
-> Term s r -> Term s (list a) -> Term s r
forall (list :: PType -> PType) (a :: PType) (s :: S) (r :: PType).
(PListLike list, PElemConstraint list a) =>
(Term s a -> Term s (list a) -> Term s r)
-> Term s r -> Term s (list a) -> Term s r
pelimList
            (\Term s a
_ Term s (list a)
_ -> Term s a -> Term s PString
forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow Term s a
x Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
", " Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (list a :--> PString)
self Term s (list a :--> PString) -> Term s (list a) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (list a)
xs)
            (Term s a -> Term s PString
forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow Term s a
x)
            Term s (list a)
xs
      )
      (Term s PString -> Term s (list a :--> PString) -> Term s PString
forall a b. a -> b -> a
const Term s PString
"")

-- | 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 = Bool -> Term s a -> Term s PString
forall (s :: S). Bool -> Term s a -> Term s PString
forall (t :: PType) (s :: S).
PShow t =>
Bool -> Term s t -> Term s PString
pshow' Bool
False

-- | Case matching on bytestring, as if a list.
pelimBS ::
  Term
    s
    ( PByteString
        :--> a -- If bytestring is empty
        :--> (PByte :--> PByteString :--> a) -- If bytestring is non-empty
        :--> a
    )
pelimBS :: forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
pelimBS = ClosedTerm
  (PByteString
   :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
-> Term
     s
     (PByteString
      :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm
   (PByteString
    :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
 -> Term
      s
      (PByteString
       :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a))))
-> ClosedTerm
     (PByteString
      :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
-> Term
     s
     (PByteString
      :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
forall a b. (a -> b) -> a -> b
$
  (Term s PByteString
 -> Term s a
 -> Term s (PByte :--> (PByteString :--> a))
 -> Term s a)
-> Term
     s
     (PByteString
      :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c
 -> Term s a
 -> Term s (PByte :--> (PByteString :--> a))
 -> Term s a)
-> Term
     s (c :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
plam ((Term s PByteString
  -> Term s a
  -> Term s (PByte :--> (PByteString :--> a))
  -> Term s a)
 -> Term
      s
      (PByteString
       :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a))))
-> (Term s PByteString
    -> Term s a
    -> Term s (PByte :--> (PByteString :--> a))
    -> Term s a)
-> Term
     s
     (PByteString
      :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
forall a b. (a -> b) -> a -> b
$ \Term s PByteString
bs Term s a
z Term s (PByte :--> (PByteString :--> a))
f ->
    Term s PInteger -> (Term s PInteger -> Term s a) -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PByteString :--> PInteger)
forall (s :: S). Term s (PByteString :--> PInteger)
plengthBS Term s (PByteString :--> PInteger)
-> Term s PByteString -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs) ((Term s PInteger -> Term s a) -> Term s a)
-> (Term s PInteger -> Term s a) -> Term s a
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
      Term s PBool -> Term s a -> Term s a -> Term s a
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
n Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0) Term s a
z (Term s a -> Term s a) -> Term s a -> Term s a
forall a b. (a -> b) -> a -> b
$
        Term s PByte -> (Term s PByte -> Term s a) -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PByteString :--> (PInteger :--> PByte))
forall (s :: S). Term s (PByteString :--> (PInteger :--> PByte))
pindexBS Term s (PByteString :--> (PInteger :--> PByte))
-> Term s PByteString -> Term s (PInteger :--> PByte)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs Term s (PInteger :--> PByte) -> Term s PInteger -> Term s PByte
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
0) ((Term s PByte -> Term s a) -> Term s a)
-> (Term s PByte -> Term s a) -> Term s a
forall a b. (a -> b) -> a -> b
$ \Term s PByte
x ->
          Term s PByteString -> (Term s PByteString -> Term s a) -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term
  s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
forall (s :: S).
Term
  s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
psliceBS Term
  s (PInteger :--> (PInteger :--> (PByteString :--> PByteString)))
-> Term s PInteger
-> Term s (PInteger :--> (PByteString :--> PByteString))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
1 Term s (PInteger :--> (PByteString :--> PByteString))
-> Term s PInteger -> Term s (PByteString :--> PByteString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term s PInteger
n Term s PInteger -> Term s PInteger -> Term s PInteger
forall a. Num a => a -> a -> a
- Term s PInteger
1) Term s (PByteString :--> PByteString)
-> Term s PByteString -> Term s PByteString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByteString
bs) ((Term s PByteString -> Term s a) -> Term s a)
-> (Term s PByteString -> Term s a) -> Term s a
forall a b. (a -> b) -> a -> b
$ \Term s PByteString
xs ->
            Term s (PByte :--> (PByteString :--> a))
f Term s (PByte :--> (PByteString :--> a))
-> Term s PByte -> Term s (PByteString :--> a)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByte
x Term s (PByteString :--> a) -> Term s PByteString -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
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) -> Term s PBool -> Term s b -> Term s b -> Term s b
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s a
x Term s a -> Term s a -> Term s PBool
forall (s :: S). Term s a -> Term s a -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s a
x') Term s b
r (Term s b -> Term s b) -> Term s b -> Term s b
forall a b. (a -> b) -> a -> b
$ Term s b -> Term s a -> [(Term s a, Term s b)] -> Term s 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 [ConstructorName]
constructorNames :: [ConstructorName] =
        NP
  @[Type]
  (K @[Type] ConstructorName)
  (ToSumCode (Rep (a s)) ('[] @[Type]))
-> CollapseTo @[Type] @[[Type]] (NP @[Type]) ConstructorName
forall (xs :: [[Type]]) a.
SListIN @[Type] @[[Type]] (NP @[Type]) xs =>
NP @[Type] (K @[Type] a) xs
-> CollapseTo @[Type] @[[Type]] (NP @[Type]) a
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 (NP
   @[Type]
   (K @[Type] ConstructorName)
   (ToSumCode (Rep (a s)) ('[] @[Type]))
 -> CollapseTo @[Type] @[[Type]] (NP @[Type]) ConstructorName)
-> NP
     @[Type]
     (K @[Type] ConstructorName)
     (ToSumCode (Rep (a s)) ('[] @[Type]))
-> CollapseTo @[Type] @[[Type]] (NP @[Type]) ConstructorName
forall a b. (a -> b) -> a -> b
$ (forall (a :: [Type]).
 ConstructorInfo a -> K @[Type] ConstructorName a)
-> NP @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
-> NP
     @[Type]
     (K @[Type] ConstructorName)
     (ToSumCode (Rep (a s)) ('[] @[Type]))
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 (ConstructorName -> K @[Type] ConstructorName a
forall k a (b :: k). a -> K @k a b
K (ConstructorName -> K @[Type] ConstructorName a)
-> (ConstructorInfo a -> ConstructorName)
-> ConstructorInfo a
-> K @[Type] ConstructorName a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorInfo a -> ConstructorName
forall (xs :: [Type]). ConstructorInfo xs -> ConstructorName
constructorName) (NP @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
 -> NP
      @[Type]
      (K @[Type] ConstructorName)
      (ToSumCode (Rep (a s)) ('[] @[Type])))
-> NP @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
-> NP
     @[Type]
     (K @[Type] ConstructorName)
     (ToSumCode (Rep (a s)) ('[] @[Type]))
forall a b. (a -> b) -> a -> b
$ DatatypeInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
-> NP @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
forall (xss :: [[Type]]).
DatatypeInfo xss -> NP @[Type] ConstructorInfo xss
constructorInfo (DatatypeInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
 -> NP
      @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type])))
-> DatatypeInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
-> NP @[Type] ConstructorInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
forall a b. (a -> b) -> a -> b
$ Proxy @Type (a s)
-> DatatypeInfo (ToSumCode (Rep (a s)) ('[] @[Type]))
forall (proxy :: Type -> Type) a.
GDatatypeInfo a =>
proxy a -> DatatypeInfo (GCode a)
gdatatypeInfo (forall t. Proxy @Type t
forall {k} (t :: k). Proxy @k t
Proxy @(a s))
   in ClosedTerm (a :--> PString) -> Term s (a :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm (a :--> PString) -> Term s (a :--> PString))
-> ClosedTerm (a :--> PString) -> Term s (a :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s a -> Term s PString) -> Term s (a :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s a -> Term s PString) -> Term s (a :--> PString))
-> (Term s a -> Term s PString) -> Term s (a :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s a
x ->
          Term s a -> (a s -> Term s PString) -> Term s PString
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 ((a s -> Term s PString) -> Term s PString)
-> (a s -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \a s
x' ->
            Bool
-> Term s PString -> NonEmpty (Term s PString) -> Term s PString
forall a. (Monoid a, IsString a) => Bool -> a -> NonEmpty a -> a
productGroup Bool
wrap Term s PString
" " (NonEmpty (Term s PString) -> Term s PString)
-> NonEmpty (Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ [ConstructorName]
-> SOP @PType (Term s) (PCode a) -> NonEmpty (Term s PString)
forall (a :: [[PType]]) (s :: S).
All2 @PType PShow a =>
[ConstructorName]
-> SOP @PType (Term s) a -> NonEmpty (Term s PString)
gpshow' [ConstructorName]
constructorNames (a s -> SOP @PType (Term s) (PCode a)
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 =>
[ConstructorName]
-> SOP @PType (Term s) a -> NonEmpty (Term s PString)
gpshow' [ConstructorName]
constructorNames (SOP NS @[PType] (NP @PType (Term s)) a
x) =
  let cName :: ConstructorName
cName = [ConstructorName]
constructorNames [ConstructorName] -> Int -> ConstructorName
forall a. HasCallStack => [a] -> Int -> a
!! NS @[PType] (NP @PType (Term s)) a -> Int
forall k l (h :: (k -> Type) -> l -> Type) (f :: k -> Type)
       (xs :: l).
HIndex @k @l h =>
h f xs -> Int
forall (f :: [PType] -> Type) (xs :: [[PType]]).
NS @[PType] f xs -> Int
hindex NS @[PType] (NP @PType (Term s)) a
x
   in forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant @PString (ConstructorName -> Text
T.pack ConstructorName
cName) Term s PString -> [Term s PString] -> NonEmpty (Term s PString)
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 =
      NS @[PType] (K @[PType] [Term s PString]) a
-> CollapseTo @[PType] @[[PType]] (NS @[PType]) [Term s PString]
forall (xs :: [[PType]]) a.
SListIN @[PType] @[[PType]] (NS @[PType]) xs =>
NS @[PType] (K @[PType] a) xs
-> CollapseTo @[PType] @[[PType]] (NS @[PType]) a
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 (NS @[PType] (K @[PType] [Term s PString]) a
 -> CollapseTo @[PType] @[[PType]] (NS @[PType]) [Term s PString])
-> (NS @[PType] (NP @PType (Term s)) a
    -> NS @[PType] (K @[PType] [Term s PString]) a)
-> NS @[PType] (NP @PType (Term s)) a
-> CollapseTo @[PType] @[[PType]] (NS @[PType]) [Term s PString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy @([PType] -> Constraint) (All @PType PShow)
-> (forall (a :: [PType]).
    All @PType PShow a =>
    NP @PType (Term s) a -> K @[PType] [Term s PString] a)
-> NS @[PType] (NP @PType (Term s)) a
-> NS @[PType] (K @[PType] [Term s PString]) a
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
forall (t :: [PType] -> Constraint).
Proxy @([PType] -> Constraint) t
Proxy @(All PShow)) NP @PType (Term s) a -> K @[PType] [Term s PString] a
forall (a :: [PType]).
All @PType PShow a =>
NP @PType (Term s) a -> K @[PType] [Term s PString] a
showProd
    showProd :: All PShow xs => NP (Term s) xs -> K [Term s PString] xs
    showProd :: forall (a :: [PType]).
All @PType PShow a =>
NP @PType (Term s) a -> K @[PType] [Term s PString] a
showProd =
      CollapseTo @PType @[PType] (NP @PType) (Term s PString)
-> K @[PType]
     (CollapseTo @PType @[PType] (NP @PType) (Term s PString))
     xs
forall k a (b :: k). a -> K @k a b
K (CollapseTo @PType @[PType] (NP @PType) (Term s PString)
 -> K @[PType]
      (CollapseTo @PType @[PType] (NP @PType) (Term s PString))
      xs)
-> (NP @PType (Term s) xs
    -> CollapseTo @PType @[PType] (NP @PType) (Term s PString))
-> NP @PType (Term s) xs
-> K @[PType]
     (CollapseTo @PType @[PType] (NP @PType) (Term s PString))
     xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NP @PType (K @PType (Term s PString)) xs
-> CollapseTo @PType @[PType] (NP @PType) (Term s PString)
forall (xs :: [PType]) a.
SListIN @PType @[PType] (NP @PType) xs =>
NP @PType (K @PType a) xs
-> CollapseTo @PType @[PType] (NP @PType) a
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 (NP @PType (K @PType (Term s PString)) xs
 -> CollapseTo @PType @[PType] (NP @PType) (Term s PString))
-> (NP @PType (Term s) xs
    -> NP @PType (K @PType (Term s PString)) xs)
-> NP @PType (Term s) xs
-> CollapseTo @PType @[PType] (NP @PType) (Term s PString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy @(PType -> Constraint) PShow
-> (forall (a :: PType).
    PShow a =>
    Term s a -> K @PType (Term s PString) a)
-> NP @PType (Term s) xs
-> NP @PType (K @PType (Term s PString)) xs
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
forall (t :: PType -> Constraint). Proxy @(PType -> Constraint) t
Proxy @PShow) Term s a -> K @PType (Term s PString) a
forall (a :: PType).
PShow a =>
Term s a -> K @PType (Term s PString) a
showTerm
    showTerm :: forall b. PShow b => Term s b -> K (Term s PString) b
    showTerm :: forall (a :: PType).
PShow a =>
Term s a -> K @PType (Term s PString) a
showTerm =
      Term s PString -> K @PType (Term s PString) b
forall k a (b :: k). a -> K @k a b
K (Term s PString -> K @PType (Term s PString) b)
-> (Term s b -> Term s PString)
-> Term s b
-> K @PType (Term s PString) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Term s b -> Term s PString
forall (s :: S). Bool -> Term s b -> Term s PString
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' = NonEmpty a -> a
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty a -> a) -> NonEmpty a -> a
forall a b. (a -> b) -> a -> b
$ a -> NonEmpty a -> NonEmpty a
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse a
sep NonEmpty a
xs
     in if Bool
wrap then ConstructorName -> a
forall a. IsString a => ConstructorName -> a
fromString ConstructorName
"(" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
xs' a -> a -> a
forall a. Semigroup a => a -> a -> a
<> ConstructorName -> a
forall a. IsString a => ConstructorName -> a
fromString ConstructorName
")" 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 = Term s PByte -> Term s b
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce (Term s PByte -> Term s b) -> Term s PByte -> Term s b
forall a b. (a -> b) -> a -> b
$ Term s (PByteString :--> (PInteger :--> PByte))
forall (s :: S). Term s (PByteString :--> (PInteger :--> PByte))
pindexBS Term s (PByteString :--> (PInteger :--> PByte))
-> Term s PByteString -> Term s (PInteger :--> PByte)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a -> Term s PByteString
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce (Term s (PBool :--> (a :--> (a :--> a)))
forall (a :: PType) (s :: S).
Term s (PBool :--> (a :--> (a :--> a)))
pif' Term s (PBool :--> (a :--> (a :--> a)))
-> Term s PBool -> Term s (a :--> (a :--> a))
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a -> Term s PBool
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce Term s a
x Term s (a :--> (a :--> a)) -> Term s a -> Term s (a :--> a)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x Term s (a :--> a) -> Term s a -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x) Term s (PInteger :--> PByte) -> Term s PInteger -> Term s PByte
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
0

--------------------------------------------------------------------------------

instance PShow PUnit where
  pshow' :: forall (s :: S). Bool -> Term s PUnit -> Term s PString
pshow' Bool
_ Term s PUnit
_ = Term s PString
"()"

instance PShow PString where
  pshow' :: forall (s :: S). Bool -> Term s PString -> Term s PString
pshow' Bool
_ Term s PString
x = Term s (PString :--> PString)
forall (s :: S). Term s (PString :--> PString)
pshowStr Term s (PString :--> PString) -> Term s PString -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PString :--> PString))
-> Term s (PString :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PString :--> PString))
 -> Term s (PString :--> PString))
-> (forall (s :: S). Term s (PString :--> PString))
-> Term s (PString :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PString -> Term s PString) -> Term s (PString :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PString -> Term s PString)
 -> Term s (PString :--> PString))
-> (Term s PString -> Term s PString)
-> Term s (PString :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PString
s ->
          Term s PString
"\"" Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> (Term s (PByteString :--> PString)
forall (s :: S). Term s (PByteString :--> PString)
pdecodeUtf8 Term s (PByteString :--> PString)
-> Term s PByteString -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ Term s (PByteString :--> PByteString)
forall (s :: S). Term s (PByteString :--> PByteString)
pshowUtf8Bytes Term s (PByteString :--> PByteString)
-> Term s PByteString -> Term s PByteString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ Term s (PString :--> PByteString)
forall (s :: S). Term s (PString :--> PByteString)
pencodeUtf8 Term s (PString :--> PByteString)
-> Term s PString -> Term s PByteString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
s) Term s PString -> Term s PString -> Term s PString
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 (s :: S). Term s (PByteString :--> PByteString))
-> Term s (PByteString :--> PByteString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PByteString :--> PByteString))
 -> Term s (PByteString :--> PByteString))
-> (forall (s :: S). Term s (PByteString :--> PByteString))
-> Term s (PByteString :--> PByteString)
forall a b. (a -> b) -> a -> b
$
        Term
  s
  (((PByteString :--> PByteString)
    :--> (PByteString :--> PByteString))
   :--> (PByteString :--> PByteString))
forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix Term
  s
  (((PByteString :--> PByteString)
    :--> (PByteString :--> PByteString))
   :--> (PByteString :--> PByteString))
-> Term
     s
     ((PByteString :--> PByteString)
      :--> (PByteString :--> PByteString))
-> Term s (PByteString :--> PByteString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ (Term s (PByteString :--> PByteString)
 -> Term s PByteString -> Term s PByteString)
-> Term
     s
     ((PByteString :--> PByteString)
      :--> (PByteString :--> PByteString))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PByteString -> Term s PByteString)
-> Term s (c :--> (PByteString :--> PByteString))
plam ((Term s (PByteString :--> PByteString)
  -> Term s PByteString -> Term s PByteString)
 -> Term
      s
      ((PByteString :--> PByteString)
       :--> (PByteString :--> PByteString)))
-> (Term s (PByteString :--> PByteString)
    -> Term s PByteString -> Term s PByteString)
-> Term
     s
     ((PByteString :--> PByteString)
      :--> (PByteString :--> PByteString))
forall a b. (a -> b) -> a -> b
$ \Term s (PByteString :--> PByteString)
self Term s PByteString
bs ->
          Term
  s
  (PByteString
   :--> (PByteString
         :--> ((PByte :--> (PByteString :--> PByteString))
               :--> PByteString)))
forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PByte :--> (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 #== (pintegerToByte # doubleQuote))
                    (pconsBS # (pintegerToByte # escapeSlash) # rec_)
                    rec_

instance PShow PBool where
  pshow' :: forall (s :: S). Bool -> Term s PBool -> Term s PString
pshow' Bool
_ Term s PBool
x = Term s (PBool :--> PString)
forall (s :: S). Term s (PBool :--> PString)
pshowBool Term s (PBool :--> PString) -> Term s PBool -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PBool :--> PString))
-> Term s (PBool :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PBool :--> PString))
 -> Term s (PBool :--> PString))
-> (forall (s :: S). Term s (PBool :--> PString))
-> Term s (PBool :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PBool -> Term s PString) -> Term s (PBool :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PBool -> Term s PString) -> Term s (PBool :--> PString))
-> (Term s PBool -> Term s PString) -> Term s (PBool :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PBool
x ->
          -- Delegate to Haskell's Show instance
          Term s PBool -> (PBool s -> Term s PString) -> Term s PString
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 ((PBool s -> Term s PString) -> Term s PString)
-> (PBool s -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant @PString (AsHaskell PString -> Term s PString)
-> (PBool s -> AsHaskell PString) -> PBool s -> Term s PString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConstructorName -> Text
T.pack (ConstructorName -> Text)
-> (PBool s -> ConstructorName) -> PBool s -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PBool s -> ConstructorName
forall a. Show a => a -> ConstructorName
show

instance PShow PInteger where
  pshow' :: forall (s :: S). Bool -> Term s PInteger -> Term s PString
pshow' Bool
_ Term s PInteger
x = Term s (PInteger :--> PString)
forall (s :: S). Term s (PInteger :--> PString)
pshowInt Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PInteger :--> PString))
 -> Term s (PInteger :--> PString))
-> (forall (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall a b. (a -> b) -> a -> b
$
        Term
  s
  (((PInteger :--> PString) :--> (PInteger :--> PString))
   :--> (PInteger :--> PString))
forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix Term
  s
  (((PInteger :--> PString) :--> (PInteger :--> PString))
   :--> (PInteger :--> PString))
-> Term s ((PInteger :--> PString) :--> (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ (Term s (PInteger :--> PString)
 -> Term s PInteger -> Term s PString)
-> Term s ((PInteger :--> PString) :--> (PInteger :--> PString))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PInteger -> Term s PString)
-> Term s (c :--> (PInteger :--> PString))
plam ((Term s (PInteger :--> PString)
  -> Term s PInteger -> Term s PString)
 -> Term s ((PInteger :--> PString) :--> (PInteger :--> PString)))
-> (Term s (PInteger :--> PString)
    -> Term s PInteger -> Term s PString)
-> Term s ((PInteger :--> PString) :--> (PInteger :--> PString))
forall a b. (a -> b) -> a -> b
$ \Term s (PInteger :--> PString)
self Term s PInteger
n ->
          let sign :: Term s PString
sign = Term s PBool -> Term s PString -> Term s PString -> Term s PString
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s PInteger
n Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
POrd 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
                Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PInteger
-> (Term s PInteger -> Term s PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet
                  (Term s (PInteger :--> (PInteger :--> PInteger))
forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pquot Term s (PInteger :--> (PInteger :--> PInteger))
-> Term s PInteger -> Term s (PInteger :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s PInteger
forall a. Num a => a -> a
abs Term s PInteger
n Term s (PInteger :--> PInteger)
-> Term s PInteger -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
10)
                  ( \Term s PInteger
q ->
                      Term s PInteger
-> (Term s PInteger -> Term s PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PInteger :--> (PInteger :--> PInteger))
forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
prem Term s (PInteger :--> (PInteger :--> PInteger))
-> Term s PInteger -> Term s (PInteger :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger -> Term s PInteger
forall a. Num a => a -> a
abs Term s PInteger
n Term s (PInteger :--> PInteger)
-> Term s PInteger -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
10) ((Term s PInteger -> Term s PString) -> Term s PString)
-> (Term s PInteger -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
r ->
                        Term s PBool -> Term s PString -> Term s PString -> Term s PString
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
                          (Term s PInteger
q Term s PInteger -> Term s PInteger -> Term s PBool
forall (s :: S). Term s PInteger -> Term s PInteger -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0)
                          (Term s (PInteger :--> PString)
forall (s :: S). Term s (PInteger :--> PString)
pshowDigit Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
r)
                          ( Term s PString
-> (Term s PString -> Term s PString) -> Term s PString
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 Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
q) ((Term s PString -> Term s PString) -> Term s PString)
-> (Term s PString -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s PString
prefix ->
                              Term s PString
prefix Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PInteger :--> PString)
forall (s :: S). Term s (PInteger :--> PString)
pshowDigit Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PInteger :--> PString))
 -> Term s (PInteger :--> PString))
-> (forall (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PInteger -> Term s PString)
-> Term s (PInteger :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PInteger -> Term s PString)
 -> Term s (PInteger :--> PString))
-> (Term s PInteger -> Term s PString)
-> Term s (PInteger :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
digit ->
          Term s PString
-> Term s PInteger
-> [(Term s PInteger, Term s PString)]
-> Term s PString
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 PString
forall (s :: S) (a :: PType). Term s a
perror Term s PInteger
digit ([(Term s PInteger, Term s PString)] -> Term s PString)
-> [(Term s PInteger, Term s PString)] -> Term s PString
forall a b. (a -> b) -> a -> b
$
            ((Integer -> (Term s PInteger, Term s PString))
 -> [Integer] -> [(Term s PInteger, Term s PString)])
-> [Integer]
-> (Integer -> (Term s PInteger, Term s PString))
-> [(Term s PInteger, Term s PString)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Integer -> (Term s PInteger, Term s PString))
-> [Integer] -> [(Term s PInteger, Term s PString)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Integer
Item [Integer]
0 .. Integer
Item [Integer]
9] ((Integer -> (Term s PInteger, Term s PString))
 -> [(Term s PInteger, Term s PString)])
-> (Integer -> (Term s PInteger, Term s PString))
-> [(Term s PInteger, Term s PString)]
forall a b. (a -> b) -> a -> b
$ \(Integer
x :: Integer) ->
              (AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant Integer
AsHaskell PInteger
x, AsHaskell PString -> Term s PString
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (ConstructorName -> Text
T.pack (ConstructorName -> Text)
-> (Integer -> ConstructorName) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ConstructorName
forall a. Show a => a -> ConstructorName
show (Integer -> Text) -> Integer -> Text
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 = Term s (PByteString :--> PString)
forall (s :: S). Term s (PByteString :--> PString)
showByteString Term s (PByteString :--> PString)
-> Term s PByteString -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PByteString :--> PString))
-> Term s (PByteString :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PByteString :--> PString))
 -> Term s (PByteString :--> PString))
-> (forall (s :: S). Term s (PByteString :--> PString))
-> Term s (PByteString :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PByteString -> Term s PString)
-> Term s (PByteString :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PByteString -> Term s PString)
 -> Term s (PByteString :--> PString))
-> (Term s PByteString -> Term s PString)
-> Term s (PByteString :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PByteString
bs ->
          Term s PString
"0x" Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PByteString :--> PString)
forall (s :: S). Term s (PByteString :--> PString)
showByteString' Term s (PByteString :--> PString)
-> Term s PByteString -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PByteString :--> PString))
-> Term s (PByteString :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PByteString :--> PString))
 -> Term s (PByteString :--> PString))
-> (forall (s :: S). Term s (PByteString :--> PString))
-> Term s (PByteString :--> PString)
forall a b. (a -> b) -> a -> b
$
        Term
  s
  (((PByteString :--> PString) :--> (PByteString :--> PString))
   :--> (PByteString :--> PString))
forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix Term
  s
  (((PByteString :--> PString) :--> (PByteString :--> PString))
   :--> (PByteString :--> PString))
-> Term
     s ((PByteString :--> PString) :--> (PByteString :--> PString))
-> Term s (PByteString :--> PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ (Term s (PByteString :--> PString)
 -> Term s PByteString -> Term s PString)
-> Term
     s ((PByteString :--> PString) :--> (PByteString :--> PString))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PByteString -> Term s PString)
-> Term s (c :--> (PByteString :--> PString))
plam ((Term s (PByteString :--> PString)
  -> Term s PByteString -> Term s PString)
 -> Term
      s ((PByteString :--> PString) :--> (PByteString :--> PString)))
-> (Term s (PByteString :--> PString)
    -> Term s PByteString -> Term s PString)
-> Term
     s ((PByteString :--> PString) :--> (PByteString :--> PString))
forall a b. (a -> b) -> a -> b
$ \Term s (PByteString :--> PString)
self Term s PByteString
bs ->
          Term
  s
  (PByteString
   :--> (PString
         :--> ((PByte :--> (PByteString :--> PString)) :--> PString)))
forall (s :: S) (a :: PType).
Term
  s
  (PByteString
   :--> (a :--> ((PByte :--> (PByteString :--> a)) :--> a)))
pelimBS
            # bs
            # pconstant @PString ""
            #$ plam
            $ \x xs -> showByte # x <> self # xs
      showByte :: Term s (PByte :--> PString)
      showByte :: forall (s :: S). Term s (PByte :--> PString)
showByte = (forall (s :: S). Term s (PByte :--> PString))
-> Term s (PByte :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PByte :--> PString))
 -> Term s (PByte :--> PString))
-> (forall (s :: S). Term s (PByte :--> PString))
-> Term s (PByte :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PByte -> Term s PString) -> Term s (PByte :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PByte -> Term s PString) -> Term s (PByte :--> PString))
-> (Term s PByte -> Term s PString) -> Term s (PByte :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PByte
n' ->
          Term s PInteger
-> (Term s PInteger -> Term s PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PByte :--> PInteger)
forall (s :: S). Term s (PByte :--> PInteger)
pbyteToInteger Term s (PByte :--> PInteger) -> Term s PByte -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PByte
n') ((Term s PInteger -> Term s PString) -> Term s PString)
-> (Term s PInteger -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
            Term s PInteger
-> (Term s PInteger -> Term s PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PInteger :--> (PInteger :--> PInteger))
forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
pquot Term s (PInteger :--> (PInteger :--> PInteger))
-> Term s PInteger -> Term s (PInteger :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
n Term s (PInteger :--> PInteger)
-> Term s PInteger -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
16) ((Term s PInteger -> Term s PString) -> Term s PString)
-> (Term s PInteger -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
a ->
              Term s PInteger
-> (Term s PInteger -> Term s PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet (Term s (PInteger :--> (PInteger :--> PInteger))
forall (s :: S). Term s (PInteger :--> (PInteger :--> PInteger))
prem Term s (PInteger :--> (PInteger :--> PInteger))
-> Term s PInteger -> Term s (PInteger :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
n Term s (PInteger :--> PInteger)
-> Term s PInteger -> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
16) ((Term s PInteger -> Term s PString) -> Term s PString)
-> (Term s PInteger -> Term s PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
b ->
                Term s (PInteger :--> PString)
forall (s :: S). Term s (PInteger :--> PString)
showNibble Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PInteger
a Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PInteger :--> PString)
forall (s :: S). Term s (PInteger :--> PString)
showNibble Term s (PInteger :--> PString) -> Term s PInteger -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
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 (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PInteger :--> PString))
 -> Term s (PInteger :--> PString))
-> (forall (s :: S). Term s (PInteger :--> PString))
-> Term s (PInteger :--> PString)
forall a b. (a -> b) -> a -> b
$
        (Term s PInteger -> Term s PString)
-> Term s (PInteger :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s PInteger -> Term s PString)
 -> Term s (PInteger :--> PString))
-> (Term s PInteger -> Term s PString)
-> Term s (PInteger :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s PInteger
n ->
          Term s PString
-> Term s PInteger
-> [(Term s PInteger, Term s PString)]
-> Term s PString
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 PString
forall (s :: S) (a :: PType). Term s a
perror Term s PInteger
n ([(Term s PInteger, Term s PString)] -> Term s PString)
-> [(Term s PInteger, Term s PString)] -> Term s PString
forall a b. (a -> b) -> a -> b
$
            ((Int -> (Term s PInteger, Term s PString))
 -> [Int] -> [(Term s PInteger, Term s PString)])
-> [Int]
-> (Int -> (Term s PInteger, Term s PString))
-> [(Term s PInteger, Term s PString)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> (Term s PInteger, Term s PString))
-> [Int] -> [(Term s PInteger, Term s PString)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap [Int
Item [Int]
0 .. Int
Item [Int]
15] ((Int -> (Term s PInteger, Term s PString))
 -> [(Term s PInteger, Term s PString)])
-> (Int -> (Term s PInteger, Term s PString))
-> [(Term s PInteger, Term s PString)]
forall a b. (a -> b) -> a -> b
$ \(Int
x :: Int) ->
              ( AsHaskell PInteger -> Term s PInteger
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant (AsHaskell PInteger -> Term s PInteger)
-> AsHaskell PInteger -> Term s PInteger
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
x
              , forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant @PString (AsHaskell PString -> Term s PString)
-> AsHaskell PString -> Term s PString
forall a b. (a -> b) -> a -> b
$ ConstructorName -> Text
T.pack [Int -> Char
intToDigit Int
x]
              )

instance PShow PData where
  pshow' :: forall (s :: S). Bool -> Term s PData -> Term s PString
pshow' Bool
b Term s PData
t0 = Term s PString -> Term s PString
wrap (Term s (PData :--> PString)
forall (s :: S). Term s (PData :--> PString)
go0 Term s (PData :--> PString) -> Term s PData -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s PData
t0)
    where
      wrap :: Term s PString -> Term s PString
wrap Term s PString
s = Term s PBool -> Term s PString -> Term s PString -> Term s PString
forall (a :: PType) (s :: S).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (AsHaskell PBool -> Term s PBool
forall (a :: PType) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant Bool
AsHaskell PBool
b) (Term s PString
"(" Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
s Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
")") Term s PString
s
      go0 :: Term s (PData :--> PString)
      go0 :: forall (s :: S). Term s (PData :--> PString)
go0 = (forall (s :: S). Term s (PData :--> PString))
-> Term s (PData :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic ((forall (s :: S). Term s (PData :--> PString))
 -> Term s (PData :--> PString))
-> (forall (s :: S). Term s (PData :--> PString))
-> Term s (PData :--> PString)
forall a b. (a -> b) -> a -> b
$
        Term
  s
  (((PData :--> PString) :--> (PData :--> PString))
   :--> (PData :--> PString))
forall (s :: S) (a :: PType) (b :: PType).
Term s (((a :--> b) :--> (a :--> b)) :--> (a :--> b))
pfix Term
  s
  (((PData :--> PString) :--> (PData :--> PString))
   :--> (PData :--> PString))
-> Term s ((PData :--> PString) :--> (PData :--> PString))
-> Term s (PData :--> PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
#$ (Term s (PData :--> PString) -> Term s PData -> Term s PString)
-> Term s ((PData :--> PString) :--> (PData :--> PString))
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PData -> Term s PString)
-> Term s (c :--> (PData :--> PString))
plam ((Term s (PData :--> PString) -> Term s PData -> Term s PString)
 -> Term s ((PData :--> PString) :--> (PData :--> PString)))
-> (Term s (PData :--> PString) -> Term s PData -> Term s PString)
-> Term s ((PData :--> PString) :--> (PData :--> PString))
forall a b. (a -> b) -> a -> b
$ \Term s (PData :--> PString)
go Term s PData
t ->
          let pshowConstr :: Term s (PBuiltinPair PInteger (PBuiltinList PData))
-> Term s PString
pshowConstr Term s (PBuiltinPair PInteger (PBuiltinList PData))
pp0 = Term s (PBuiltinPair PInteger (PBuiltinList PData))
-> (Term s (PBuiltinPair PInteger (PBuiltinList PData))
    -> Term s PString)
-> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PBuiltinPair PInteger (PBuiltinList PData))
pp0 ((Term s (PBuiltinPair PInteger (PBuiltinList PData))
  -> Term s PString)
 -> Term s PString)
-> (Term s (PBuiltinPair PInteger (PBuiltinList PData))
    -> Term s PString)
-> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinPair PInteger (PBuiltinList PData))
pp ->
                Term s PString
"Constr "
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Bool -> Term s PInteger -> Term s PString
forall (s :: S). Bool -> Term s PInteger -> Term s PString
forall (t :: PType) (s :: S).
PShow t =>
Bool -> Term s t -> Term s PString
pshow' Bool
False (Term s (PBuiltinPair PInteger (PBuiltinList PData) :--> PInteger)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term s (PBuiltinPair PInteger (PBuiltinList PData) :--> PInteger)
-> Term s (PBuiltinPair PInteger (PBuiltinList PData))
-> Term s PInteger
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
pp)
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
" "
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PBuiltinList PString :--> PString)
forall {list :: PType -> PType} {s :: S}.
(PElemConstraint list PString, PListLike list) =>
Term s (list PString :--> PString)
pshowListPString Term s (PBuiltinList PString :--> PString)
-> Term s (PBuiltinList PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term
  s
  ((PData :--> PString)
   :--> (PBuiltinList PData :--> PBuiltinList PString))
forall (list :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
(PListLike list, PElemConstraint list a, PElemConstraint list b) =>
Term s ((a :--> b) :--> (list a :--> list b))
pmap Term
  s
  ((PData :--> PString)
   :--> (PBuiltinList PData :--> PBuiltinList PString))
-> Term s (PData :--> PString)
-> Term s (PBuiltinList PData :--> PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PData :--> PString)
go Term s (PBuiltinList PData :--> PBuiltinList PString)
-> Term s (PBuiltinList PData) -> Term s (PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term
  s
  (PBuiltinPair PInteger (PBuiltinList PData)
   :--> PBuiltinList PData)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin Term
  s
  (PBuiltinPair PInteger (PBuiltinList PData)
   :--> PBuiltinList PData)
-> Term s (PBuiltinPair PInteger (PBuiltinList PData))
-> Term s (PBuiltinList PData)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
pp))
              pshowMap :: Term s (PBuiltinList (PBuiltinPair PData PData)) -> Term s PString
pshowMap Term s (PBuiltinList (PBuiltinPair PData PData))
pplist =
                Term s PString
"Map " Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PBuiltinList PString :--> PString)
forall {list :: PType -> PType} {s :: S}.
(PElemConstraint list PString, PListLike list) =>
Term s (list PString :--> PString)
pshowListPString Term s (PBuiltinList PString :--> PString)
-> Term s (PBuiltinList PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term
  s
  ((PBuiltinPair PData PData :--> PString)
   :--> (PBuiltinList (PBuiltinPair PData PData)
         :--> PBuiltinList PString))
forall (list :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
(PListLike list, PElemConstraint list a, PElemConstraint list b) =>
Term s ((a :--> b) :--> (list a :--> list b))
pmap Term
  s
  ((PBuiltinPair PData PData :--> PString)
   :--> (PBuiltinList (PBuiltinPair PData PData)
         :--> PBuiltinList PString))
-> Term s (PBuiltinPair PData PData :--> PString)
-> Term
     s
     (PBuiltinList (PBuiltinPair PData PData) :--> PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PData PData :--> PString)
pshowPair Term
  s
  (PBuiltinList (PBuiltinPair PData PData) :--> PBuiltinList PString)
-> Term s (PBuiltinList (PBuiltinPair PData PData))
-> Term s (PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList (PBuiltinPair PData PData))
pplist)
              pshowPair :: Term s (PBuiltinPair PData PData :--> PString)
pshowPair = (Term s (PBuiltinPair PData PData) -> Term s PString)
-> Term s (PBuiltinPair PData PData :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s (PBuiltinPair PData PData) -> Term s PString)
 -> Term s (PBuiltinPair PData PData :--> PString))
-> (Term s (PBuiltinPair PData PData) -> Term s PString)
-> Term s (PBuiltinPair PData PData :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinPair PData PData)
pp0 -> Term s (PBuiltinPair PData PData)
-> (Term s (PBuiltinPair PData PData) -> Term s PString)
-> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s (PBuiltinPair PData PData)
pp0 ((Term s (PBuiltinPair PData PData) -> Term s PString)
 -> Term s PString)
-> (Term s (PBuiltinPair PData PData) -> Term s PString)
-> Term s PString
forall a b. (a -> b) -> a -> b
$ \Term s (PBuiltinPair PData PData)
pp ->
                Term s PString
"("
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> (Term s (PData :--> PString)
go Term s (PData :--> PString) -> Term s PData -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term s (PBuiltinPair PData PData :--> PData)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term s (PBuiltinPair PData PData :--> PData)
-> Term s (PBuiltinPair PData PData) -> Term s PData
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PData PData)
pp))
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
", "
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> (Term s (PData :--> PString)
go Term s (PData :--> PString) -> Term s PData -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term s (PBuiltinPair PData PData :--> PData)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin Term s (PBuiltinPair PData PData :--> PData)
-> Term s (PBuiltinPair PData PData) -> Term s PData
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PData PData)
pp))
                  Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
")"
              pshowList :: Term s (PBuiltinList PData) -> Term s PString
pshowList Term s (PBuiltinList PData)
xs = Term s PString
"List " Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s (PBuiltinList PString :--> PString)
forall {list :: PType -> PType} {s :: S}.
(PElemConstraint list PString, PListLike list) =>
Term s (list PString :--> PString)
pshowListPString Term s (PBuiltinList PString :--> PString)
-> Term s (PBuiltinList PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term
  s
  ((PData :--> PString)
   :--> (PBuiltinList PData :--> PBuiltinList PString))
forall (list :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
(PListLike list, PElemConstraint list a, PElemConstraint list b) =>
Term s ((a :--> b) :--> (list a :--> list b))
pmap Term
  s
  ((PData :--> PString)
   :--> (PBuiltinList PData :--> PBuiltinList PString))
-> Term s (PData :--> PString)
-> Term s (PBuiltinList PData :--> PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PData :--> PString)
go Term s (PBuiltinList PData :--> PBuiltinList PString)
-> Term s (PBuiltinList PData) -> Term s (PBuiltinList PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList PData)
xs)
              pshowListPString :: Term s (list PString :--> PString)
pshowListPString = ClosedTerm (list PString :--> PString)
-> Term s (list PString :--> PString)
forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic (ClosedTerm (list PString :--> PString)
 -> Term s (list PString :--> PString))
-> ClosedTerm (list PString :--> PString)
-> Term s (list PString :--> PString)
forall a b. (a -> b) -> a -> b
$
                (Term s (list PString) -> Term s PString)
-> Term s (list PString :--> PString)
forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
forall (c :: PType).
HasCallStack =>
(Term s c -> Term s PString) -> Term s (c :--> PString)
plam ((Term s (list PString) -> Term s PString)
 -> Term s (list PString :--> PString))
-> (Term s (list PString) -> Term s PString)
-> Term s (list PString :--> PString)
forall a b. (a -> b) -> a -> b
$ \Term s (list PString)
plist ->
                  Term s PString
"["
                    Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> (Term s PString -> Term s (list PString) -> Term s PString)
-> Term s PString -> Term s (list PString) -> Term s PString
forall (a :: PType) (s :: S) (r :: PType).
PElemConstraint list a =>
(Term s a -> Term s (list a) -> Term s r)
-> Term s r -> Term s (list a) -> Term s r
forall (list :: PType -> PType) (a :: PType) (s :: S) (r :: PType).
(PListLike list, PElemConstraint list a) =>
(Term s a -> Term s (list a) -> Term s r)
-> Term s r -> Term s (list a) -> Term s r
pelimList
                      ( \Term s PString
x0 Term s (list PString)
xs0 ->
                          Term s PString
x0 Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> ((forall (s1 :: S).
 Term s1 PString -> Term s1 PString -> Term s1 PString)
-> Term s (PString :--> (list PString :--> PString))
forall (list :: PType -> PType) (a :: PType) (b :: PType) (s :: S).
PIsListLike list a =>
(forall (s1 :: S). Term s1 a -> Term s1 b -> Term s1 b)
-> Term s (b :--> (list a :--> b))
pfoldr' (\Term s1 PString
x Term s1 PString
r -> Term s1 PString
", " Term s1 PString -> Term s1 PString -> Term s1 PString
forall a. Semigroup a => a -> a -> a
<> Term s1 PString
x Term s1 PString -> Term s1 PString -> Term s1 PString
forall a. Semigroup a => a -> a -> a
<> Term s1 PString
r) Term s (PString :--> (list PString :--> PString))
-> Term s PString -> Term s (list PString :--> PString)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# (Term s PString
forall {s :: S}. Term s PString
"" :: Term s PString) Term s (list PString :--> PString)
-> Term s (list PString) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (list PString)
xs0)
                      )
                      Term s PString
""
                      Term s (list PString)
plist
                    Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
"]"
           in Term s (PDelayed PString) -> Term s PString
forall (s :: S) (a :: PType). Term s (PDelayed a) -> Term s a
pforce (Term s (PDelayed PString) -> Term s PString)
-> Term s (PDelayed PString) -> Term s PString
forall a b. (a -> b) -> a -> b
$
                Term
  s
  (PData
   :--> (PDelayed PString
         :--> (PDelayed PString
               :--> (PDelayed PString
                     :--> (PDelayed PString
                           :--> (PDelayed PString :--> PDelayed PString))))))
forall (s :: S) (a :: PType).
Term s (PData :--> (a :--> (a :--> (a :--> (a :--> (a :--> a))))))
pchooseData
                  # t
                  # pdelay (pshowConstr (pasConstr # t))
                  # pdelay (pshowMap (pasMap # t))
                  # pdelay (pshowList (pasList # t))
                  # pdelay ("I " <> pshow (pasInt # t))
                  # pdelay ("B " <> pshow (pasByteStr # t))

instance (PIsData a, PShow a) => PShow (PAsData a) where
  pshow' :: forall (s :: S). Bool -> Term s (PAsData a) -> Term s PString
pshow' Bool
w Term s (PAsData a)
x = Bool -> Term s a -> Term s PString
forall (s :: S). Bool -> Term s a -> Term s PString
forall (t :: PType) (s :: S).
PShow t =>
Bool -> Term s t -> Term s PString
pshow' Bool
w (Term s (PAsData a) -> Term s a
forall (a :: PType) (s :: S).
PIsData a =>
Term s (PAsData a) -> Term s a
pfromData Term s (PAsData a)
x)

instance
  ( PShow a
  , PLC.Contains PLC.DefaultUni (PlutusRepr a)
  ) =>
  PShow (PBuiltinList a)
  where
  pshow' :: forall (s :: S). Bool -> Term s (PBuiltinList a) -> Term s PString
pshow' Bool
_ Term s (PBuiltinList a)
x = forall (list :: PType -> PType) (a :: PType) (s :: S).
(PShow a, PIsListLike list a) =>
Term s (list a :--> PString)
pshowList @PBuiltinList @a Term s (PBuiltinList a :--> PString)
-> Term s (PBuiltinList a) -> Term s PString
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinList a)
x

instance (PShow a, PShow b) => PShow (PBuiltinPair a b) where
  pshow' :: forall (s :: S).
Bool -> Term s (PBuiltinPair a b) -> Term s PString
pshow' Bool
_ Term s (PBuiltinPair a b)
pair = Term s PString
"(" Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s a -> Term s PString
forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow (Term s (PBuiltinPair a b :--> a)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin Term s (PBuiltinPair a b :--> a)
-> Term s (PBuiltinPair a b) -> Term s a
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair a b)
pair) Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
"," Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s b -> Term s PString
forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow (Term s (PBuiltinPair a b :--> b)
forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin Term s (PBuiltinPair a b :--> b)
-> Term s (PBuiltinPair a b) -> Term s b
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair a b)
pair) Term s PString -> Term s PString -> Term s PString
forall a. Semigroup a => a -> a -> a
<> Term s PString
")"

-- | @since WIP
instance PShow PPositive

-- | @since WIP
instance PShow a => PShow (PMaybe a)

-- | @since WIP
instance PShow a => PShow (PMaybeSoP a)