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

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

module PlutusCore.Pretty.Classic
    ( PrettyConfigClassic (..)
    , PrettyClassicBy
    , PrettyClassic
    , consAnnIf
    , defPrettyConfigClassic
    , debugPrettyConfigClassic
    , prettyClassicDef
    , prettyClassicDebug
    ) where

import PlutusPrelude

import PlutusCore.Pretty.ConfigName

import Prettyprinter.Internal (Doc (Empty))

-- | Configuration for the classic pretty-printing.
data PrettyConfigClassic configName = PrettyConfigClassic
    { PrettyConfigClassic configName -> configName
_pccConfigName :: configName  -- ^ How to pretty-print names.
    , PrettyConfigClassic configName -> Bool
_pccDisplayAnn :: Bool        -- ^ Whether to display annotations.
    }

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 -> PrettyConfigName
forall configName. PrettyConfigClassic configName -> configName
_pccConfigName

isEmptyDoc :: Doc ann -> Bool
isEmptyDoc :: 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 :: 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 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

defPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName
defPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName
defPrettyConfigClassic = PrettyConfigName -> Bool -> PrettyConfigClassic PrettyConfigName
forall configName.
configName -> Bool -> PrettyConfigClassic configName
PrettyConfigClassic PrettyConfigName
defPrettyConfigName Bool
False

debugPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName
debugPrettyConfigClassic :: PrettyConfigClassic PrettyConfigName
debugPrettyConfigClassic = PrettyConfigName -> Bool -> PrettyConfigClassic PrettyConfigName
forall configName.
configName -> Bool -> PrettyConfigClassic configName
PrettyConfigClassic PrettyConfigName
debugPrettyConfigName Bool
False

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

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