module Plutarch.Maybe (
  PMaybe (PJust, PNothing),
  pfromJust,
) where

import GHC.Generics (Generic)
import Plutarch (
  DPTStrat,
  DerivePlutusType,
  PType,
  PlutusType,
  PlutusTypeScott,
  S,
  Term,
  perror,
  phoistAcyclic,
  plam,
  pmatch,
  type (:-->),
 )
import Plutarch.Bool (PEq)
import Plutarch.Show (PShow)

-- | Plutus Maybe type, with Scott-encoded repr
data PMaybe (a :: PType) (s :: S)
  = PJust (Term s a)
  | PNothing
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: PType) (s :: S) x. Rep (PMaybe a s) x -> PMaybe a s
forall (a :: PType) (s :: S) x. PMaybe a s -> Rep (PMaybe a s) x
$cto :: forall (a :: PType) (s :: S) x. Rep (PMaybe a s) x -> PMaybe a s
$cfrom :: forall (a :: PType) (s :: S) x. PMaybe a s -> Rep (PMaybe a s) x
Generic)
  deriving anyclass (forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
forall (a :: PType) (s :: S).
PMaybe a s -> Term s (PInner (PMaybe a))
forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PMaybe a)) -> (PMaybe a s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner (PMaybe a)) -> (PMaybe a s -> Term s b) -> Term s b
$cpmatch' :: forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PMaybe a)) -> (PMaybe a s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PMaybe a s -> Term s (PInner (PMaybe a))
$cpcon' :: forall (a :: PType) (s :: S).
PMaybe a s -> Term s (PInner (PMaybe a))
PlutusType, forall (a :: PType) (s :: S).
PEq a =>
Term s (PMaybe a) -> Term s (PMaybe a) -> Term s PBool
forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
#== :: forall (s :: S).
Term s (PMaybe a) -> Term s (PMaybe a) -> Term s PBool
$c#== :: forall (a :: PType) (s :: S).
PEq a =>
Term s (PMaybe a) -> Term s (PMaybe a) -> Term s PBool
PEq, forall (a :: PType) (s :: S).
PShow a =>
Bool -> Term s (PMaybe a) -> Term s PString
forall (t :: PType).
(forall (s :: S). Bool -> Term s t -> Term s PString) -> PShow t
pshow' :: forall (s :: S). Bool -> Term s (PMaybe a) -> Term s PString
$cpshow' :: forall (a :: PType) (s :: S).
PShow a =>
Bool -> Term s (PMaybe a) -> Term s PString
PShow)

instance DerivePlutusType (PMaybe a) where type DPTStrat _ = PlutusTypeScott

{- |
 fallible unwrapping from @PMaybe@
-}
pfromJust :: Term s (PMaybe a :--> a)
pfromJust :: forall (s :: S) (a :: PType). Term s (PMaybe a :--> a)
pfromJust = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
  forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PMaybe a)
maybe -> forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s (PMaybe a)
maybe forall a b. (a -> b) -> a -> b
$ \case
    PMaybe a s
PNothing -> forall (s :: S) (a :: PType). Term s a
perror
    PJust Term s a
a -> Term s a
a