{-# LANGUAGE UndecidableInstances #-}

module Plutarch.Internal.Other (
  printTerm,
  printScript,
  pto,
) where

import Data.Text qualified as T
import GHC.Stack (HasCallStack)
import Plutarch.Internal.PlutusType (
  PInner,
 )
import Plutarch.Internal.Term (
  ClosedTerm,
  Config,
  Term,
  compile,
  punsafeCoerce,
 )
import Plutarch.Script (Script (Script))
import PlutusCore.Pretty (prettyPlcReadable)

-- | Prettyprint a compiled Script via the PLC pretty printer
printScript :: Script -> String
printScript :: Script -> String
printScript = Doc (Any @Type) -> String
forall a. Show a => a -> String
show (Doc (Any @Type) -> String)
-> (Script -> Doc (Any @Type)) -> Script -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program DeBruijn DefaultUni DefaultFun () -> Doc (Any @Type)
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcReadable (Program DeBruijn DefaultUni DefaultFun () -> Doc (Any @Type))
-> (Script -> Program DeBruijn DefaultUni DefaultFun ())
-> Script
-> Doc (Any @Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(Script Program DeBruijn DefaultUni DefaultFun ()
s) -> Program DeBruijn DefaultUni DefaultFun ()
s)

{- | Prettyprint a Term via the PLC pretty printer

  TODO: Heavily improve. It's unreadable right now.

  We could convert the de Bruijn indices into names with:

  > show . prettyPlcReadableDef . (\(Right p) -> p) . Scripts.mkTermToEvaluate . compile $ term
-}
printTerm :: HasCallStack => Config -> ClosedTerm a -> String
printTerm :: forall (a :: PType).
HasCallStack =>
Config -> ClosedTerm a -> String
printTerm Config
config ClosedTerm a
term = Script -> String
printScript (Script -> String) -> Script -> String
forall a b. (a -> b) -> a -> b
$ (Text -> Script)
-> (Script -> Script) -> Either Text Script -> Script
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Script
forall a. HasCallStack => String -> a
error (String -> Script) -> (Text -> String) -> Text -> Script
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) Script -> Script
forall a. a -> a
id (Either Text Script -> Script) -> Either Text Script -> Script
forall a b. (a -> b) -> a -> b
$ Config -> ClosedTerm a -> Either Text Script
forall (a :: PType). Config -> ClosedTerm a -> Either Text Script
compile Config
config Term s a
ClosedTerm a
term

{- |
  Safely coerce from a Term to it's 'PInner' representation.
-}
pto :: Term s a -> Term s (PInner a)
pto :: forall (s :: S) (a :: PType). Term s a -> Term s (PInner a)
pto = Term s a -> Term s (PInner a)
forall (b :: PType) (a :: PType) (s :: S). Term s a -> Term s b
punsafeCoerce