module Cooked.Skeleton.Redeemer
  ( TxSkelRedeemer (..),
    Redeemer (..),
    RedeemerConstrs,
    withReferenceInput,
    someTxSkelRedeemer,
    emptyTxSkelRedeemer,
    toTypedRedeemer,
  )
where

import Cooked.Pretty.Class
import Data.Typeable (Typeable, cast)
import PlutusLedgerApi.V3 qualified as Api
import PlutusTx.Prelude qualified as PlutusTx

type RedeemerConstrs redeemer =
  ( Api.ToData redeemer,
    Show redeemer,
    PrettyCooked redeemer,
    PlutusTx.Eq redeemer,
    Typeable redeemer
  )

data Redeemer where
  EmptyRedeemer :: Redeemer
  SomeRedeemer :: (RedeemerConstrs redeemer) => redeemer -> Redeemer

deriving instance (Show Redeemer)

instance Eq Redeemer where
  Redeemer
EmptyRedeemer == :: Redeemer -> Redeemer -> Bool
== Redeemer
EmptyRedeemer = Bool
True
  (SomeRedeemer redeemer
r1) == (SomeRedeemer redeemer
r2) = redeemer -> Maybe redeemer
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast redeemer
r1 Maybe redeemer -> Maybe redeemer -> Bool
forall a. Eq a => a -> a -> Bool
PlutusTx.== redeemer -> Maybe redeemer
forall a. a -> Maybe a
Just redeemer
r2
  Redeemer
_ == Redeemer
_ = Bool
False

data TxSkelRedeemer = TxSkelRedeemer
  { TxSkelRedeemer -> Redeemer
txSkelRedeemer :: Redeemer,
    -- An optional input containing a reference script
    TxSkelRedeemer -> Maybe TxOutRef
txSkelReferenceInput :: Maybe Api.TxOutRef
  }
  deriving (Int -> TxSkelRedeemer -> ShowS
[TxSkelRedeemer] -> ShowS
TxSkelRedeemer -> String
(Int -> TxSkelRedeemer -> ShowS)
-> (TxSkelRedeemer -> String)
-> ([TxSkelRedeemer] -> ShowS)
-> Show TxSkelRedeemer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSkelRedeemer -> ShowS
showsPrec :: Int -> TxSkelRedeemer -> ShowS
$cshow :: TxSkelRedeemer -> String
show :: TxSkelRedeemer -> String
$cshowList :: [TxSkelRedeemer] -> ShowS
showList :: [TxSkelRedeemer] -> ShowS
Show, TxSkelRedeemer -> TxSkelRedeemer -> Bool
(TxSkelRedeemer -> TxSkelRedeemer -> Bool)
-> (TxSkelRedeemer -> TxSkelRedeemer -> Bool) -> Eq TxSkelRedeemer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
== :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
$c/= :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
/= :: TxSkelRedeemer -> TxSkelRedeemer -> Bool
Eq)

-- Attempts to cast a redeemer to a certain type
toTypedRedeemer :: (Typeable a) => Redeemer -> Maybe a
toTypedRedeemer :: forall a. Typeable a => Redeemer -> Maybe a
toTypedRedeemer (SomeRedeemer redeemer
red) = redeemer -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast redeemer
red
toTypedRedeemer Redeemer
EmptyRedeemer = Maybe a
forall a. Maybe a
Nothing

-- Two helpers to create skeleton redeemers
someTxSkelRedeemer :: (RedeemerConstrs redeemer) => redeemer -> TxSkelRedeemer
someTxSkelRedeemer :: forall redeemer.
RedeemerConstrs redeemer =>
redeemer -> TxSkelRedeemer
someTxSkelRedeemer redeemer
a = Redeemer -> Maybe TxOutRef -> TxSkelRedeemer
TxSkelRedeemer (redeemer -> Redeemer
forall redeemer. RedeemerConstrs redeemer => redeemer -> Redeemer
SomeRedeemer redeemer
a) Maybe TxOutRef
forall a. Maybe a
Nothing

emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer :: TxSkelRedeemer
emptyTxSkelRedeemer = Redeemer -> Maybe TxOutRef -> TxSkelRedeemer
TxSkelRedeemer Redeemer
EmptyRedeemer Maybe TxOutRef
forall a. Maybe a
Nothing

-- Additional helper to specify a given reference input. As reference inputs are
-- automatically attached during transaction generation when they contain the
-- right scripts by default, there are only 3 cases where this can be useful:
-- - The reliance on a reference script needs to be made explicit
-- - A wrong reference script somehow needs to be attached
-- - The automated attachement of reference inputs has been disabled using the
-- `txOptAutoReferenceScripts` option

withReferenceInput :: TxSkelRedeemer -> Api.TxOutRef -> TxSkelRedeemer
withReferenceInput :: TxSkelRedeemer -> TxOutRef -> TxSkelRedeemer
withReferenceInput TxSkelRedeemer
red TxOutRef
ref = TxSkelRedeemer
red {txSkelReferenceInput = Just ref}