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

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds       #-}
{-# LANGUAGE TypeFamilies    #-}
{-# LANGUAGE TypeOperators   #-}

module PlutusCore.Pretty.Classic
    ( PrettyConfigClassic (..)
    , PrettyClassicBy
    , PrettyClassic
    , PrettyParens
    , juxtRenderContext
    , consAnnIf
    , prettyConfigClassic
    , prettyConfigClassicSimple
    , prettyClassic
    , prettyClassicSimple
    ) where

import PlutusPrelude

import PlutusCore.Pretty.ConfigName
import PlutusCore.Pretty.Extra

import Prettyprinter.Internal (Doc (Empty))

-- | Configuration for the classic pretty-printing.
data PrettyConfigClassic configName = PrettyConfigClassic
    { forall configName. PrettyConfigClassic configName -> configName
_pccConfigName :: configName  -- ^ How to pretty-print names.
    , forall configName. PrettyConfigClassic configName -> Bool
_pccDisplayAnn :: Bool        -- ^ Whether to display annotations.
    }
    deriving stock (Int -> PrettyConfigClassic configName -> ShowS
[PrettyConfigClassic configName] -> ShowS
PrettyConfigClassic configName -> String
(Int -> PrettyConfigClassic configName -> ShowS)
-> (PrettyConfigClassic configName -> String)
-> ([PrettyConfigClassic configName] -> ShowS)
-> Show (PrettyConfigClassic configName)
forall configName.
Show configName =>
Int -> PrettyConfigClassic configName -> ShowS
forall configName.
Show configName =>
[PrettyConfigClassic configName] -> ShowS
forall configName.
Show configName =>
PrettyConfigClassic configName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall configName.
Show configName =>
Int -> PrettyConfigClassic configName -> ShowS
showsPrec :: Int -> PrettyConfigClassic configName -> ShowS
$cshow :: forall configName.
Show configName =>
PrettyConfigClassic configName -> String
show :: PrettyConfigClassic configName -> String
$cshowList :: forall configName.
Show configName =>
[PrettyConfigClassic configName] -> ShowS
showList :: [PrettyConfigClassic configName] -> ShowS
Show)

type instance HasPrettyDefaults (PrettyConfigClassic _) = 'True

-- | The "classically pretty-printable" constraint.
type PrettyClassicBy configName = PrettyBy (PrettyConfigClassic configName)

type PrettyClassic = PrettyClassicBy PrettyConfigName

instance configName ~ PrettyConfigName => HasPrettyConfigName (PrettyConfigClassic configName) where
    toPrettyConfigName :: PrettyConfigClassic configName -> PrettyConfigName
toPrettyConfigName = PrettyConfigClassic configName -> configName
PrettyConfigClassic configName -> PrettyConfigName
forall configName. PrettyConfigClassic configName -> configName
_pccConfigName

isEmptyDoc :: Doc ann -> Bool
isEmptyDoc :: forall ann. Doc ann -> Bool
isEmptyDoc Doc ann
Empty = Bool
True
isEmptyDoc Doc ann
_     = Bool
False

-- | Add a pretty-printed annotation to a list of 'Doc's if the given config enables pretty-printing
-- of annotations.
consAnnIf :: Pretty ann => PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf :: forall ann configName dann.
Pretty ann =>
PrettyConfigClassic configName -> ann -> [Doc dann] -> [Doc dann]
consAnnIf PrettyConfigClassic configName
config ann
ann [Doc dann]
rest = (Doc dann -> Bool) -> [Doc dann] -> [Doc dann]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Doc dann -> Bool) -> Doc dann -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc dann -> Bool
forall ann. Doc ann -> Bool
isEmptyDoc) [ann -> Doc dann
forall ann. ann -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ann
ann | PrettyConfigClassic configName -> Bool
forall configName. PrettyConfigClassic configName -> Bool
_pccDisplayAnn PrettyConfigClassic configName
config] [Doc dann] -> [Doc dann] -> [Doc dann]
forall a. [a] -> [a] -> [a]
++ [Doc dann]
rest

prettyConfigClassic :: PrettyConfigClassic PrettyConfigName
prettyConfigClassic :: PrettyConfigClassic PrettyConfigName
prettyConfigClassic = PrettyConfigName -> Bool -> PrettyConfigClassic PrettyConfigName
forall configName.
configName -> Bool -> PrettyConfigClassic configName
PrettyConfigClassic PrettyConfigName
prettyConfigName Bool
False

prettyConfigClassicSimple :: PrettyConfigClassic PrettyConfigName
prettyConfigClassicSimple :: PrettyConfigClassic PrettyConfigName
prettyConfigClassicSimple = PrettyConfigName -> Bool -> PrettyConfigClassic PrettyConfigName
forall configName.
configName -> Bool -> PrettyConfigClassic configName
PrettyConfigClassic PrettyConfigName
prettyConfigNameSimple Bool
False

-- | Pretty-print a value in the default mode using the classic view.
prettyClassic :: PrettyClassic a => a -> Doc ann
prettyClassic :: forall a ann. PrettyClassic a => a -> Doc ann
prettyClassic = PrettyConfigClassic PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigClassic PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic PrettyConfigName
prettyConfigClassic

-- | Pretty-print a value in the simple mode using the classic view.
prettyClassicSimple :: PrettyClassic a => a -> Doc ann
prettyClassicSimple :: forall a ann. PrettyClassic a => a -> Doc ann
prettyClassicSimple = PrettyConfigClassic PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigClassic PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic PrettyConfigName
prettyConfigClassicSimple