-- | 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.

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

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