{-# LANGUAGE UndecidableInstances #-}

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

import Data.Kind (Type)
import Data.Text qualified as T
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Plutarch.Internal.Term (
  Config,
  S,
  Term,
  compile,
 )
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 :: forall (a :: S -> Type). HasCallStack => Config -> (forall (s :: S). Term s a) -> String
printTerm :: forall (a :: S -> Type).
HasCallStack =>
Config -> (forall (s :: S). Term s a) -> String
printTerm Config
config forall (s :: S). Term s 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 -> (forall (s :: S). Term s a) -> Either Text Script
forall (a :: S -> Type).
Config -> (forall (s :: S). Term s a) -> Either Text Script
compile Config
config Term s a
forall (s :: S). Term s a
term

{- | Type level flip operation, reversing the order of arguments
Commonly used in Plutarch to get the PTryFromExcess associated type of PTryFrom for a Plutarch type

@since 1.12.0
-}
newtype Flip (f :: k1 -> k2 -> Type) (a :: k2) (b :: k1) = Flip (f b a)
  deriving stock ((forall x. Flip @k1 @k2 f a b -> Rep (Flip @k1 @k2 f a b) x)
-> (forall x. Rep (Flip @k1 @k2 f a b) x -> Flip @k1 @k2 f a b)
-> Generic (Flip @k1 @k2 f a b)
forall x. Rep (Flip @k1 @k2 f a b) x -> Flip @k1 @k2 f a b
forall x. Flip @k1 @k2 f a b -> Rep (Flip @k1 @k2 f a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k2 k1 (f :: k1 -> k2 -> Type) (a :: k2) (b :: k1) x.
Rep (Flip @k1 @k2 f a b) x -> Flip @k1 @k2 f a b
forall k2 k1 (f :: k1 -> k2 -> Type) (a :: k2) (b :: k1) x.
Flip @k1 @k2 f a b -> Rep (Flip @k1 @k2 f a b) x
$cfrom :: forall k2 k1 (f :: k1 -> k2 -> Type) (a :: k2) (b :: k1) x.
Flip @k1 @k2 f a b -> Rep (Flip @k1 @k2 f a b) x
from :: forall x. Flip @k1 @k2 f a b -> Rep (Flip @k1 @k2 f a b) x
$cto :: forall k2 k1 (f :: k1 -> k2 -> Type) (a :: k2) (b :: k1) x.
Rep (Flip @k1 @k2 f a b) x -> Flip @k1 @k2 f a b
to :: forall x. Rep (Flip @k1 @k2 f a b) x -> Flip @k1 @k2 f a b
Generic)