-- | A "classic" (i.e. as seen in the specification) way to pretty-print Untyped Plutus Core terms.

{-# OPTIONS_GHC -fno-warn-orphans #-}

{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

module UntypedPlutusCore.Core.Instance.Pretty.Classic () where

import PlutusPrelude

import UntypedPlutusCore.Core.Type

import PlutusCore.Core.Instance.Pretty.Common ()
import PlutusCore.Pretty.Classic
import PlutusCore.Pretty.PrettyConst

import Prettyprinter
import Prettyprinter.Custom
import Universe

instance
        ( PrettyClassicBy configName name
        , GShow uni, Closed uni, uni `Everywhere` PrettyConst, Pretty fun
        , Pretty ann
        ) => PrettyBy (PrettyConfigClassic configName) (Term name uni fun ann) where
    prettyBy :: PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
prettyBy PrettyConfigClassic configName
config = \case
        Var ann
ann name
n ->
            [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann [PrettyConfigClassic configName -> name -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config name
n])
        LamAbs ann
ann name
n Term name uni fun ann
t ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"lam" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann
                [PrettyConfigClassic configName -> name -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config name
n, PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
t])
        Apply ann
ann Term name uni fun ann
t1 Term name uni fun ann
t2 ->
            Doc ann -> Doc ann
forall a. Doc a -> Doc a
brackets' ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
sep (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann
                [PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
t1, PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
t2]))
        Constant ann
ann Some (ValueOf uni)
c ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"con" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann [Some (ValueOf uni) -> Doc ann
forall (t :: * -> *) dann. GShow t => Some (ValueOf t) -> Doc dann
prettyTypeOf Some (ValueOf uni)
c, Some (ValueOf uni) -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Some (ValueOf uni)
c])
        Builtin ann
ann fun
bi ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"builtin" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann
                [fun -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty fun
bi])
        Error ann
ann ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"error" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann [])
        Delay ann
ann Term name uni fun ann
term ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"delay" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann
                [PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
term])
        Force ann
ann Term name uni fun ann
term ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"force" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann
                [PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
term])
      where
        prettyTypeOf :: GShow t => Some (ValueOf t) -> Doc dann
        prettyTypeOf :: Some (ValueOf t) -> Doc dann
prettyTypeOf (Some (ValueOf t (Esc a)
uni a
_ )) = SomeTypeIn t -> Doc dann
forall a ann. Pretty a => a -> Doc ann
pretty (SomeTypeIn t -> Doc dann) -> SomeTypeIn t -> Doc dann
forall a b. (a -> b) -> a -> b
$ t (Esc a) -> SomeTypeIn t
forall (uni :: * -> *) k (a :: k). uni (Esc a) -> SomeTypeIn uni
SomeTypeIn t (Esc a)
uni

instance (PrettyClassicBy configName (Term name uni fun ann), Pretty ann) =>
        PrettyBy (PrettyConfigClassic configName) (Program name uni fun ann) where
    prettyBy :: PrettyConfigClassic configName
-> Program name uni fun ann -> Doc ann
prettyBy PrettyConfigClassic configName
config (Program ann
ann Version ann
version Term name uni fun ann
term) =
        Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"program" (PrettyConfigClassic configName -> ann -> [Doc ann] -> [Doc ann]
forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann [Version ann -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Version ann
version, PrettyConfigClassic configName -> Term name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term name uni fun ann
term])