-- | 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
    , defPrettyConfigPlcOptions
    , defPrettyConfigPlcClassic
    , debugPrettyConfigPlcClassic
    , defPrettyConfigPlcReadable
    , debugPrettyConfigPlcReadable
    -- * Custom functions for PLC types.
    , prettyPlcClassicDef
    , prettyPlcClassicDebug
    , prettyPlcReadableDef
    , prettyPlcReadableDebug
    , 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
showList :: [CondensedErrors] -> ShowS
$cshowList :: [CondensedErrors] -> ShowS
show :: CondensedErrors -> String
$cshow :: CondensedErrors -> String
showsPrec :: Int -> CondensedErrors -> ShowS
$cshowsPrec :: Int -> CondensedErrors -> ShowS
Show, CondensedErrors -> CondensedErrors -> Bool
(CondensedErrors -> CondensedErrors -> Bool)
-> (CondensedErrors -> CondensedErrors -> Bool)
-> Eq CondensedErrors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CondensedErrors -> CondensedErrors -> Bool
$c/= :: CondensedErrors -> CondensedErrors -> Bool
== :: CondensedErrors -> CondensedErrors -> Bool
$c== :: CondensedErrors -> CondensedErrors -> Bool
Eq)

-- | Options for pretty-printing PLC entities.
newtype PrettyConfigPlcOptions = PrettyConfigPlcOptions
    { PrettyConfigPlcOptions -> CondensedErrors
_pcpoCondensedErrors :: CondensedErrors
    }

-- | Strategy for pretty-printing PLC entities.
data PrettyConfigPlcStrategy
    = PrettyConfigPlcClassic (PrettyConfigClassic PrettyConfigName)
    | PrettyConfigPlcReadable (PrettyConfigReadable PrettyConfigName)

-- | Global configuration used for pretty-printing PLC entities.
data PrettyConfigPlc = PrettyConfigPlc
    { PrettyConfigPlc -> PrettyConfigPlcOptions
_pcpOptions  :: PrettyConfigPlcOptions
    , PrettyConfigPlc -> PrettyConfigPlcStrategy
_pcpStrategy :: PrettyConfigPlcStrategy
    }

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 :: PrettyConfigPlcStrategy -> PrettyAny a -> Doc ann
prettyBy (PrettyConfigPlcClassic  PrettyConfigClassic PrettyConfigName
configClassic ) = 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 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 :: PrettyConfigPlc -> PrettyAny a -> Doc ann
prettyBy = 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.
defPrettyConfigPlcOptions :: PrettyConfigPlcOptions
defPrettyConfigPlcOptions :: PrettyConfigPlcOptions
defPrettyConfigPlcOptions = CondensedErrors -> PrettyConfigPlcOptions
PrettyConfigPlcOptions CondensedErrors
CondensedErrorsNo

-- | The 'PrettyConfigPlc' used by default:
-- use the classic view and print neither 'Unique's, nor name attachments.
defPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
defPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
defPrettyConfigPlcClassic 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
defPrettyConfigClassic

-- | The 'PrettyConfigPlc' used for debugging:
-- use the classic view and print 'Unique's, but not name attachments.
debugPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
debugPrettyConfigPlcClassic :: PrettyConfigPlcOptions -> PrettyConfigPlc
debugPrettyConfigPlcClassic 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
debugPrettyConfigClassic

-- | The 'PrettyConfigPlc' used by default and for readability:
-- use the refined view and print neither 'Unique's, nor name attachments.
defPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
defPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
defPrettyConfigPlcReadable 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
topPrettyConfigReadable PrettyConfigName
defPrettyConfigName ShowKinds
ShowKindsYes

-- | The 'PrettyConfigPlc' used for debugging and readability:
-- use the refined view and print 'Unique's, but not name attachments.
debugPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
debugPrettyConfigPlcReadable :: PrettyConfigPlcOptions -> PrettyConfigPlc
debugPrettyConfigPlcReadable 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
topPrettyConfigReadable PrettyConfigName
debugPrettyConfigName ShowKinds
ShowKindsYes

-- | Pretty-print a PLC value in the default mode using the classic view.
prettyPlcClassicDef :: PrettyPlc a => a -> Doc ann
prettyPlcClassicDef :: a -> Doc ann
prettyPlcClassicDef = 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
defPrettyConfigPlcClassic PrettyConfigPlcOptions
defPrettyConfigPlcOptions

-- | Pretty-print a PLC value in the debug mode using the classic view.
prettyPlcClassicDebug :: PrettyPlc a => a -> Doc ann
prettyPlcClassicDebug :: a -> Doc ann
prettyPlcClassicDebug = 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
debugPrettyConfigPlcClassic PrettyConfigPlcOptions
defPrettyConfigPlcOptions

-- | Pretty-print a PLC value in the default mode using the readable view.
prettyPlcReadableDef :: PrettyPlc a => a -> Doc ann
prettyPlcReadableDef :: a -> Doc ann
prettyPlcReadableDef = 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
defPrettyConfigPlcReadable PrettyConfigPlcOptions
defPrettyConfigPlcOptions

-- | Pretty-print a PLC value in the debug mode using the readable view.
prettyPlcReadableDebug :: PrettyPlc a => a -> Doc ann
prettyPlcReadableDebug :: a -> Doc ann
prettyPlcReadableDebug = 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
debugPrettyConfigPlcReadable PrettyConfigPlcOptions
defPrettyConfigPlcOptions

-- | 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 :: (PrettyConfigPlcOptions -> PrettyConfigPlc) -> a -> Doc ann
prettyPlcCondensedErrorBy PrettyConfigPlcOptions -> PrettyConfigPlc
toConfig = 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