{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{-| The global pretty-printing config used to pretty-print everything in the PLC world.
This module also defines custom pretty-printing functions for PLC types as a convenience. -}
module PlutusCore.Pretty.Plc
  ( -- * Global configuration
    CondensedErrors (..)
  , PrettyConfigPlcOptions (..)
  , PrettyConfigPlcStrategy (..)
  , PrettyConfigPlc (..)
  , PrettyPlc
  , DefaultPrettyPlcStrategy
  , prettyConfigPlcOptions
  , prettyConfigPlcClassic
  , prettyConfigPlcClassicSimple
  , prettyConfigPlcReadable
  , prettyConfigPlcReadableSimple

    -- * Custom functions for PLC types.
  , prettyPlcClassic
  , prettyPlcClassicSimple
  , prettyPlcReadable
  , prettyPlcReadableSimple
  , prettyPlcCondensedErrorBy
  ) where

import PlutusPrelude

import PlutusCore.Pretty.Classic
import PlutusCore.Pretty.ConfigName
import PlutusCore.Pretty.Readable

-- | Whether to pretty-print PLC errors in full or with some information omitted.
data CondensedErrors
  = CondensedErrorsYes
  | CondensedErrorsNo
  deriving stock (Int -> CondensedErrors -> ShowS
[CondensedErrors] -> ShowS
CondensedErrors -> String
(Int -> CondensedErrors -> ShowS)
-> (CondensedErrors -> String)
-> ([CondensedErrors] -> ShowS)
-> Show CondensedErrors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CondensedErrors -> ShowS
showsPrec :: Int -> CondensedErrors -> ShowS
$cshow :: CondensedErrors -> String
show :: CondensedErrors -> String
$cshowList :: [CondensedErrors] -> ShowS
showList :: [CondensedErrors] -> ShowS
Show, CondensedErrors -> CondensedErrors -> Bool
(CondensedErrors -> CondensedErrors -> Bool)
-> (CondensedErrors -> CondensedErrors -> Bool)
-> Eq CondensedErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CondensedErrors -> CondensedErrors -> Bool
== :: CondensedErrors -> CondensedErrors -> Bool
$c/= :: CondensedErrors -> CondensedErrors -> Bool
/= :: CondensedErrors -> CondensedErrors -> Bool
Eq)

-- | Options for pretty-printing PLC entities.
newtype PrettyConfigPlcOptions = PrettyConfigPlcOptions
  { PrettyConfigPlcOptions -> CondensedErrors
_pcpoCondensedErrors :: CondensedErrors
  }
  deriving stock (Int -> PrettyConfigPlcOptions -> ShowS
[PrettyConfigPlcOptions] -> ShowS
PrettyConfigPlcOptions -> String
(Int -> PrettyConfigPlcOptions -> ShowS)
-> (PrettyConfigPlcOptions -> String)
-> ([PrettyConfigPlcOptions] -> ShowS)
-> Show PrettyConfigPlcOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyConfigPlcOptions -> ShowS
showsPrec :: Int -> PrettyConfigPlcOptions -> ShowS
$cshow :: PrettyConfigPlcOptions -> String
show :: PrettyConfigPlcOptions -> String
$cshowList :: [PrettyConfigPlcOptions] -> ShowS
showList :: [PrettyConfigPlcOptions] -> ShowS
Show)

-- | Strategy for pretty-printing PLC entities.
data PrettyConfigPlcStrategy
  = PrettyConfigPlcClassic (PrettyConfigClassic PrettyConfigName)
  | PrettyConfigPlcReadable (PrettyConfigReadable PrettyConfigName)
  deriving stock (Int -> PrettyConfigPlcStrategy -> ShowS
[PrettyConfigPlcStrategy] -> ShowS
PrettyConfigPlcStrategy -> String
(Int -> PrettyConfigPlcStrategy -> ShowS)
-> (PrettyConfigPlcStrategy -> String)
-> ([PrettyConfigPlcStrategy] -> ShowS)
-> Show PrettyConfigPlcStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyConfigPlcStrategy -> ShowS
showsPrec :: Int -> PrettyConfigPlcStrategy -> ShowS
$cshow :: PrettyConfigPlcStrategy -> String
show :: PrettyConfigPlcStrategy -> String
$cshowList :: [PrettyConfigPlcStrategy] -> ShowS
showList :: [PrettyConfigPlcStrategy] -> ShowS
Show)

-- | Global configuration used for pretty-printing PLC entities.
data PrettyConfigPlc = PrettyConfigPlc
  { PrettyConfigPlc -> PrettyConfigPlcOptions
_pcpOptions :: PrettyConfigPlcOptions
  , PrettyConfigPlc -> PrettyConfigPlcStrategy
_pcpStrategy :: PrettyConfigPlcStrategy
  }
  deriving stock (Int -> PrettyConfigPlc -> ShowS
[PrettyConfigPlc] -> ShowS
PrettyConfigPlc -> String
(Int -> PrettyConfigPlc -> ShowS)
-> (PrettyConfigPlc -> String)
-> ([PrettyConfigPlc] -> ShowS)
-> Show PrettyConfigPlc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PrettyConfigPlc -> ShowS
showsPrec :: Int -> PrettyConfigPlc -> ShowS
$cshow :: PrettyConfigPlc -> String
show :: PrettyConfigPlc -> String
$cshowList :: [PrettyConfigPlc] -> ShowS
showList :: [PrettyConfigPlc] -> ShowS
Show)

type instance HasPrettyDefaults PrettyConfigPlc = 'True

-- | The "pretty-printable PLC entity" constraint.
type PrettyPlc = PrettyBy PrettyConfigPlc

-- | A constraint that allows to derive @PrettyBy PrettyConfigPlc@ instances, see below.
type DefaultPrettyPlcStrategy a =
  ( PrettyClassic a
  , PrettyReadable a
  )

instance HasPrettyConfigName PrettyConfigPlcStrategy where
  toPrettyConfigName :: PrettyConfigPlcStrategy -> PrettyConfigName
toPrettyConfigName (PrettyConfigPlcClassic PrettyConfigClassic PrettyConfigName
configClassic) = PrettyConfigClassic PrettyConfigName -> PrettyConfigName
forall config.
HasPrettyConfigName config =>
config -> PrettyConfigName
toPrettyConfigName PrettyConfigClassic PrettyConfigName
configClassic
  toPrettyConfigName (PrettyConfigPlcReadable PrettyConfigReadable PrettyConfigName
configReadable) = PrettyConfigReadable PrettyConfigName -> PrettyConfigName
forall config.
HasPrettyConfigName config =>
config -> PrettyConfigName
toPrettyConfigName PrettyConfigReadable PrettyConfigName
configReadable

instance HasPrettyConfigName PrettyConfigPlc where
  toPrettyConfigName :: PrettyConfigPlc -> PrettyConfigName
toPrettyConfigName = PrettyConfigPlcStrategy -> PrettyConfigName
forall config.
HasPrettyConfigName config =>
config -> PrettyConfigName
toPrettyConfigName (PrettyConfigPlcStrategy -> PrettyConfigName)
-> (PrettyConfigPlc -> PrettyConfigPlcStrategy)
-> PrettyConfigPlc
-> PrettyConfigName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigPlc -> PrettyConfigPlcStrategy
_pcpStrategy

instance DefaultPrettyPlcStrategy a => PrettyBy PrettyConfigPlcStrategy (PrettyAny a) where
  prettyBy :: forall ann. PrettyConfigPlcStrategy -> PrettyAny a -> Doc ann
prettyBy (PrettyConfigPlcClassic PrettyConfigClassic PrettyConfigName
configClassic) = 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
configClassic (a -> Doc ann) -> (PrettyAny a -> a) -> PrettyAny a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyAny a -> a
forall a. PrettyAny a -> a
unPrettyAny
  prettyBy (PrettyConfigPlcReadable PrettyConfigReadable PrettyConfigName
configReadable) = PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall ann. PrettyConfigReadable PrettyConfigName -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigReadable PrettyConfigName
configReadable (a -> Doc ann) -> (PrettyAny a -> a) -> PrettyAny a -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyAny a -> a
forall a. PrettyAny a -> a
unPrettyAny

instance DefaultPrettyPlcStrategy a => PrettyBy PrettyConfigPlc (PrettyAny a) where
  prettyBy :: forall ann. PrettyConfigPlc -> PrettyAny a -> Doc ann
prettyBy = PrettyConfigPlcStrategy -> PrettyAny a -> Doc ann
forall ann. PrettyConfigPlcStrategy -> PrettyAny a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlcStrategy -> PrettyAny a -> Doc ann)
-> (PrettyConfigPlc -> PrettyConfigPlcStrategy)
-> PrettyConfigPlc
-> PrettyAny a
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigPlc -> PrettyConfigPlcStrategy
_pcpStrategy

{-| The 'PrettyConfigPlcOptions' used by default:
print errors in full. -}
prettyConfigPlcOptions :: PrettyConfigPlcOptions
prettyConfigPlcOptions :: PrettyConfigPlcOptions
prettyConfigPlcOptions = CondensedErrors -> PrettyConfigPlcOptions
PrettyConfigPlcOptions CondensedErrors
CondensedErrorsNo

{-| The 'PrettyConfigPlc' used by default:
use the classic view and print neither 'Unique's, nor name attachments. -}
prettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassic PrettyConfigPlcOptions
opts =
  PrettyConfigPlcOptions
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
PrettyConfigPlc PrettyConfigPlcOptions
opts (PrettyConfigPlcStrategy -> PrettyConfigPlc)
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
forall a b. (a -> b) -> a -> b
$ PrettyConfigClassic PrettyConfigName -> PrettyConfigPlcStrategy
PrettyConfigPlcClassic PrettyConfigClassic PrettyConfigName
prettyConfigClassic

{-| The 'PrettyConfigPlc' used for debugging:
use the classic view and print 'Unique's, but not name attachments. -}
prettyConfigPlcClassicSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassicSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassicSimple PrettyConfigPlcOptions
opts =
  PrettyConfigPlcOptions
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
PrettyConfigPlc PrettyConfigPlcOptions
opts (PrettyConfigPlcStrategy -> PrettyConfigPlc)
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
forall a b. (a -> b) -> a -> b
$ PrettyConfigClassic PrettyConfigName -> PrettyConfigPlcStrategy
PrettyConfigPlcClassic PrettyConfigClassic PrettyConfigName
prettyConfigClassicSimple

{-| The 'PrettyConfigPlc' used by default and for readability:
use the refined view and print 'Unique's but not name attachments. -}
prettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadable PrettyConfigPlcOptions
opts =
  PrettyConfigPlcOptions
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
PrettyConfigPlc PrettyConfigPlcOptions
opts (PrettyConfigPlcStrategy -> PrettyConfigPlc)
-> (PrettyConfigReadable PrettyConfigName
    -> PrettyConfigPlcStrategy)
-> PrettyConfigReadable PrettyConfigName
-> PrettyConfigPlc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigReadable PrettyConfigName -> PrettyConfigPlcStrategy
PrettyConfigPlcReadable (PrettyConfigReadable PrettyConfigName -> PrettyConfigPlc)
-> PrettyConfigReadable PrettyConfigName -> PrettyConfigPlc
forall a b. (a -> b) -> a -> b
$
    PrettyConfigName
-> ShowKinds -> PrettyConfigReadable PrettyConfigName
forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable PrettyConfigName
prettyConfigName ShowKinds
forall a. Default a => a
def

{-| The 'PrettyConfigPlc' used for debugging and readability:
use the refined view and print neither 'Unique's nor name attachments. -}
prettyConfigPlcReadableSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadableSimple :: PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadableSimple PrettyConfigPlcOptions
opts =
  PrettyConfigPlcOptions
-> PrettyConfigPlcStrategy -> PrettyConfigPlc
PrettyConfigPlc PrettyConfigPlcOptions
opts (PrettyConfigPlcStrategy -> PrettyConfigPlc)
-> (PrettyConfigReadable PrettyConfigName
    -> PrettyConfigPlcStrategy)
-> PrettyConfigReadable PrettyConfigName
-> PrettyConfigPlc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigReadable PrettyConfigName -> PrettyConfigPlcStrategy
PrettyConfigPlcReadable (PrettyConfigReadable PrettyConfigName -> PrettyConfigPlc)
-> PrettyConfigReadable PrettyConfigName -> PrettyConfigPlc
forall a b. (a -> b) -> a -> b
$
    PrettyConfigName
-> ShowKinds -> PrettyConfigReadable PrettyConfigName
forall configName.
configName -> ShowKinds -> PrettyConfigReadable configName
botPrettyConfigReadable PrettyConfigName
prettyConfigNameSimple ShowKinds
forall a. Default a => a
def

-- | Pretty-print a PLC value in the default mode using the classic view.
prettyPlcClassic :: PrettyPlc a => a -> Doc ann
prettyPlcClassic :: forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassic = PrettyConfigPlc -> a -> Doc ann
forall ann. PrettyConfigPlc -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlc -> a -> Doc ann)
-> PrettyConfigPlc -> a -> Doc ann
forall a b. (a -> b) -> a -> b
$ PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassic PrettyConfigPlcOptions
prettyConfigPlcOptions

-- | Pretty-print a PLC value without unique indices using the classic view.
prettyPlcClassicSimple :: PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple :: forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple = PrettyConfigPlc -> a -> Doc ann
forall ann. PrettyConfigPlc -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlc -> a -> Doc ann)
-> PrettyConfigPlc -> a -> Doc ann
forall a b. (a -> b) -> a -> b
$ PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcClassicSimple PrettyConfigPlcOptions
prettyConfigPlcOptions

-- | Pretty-print a PLC value in the default mode using the readable view.
prettyPlcReadable :: PrettyPlc a => a -> Doc ann
prettyPlcReadable :: forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable = PrettyConfigPlc -> a -> Doc ann
forall ann. PrettyConfigPlc -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlc -> a -> Doc ann)
-> PrettyConfigPlc -> a -> Doc ann
forall a b. (a -> b) -> a -> b
$ PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadable PrettyConfigPlcOptions
prettyConfigPlcOptions

-- | Pretty-print a PLC value without unique indices using the readable view.
prettyPlcReadableSimple :: PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple :: forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadableSimple = PrettyConfigPlc -> a -> Doc ann
forall ann. PrettyConfigPlc -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlc -> a -> Doc ann)
-> PrettyConfigPlc -> a -> Doc ann
forall a b. (a -> b) -> a -> b
$ PrettyConfigPlcOptions -> PrettyConfigPlc
prettyConfigPlcReadableSimple PrettyConfigPlcOptions
prettyConfigPlcOptions

{-| Pretty-print a PLC value using the condensed way (see 'CondensedErrors')
of pretty-printing PLC errors (in case there are any). -}
prettyPlcCondensedErrorBy
  :: PrettyPlc a => (PrettyConfigPlcOptions -> PrettyConfigPlc) -> a -> Doc ann
prettyPlcCondensedErrorBy :: forall a ann.
PrettyPlc a =>
(PrettyConfigPlcOptions -> PrettyConfigPlc) -> a -> Doc ann
prettyPlcCondensedErrorBy PrettyConfigPlcOptions -> PrettyConfigPlc
toConfig = PrettyConfigPlc -> a -> Doc ann
forall ann. PrettyConfigPlc -> a -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy (PrettyConfigPlc -> a -> Doc ann)
-> (PrettyConfigPlcOptions -> PrettyConfigPlc)
-> PrettyConfigPlcOptions
-> a
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrettyConfigPlcOptions -> PrettyConfigPlc
toConfig (PrettyConfigPlcOptions -> a -> Doc ann)
-> PrettyConfigPlcOptions -> a -> Doc ann
forall a b. (a -> b) -> a -> b
$ CondensedErrors -> PrettyConfigPlcOptions
PrettyConfigPlcOptions CondensedErrors
CondensedErrorsYes