-- | A "classic" (i.e. as seen in the specification) way to pretty-print PLC entities.

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

{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE LambdaCase            #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

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

import PlutusPrelude

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

import Prettyprinter
import Prettyprinter.Custom
import Universe

instance Pretty ann => PrettyBy (PrettyConfigClassic configName) (Kind ann) where
    prettyBy :: PrettyConfigClassic configName -> Kind ann -> Doc ann
prettyBy PrettyConfigClassic configName
config = \case
        Type ann
ann           ->
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
parens ([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
                [Doc ann
"type"]))
        KindArrow ann
ann Kind ann
k Kind ann
k' ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"fun" (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 -> Kind ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Kind ann
k, PrettyConfigClassic configName -> Kind ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Kind ann
k'])

instance (PrettyClassicBy configName tyname, GShow uni, Pretty ann) =>
        PrettyBy (PrettyConfigClassic configName) (Type tyname uni ann) where
    prettyBy :: PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
prettyBy PrettyConfigClassic configName
config = \case
        TyApp ann
ann Type tyname uni ann
t Type tyname uni ann
t'     ->
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
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 -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t']))
        TyVar ann
ann tyname
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 -> tyname -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config tyname
n])
        TyFun ann
ann Type tyname uni ann
t Type tyname uni ann
t'     ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"fun" (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 -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t'])
        TyIFix ann
ann Type tyname uni ann
pat Type tyname uni ann
arg ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"ifix" (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 -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
pat, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
arg])
        TyForall ann
ann tyname
n Kind ann
k Type tyname uni ann
t ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"all" (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 -> tyname -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config tyname
n, PrettyConfigClassic configName -> Kind ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Kind ann
k, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t])
        TyBuiltin ann
ann SomeTypeIn uni
n    ->
            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 [SomeTypeIn uni -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty SomeTypeIn uni
n])
        TyLam ann
ann tyname
n Kind ann
k Type tyname uni 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 -> tyname -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config tyname
n, PrettyConfigClassic configName -> Kind ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Kind ann
k, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
t])

instance
        ( PrettyClassicBy configName tyname
        , PrettyClassicBy configName name
        , GShow uni, Closed uni, uni `Everywhere` PrettyConst, Pretty fun
        , Pretty ann
        ) => PrettyBy (PrettyConfigClassic configName) (Term tyname name uni fun ann) where
    prettyBy :: PrettyConfigClassic configName
-> Term tyname 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])
        TyAbs ann
ann tyname
tn Kind ann
k Term tyname name uni fun ann
t ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"abs" (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 -> tyname -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config tyname
tn, PrettyConfigClassic configName -> Kind ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Kind ann
k, PrettyConfigClassic configName
-> Term tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t])
        LamAbs ann
ann name
n Type tyname uni ann
ty Term tyname 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 -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
ty, PrettyConfigClassic configName
-> Term tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t])
        Apply ann
ann Term tyname name uni fun ann
t1 Term tyname name uni fun ann
t2 ->
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
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 tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t1, PrettyConfigClassic configName
-> Term tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname 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])
        TyInst ann
ann Term tyname name uni fun ann
t Type tyname uni ann
ty ->
            Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces' ([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 tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
ty]))
        Error ann
ann Type tyname uni ann
ty ->
            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 [PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
ty])
        IWrap ann
ann Type tyname uni ann
ty1 Type tyname uni ann
ty2 Term tyname name uni fun ann
t ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"iwrap" (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 -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
ty1, PrettyConfigClassic configName -> Type tyname uni ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Type tyname uni ann
ty2, PrettyConfigClassic configName
-> Term tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t])
        Unwrap ann
ann Term tyname name uni fun ann
t ->
            Doc ann -> [Doc ann] -> Doc ann
forall a. Doc a -> [Doc a] -> Doc a
sexp Doc ann
"unwrap" (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 tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
t])
      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 tyname name uni fun ann), Pretty ann) =>
        PrettyBy (PrettyConfigClassic configName) (Program tyname name uni fun ann) where
    prettyBy :: PrettyConfigClassic configName
-> Program tyname name uni fun ann -> Doc ann
prettyBy PrettyConfigClassic configName
config (Program ann
ann Version ann
version Term tyname 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 tyname name uni fun ann -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic configName
config Term tyname name uni fun ann
term])