module Plutarch.Pretty.Internal.BuiltinConstant (prettyConstant) where

import Data.ByteString (ByteString)
import Data.ByteString.Builder qualified as BSB
import Data.ByteString.Lazy qualified as LBS
import Data.Text (Text)
import Data.Text.Encoding qualified as TxtEnc

import Prettyprinter ((<+>))
import Prettyprinter qualified as PP

import PlutusCore qualified as PLC
import PlutusLedgerApi.V1 qualified as Plutus
import UntypedPlutusCore (DefaultUni)

import Plutarch.Pretty.Internal.Config (indentWidth)

prettyConstant :: PLC.Some (PLC.ValueOf DefaultUni) -> PP.Doc ()
prettyConstant :: Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniInteger a
n)) = a -> Doc ()
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty a
n
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniByteString a
b)) = Text -> Doc ()
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (Text -> Doc ()) -> Text -> Doc ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
encodeHex a
ByteString
b
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniString a
s)) =
  -- Have to `show` first to get a quoted string.
  String -> Doc ()
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty (String -> Doc ()) -> String -> Doc ()
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
s
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniUnit a
_)) = Doc ()
"()"
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniBool a
b)) = a -> Doc ()
forall ann. a -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty a
b
prettyConstant (PLC.Some (PLC.ValueOf (PLC.DefaultUniList DefaultUni (Esc @k1 a1)
a) a
l)) =
  [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
PP.list ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$
    (a1 -> Doc ()) -> [a1] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> (a1 -> Some @Type (ValueOf DefaultUni)) -> a1 -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueOf DefaultUni a1 -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni a1 -> Some @Type (ValueOf DefaultUni))
-> (a1 -> ValueOf DefaultUni a1)
-> a1
-> Some @Type (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultUni (Esc @Type a1) -> a1 -> ValueOf DefaultUni a1
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @k1 a1)
DefaultUni (Esc @Type a1)
a) a
[a1]
l
prettyConstant (PLC.Some (PLC.ValueOf (PLC.DefaultUniPair DefaultUni (Esc @k3 a2)
a DefaultUni (Esc @k1 a1)
b) ~(a2
x, a1
y))) =
  [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
PP.tupled
    [Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> (ValueOf DefaultUni a2 -> Some @Type (ValueOf DefaultUni))
-> ValueOf DefaultUni a2
-> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueOf DefaultUni a2 -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni a2 -> Doc ())
-> ValueOf DefaultUni a2 -> Doc ()
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc @Type a2) -> a2 -> ValueOf DefaultUni a2
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @k3 a2)
DefaultUni (Esc @Type a2)
a a2
x, Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> (ValueOf DefaultUni a1 -> Some @Type (ValueOf DefaultUni))
-> ValueOf DefaultUni a1
-> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueOf DefaultUni a1 -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni a1 -> Doc ())
-> ValueOf DefaultUni a1 -> Doc ()
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc @Type a1) -> a1 -> ValueOf DefaultUni a1
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @k1 a1)
DefaultUni (Esc @Type a1)
b a1
y]
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniData (Plutus.Constr Integer
ix [Data]
dl))) =
  Doc ()
"Σ"
    Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ()
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
PP.pretty Integer
ix
    Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Doc ()
"."
    Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
PP.list (Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> (Data -> Some @Type (ValueOf DefaultUni)) -> Data -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni))
-> (Data -> ValueOf DefaultUni Data)
-> Data
-> Some @Type (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultUni (Esc @Type Data) -> Data -> ValueOf DefaultUni Data
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type Data)
PLC.DefaultUniData (Data -> Doc ()) -> [Data] -> [Doc ()]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data]
dl)
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniData (Plutus.Map [(Data, Data)]
ascList))) =
  Doc () -> Doc ()
forall ann. Doc ann -> Doc ann
PP.group
    (Doc () -> Doc ()) -> ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc () -> Doc () -> Doc () -> [Doc ()] -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann -> [Doc ann] -> Doc ann
PP.encloseSep (Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
PP.flatAlt Doc ()
"{ " Doc ()
"{") (Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
PP.flatAlt Doc ()
" }" Doc ()
"}") Doc ()
", "
    ([Doc ()] -> Doc ()) -> [Doc ()] -> Doc ()
forall a b. (a -> b) -> a -> b
$ ((Data, Data) -> Doc ()) -> [(Data, Data)] -> [Doc ()]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \(Data
a, Data
b) ->
          Int -> Doc () -> Doc ()
forall ann. Int -> Doc ann -> Doc ann
PP.hang Int
indentWidth (Doc () -> Doc ()) -> Doc () -> Doc ()
forall a b. (a -> b) -> a -> b
$
            [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
PP.sep
              [ Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (DefaultUni (Esc @Type Data) -> Data -> ValueOf DefaultUni Data
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type Data)
PLC.DefaultUniData Data
a)) Doc () -> Doc () -> Doc ()
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ()
"="
              , Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> Some @Type (ValueOf DefaultUni) -> Doc ()
forall a b. (a -> b) -> a -> b
$ ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni))
-> ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc @Type Data) -> Data -> ValueOf DefaultUni Data
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type Data)
PLC.DefaultUniData Data
b
              ]
      )
      [(Data, Data)]
ascList
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniData (Plutus.List [Data]
l))) =
  Doc ()
"#" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> [Doc ()] -> Doc ()
forall ann. [Doc ann] -> Doc ann
PP.list (Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (Some @Type (ValueOf DefaultUni) -> Doc ())
-> (Data -> Some @Type (ValueOf DefaultUni)) -> Data -> Doc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni Data -> Some @Type (ValueOf DefaultUni))
-> (Data -> ValueOf DefaultUni Data)
-> Data
-> Some @Type (ValueOf DefaultUni)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DefaultUni (Esc @Type Data) -> Data -> ValueOf DefaultUni Data
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type Data)
PLC.DefaultUniData (Data -> Doc ()) -> [Data] -> [Doc ()]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data]
l)
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniData (Plutus.B ByteString
b))) =
  Doc ()
"#" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (ValueOf DefaultUni ByteString -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni ByteString -> Some @Type (ValueOf DefaultUni))
-> ValueOf DefaultUni ByteString -> Some @Type (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc @Type ByteString)
-> ByteString -> ValueOf DefaultUni ByteString
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type ByteString)
PLC.DefaultUniByteString ByteString
b)
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
PLC.DefaultUniData (Plutus.I Integer
i))) =
  Doc ()
"#" Doc () -> Doc () -> Doc ()
forall a. Semigroup a => a -> a -> a
<> Some @Type (ValueOf DefaultUni) -> Doc ()
prettyConstant (ValueOf DefaultUni Integer -> Some @Type (ValueOf DefaultUni)
forall {k} (tag :: k -> Type) (a :: k). tag a -> Some @k tag
PLC.Some (ValueOf DefaultUni Integer -> Some @Type (ValueOf DefaultUni))
-> ValueOf DefaultUni Integer -> Some @Type (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ DefaultUni (Esc @Type Integer)
-> Integer -> ValueOf DefaultUni Integer
forall (uni :: Type -> Type) a.
uni (Esc @Type a) -> a -> ValueOf uni a
PLC.ValueOf DefaultUni (Esc @Type Integer)
PLC.DefaultUniInteger Integer
i)
prettyConstant (PLC.Some (PLC.ValueOf DefaultUni (Esc @Type a)
uni a
_)) =
  String -> Doc ()
forall a. HasCallStack => String -> a
error (String -> Doc ()) -> String -> Doc ()
forall a b. (a -> b) -> a -> b
$ String
"prettyConstant(impossible): " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DefaultUni (Esc @Type a) -> String
forall a. Show a => a -> String
show DefaultUni (Esc @Type a)
uni

encodeHex :: ByteString -> Text
encodeHex :: ByteString -> Text
encodeHex = (Text
"0x" <>) (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TxtEnc.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString (Builder -> ByteString)
-> (ByteString -> Builder) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
BSB.byteStringHex