{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Plutarch.Api.V1.Maybe (
  PMaybeData (PDJust, PDNothing),
) where

import Plutarch.Builtin (pasConstr, pforgetData)
import Plutarch.DataRepr.Internal (
  DerivePConstantViaData (DerivePConstantViaData),
 )
import Plutarch.Lift (
  PConstantDecl (PConstanted),
  PUnsafeLiftDecl (..),
 )
import Plutarch.Prelude
import Plutarch.Unsafe (punsafeCoerce)

-- | Data encoded Maybe type. Used in various ledger api types.
data PMaybeData a (s :: S)
  = PDJust (Term s (PDataRecord '["_0" ':= a]))
  | PDNothing (Term s (PDataRecord '[]))
  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 (PMaybeData a s) x -> PMaybeData a s
forall (a :: PType) (s :: S) x.
PMaybeData a s -> Rep (PMaybeData a s) x
$cto :: forall (a :: PType) (s :: S) x.
Rep (PMaybeData a s) x -> PMaybeData a s
$cfrom :: forall (a :: PType) (s :: S) x.
PMaybeData a s -> Rep (PMaybeData 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).
PMaybeData a s -> Term s (PInner (PMaybeData a))
forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PMaybeData a))
-> (PMaybeData a s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner (PMaybeData a))
-> (PMaybeData a s -> Term s b) -> Term s b
$cpmatch' :: forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PMaybeData a))
-> (PMaybeData a s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PMaybeData a s -> Term s (PInner (PMaybeData a))
$cpcon' :: forall (a :: PType) (s :: S).
PMaybeData a s -> Term s (PInner (PMaybeData a))
PlutusType, forall (a :: PType).
(forall (s :: S). Term s (PAsData a) -> Term s a)
-> (forall (s :: S). Term s a -> Term s PData) -> PIsData a
forall (a :: PType) (s :: S).
Term s (PAsData (PMaybeData a)) -> Term s (PMaybeData a)
forall (a :: PType) (s :: S). Term s (PMaybeData a) -> Term s PData
pdataImpl :: forall (s :: S). Term s (PMaybeData a) -> Term s PData
$cpdataImpl :: forall (a :: PType) (s :: S). Term s (PMaybeData a) -> Term s PData
pfromDataImpl :: forall (s :: S).
Term s (PAsData (PMaybeData a)) -> Term s (PMaybeData a)
$cpfromDataImpl :: forall (a :: PType) (s :: S).
Term s (PAsData (PMaybeData a)) -> Term s (PMaybeData a)
PIsData, forall (t :: PType).
(forall (s :: S). Term s t -> Term s t -> Term s PBool) -> PEq t
forall (a :: PType) (s :: S).
Term s (PMaybeData a) -> Term s (PMaybeData a) -> Term s PBool
#== :: forall (s :: S).
Term s (PMaybeData a) -> Term s (PMaybeData a) -> Term s PBool
$c#== :: forall (a :: PType) (s :: S).
Term s (PMaybeData a) -> Term s (PMaybeData a) -> Term s PBool
PEq, forall (a :: PType) (s :: S).
(PIsData a, PShow a) =>
Bool -> Term s (PMaybeData 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 (PMaybeData a) -> Term s PString
$cpshow' :: forall (a :: PType) (s :: S).
(PIsData a, PShow a) =>
Bool -> Term s (PMaybeData a) -> Term s PString
PShow)

instance DerivePlutusType (PMaybeData a) where type DPTStrat _ = PlutusTypeData
instance PTryFrom PData a => PTryFrom PData (PMaybeData a)
instance PTryFrom PData a => PTryFrom PData (PAsData (PMaybeData a))

instance PLiftData a => PUnsafeLiftDecl (PMaybeData a) where
  type PLifted (PMaybeData a) = Maybe (PLifted a)

deriving via
  (DerivePConstantViaData (Maybe a) (PMaybeData (PConstanted a)))
  instance
    PConstantData a => PConstantDecl (Maybe a)

-- Have to manually write this instance because the constructor id ordering is screwed for 'Maybe'....
instance (PIsData a, POrd a) => PPartialOrd (PMaybeData a) where
  Term s (PMaybeData a)
x #< :: forall (s :: S).
Term s (PMaybeData a) -> Term s (PMaybeData a) -> Term s PBool
#< Term s (PMaybeData a)
y = forall (a :: PType) (s :: S).
Bool
-> (forall (s :: S) (rec_ :: [PLabeledType]).
    ((rec_ :: [PLabeledType])
     ~ ((':)
          @PLabeledType
          ("_0" ':= a)
          ('[] @PLabeledType) :: [PLabeledType])) =>
    Term s (PDataRecord rec_)
    -> Term s (PDataRecord rec_) -> Term s PBool)
-> Term s (PMaybeData a :--> (PMaybeData a :--> PBool))
_pmaybeLT Bool
False forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
(#<) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMaybeData a)
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMaybeData a)
y
  Term s (PMaybeData a)
x #<= :: forall (s :: S).
Term s (PMaybeData a) -> Term s (PMaybeData a) -> Term s PBool
#<= Term s (PMaybeData a)
y = forall (a :: PType) (s :: S).
Bool
-> (forall (s :: S) (rec_ :: [PLabeledType]).
    ((rec_ :: [PLabeledType])
     ~ ((':)
          @PLabeledType
          ("_0" ':= a)
          ('[] @PLabeledType) :: [PLabeledType])) =>
    Term s (PDataRecord rec_)
    -> Term s (PDataRecord rec_) -> Term s PBool)
-> Term s (PMaybeData a :--> (PMaybeData a :--> PBool))
_pmaybeLT Bool
True forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
(#<=) forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMaybeData a)
x forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PMaybeData a)
y

instance (PIsData a, POrd a) => POrd (PMaybeData a)

_pmaybeLT ::
  Bool ->
  ( forall s rec_.
    rec_ ~ '["_0" ':= a] =>
    Term s (PDataRecord rec_) ->
    Term s (PDataRecord rec_) ->
    Term s PBool
  ) ->
  Term s (PMaybeData a :--> PMaybeData a :--> PBool)
_pmaybeLT :: forall (a :: PType) (s :: S).
Bool
-> (forall (s :: S) (rec_ :: [PLabeledType]).
    ((rec_ :: [PLabeledType])
     ~ ((':)
          @PLabeledType
          ("_0" ':= a)
          ('[] @PLabeledType) :: [PLabeledType])) =>
    Term s (PDataRecord rec_)
    -> Term s (PDataRecord rec_) -> Term s PBool)
-> Term s (PMaybeData a :--> (PMaybeData a :--> PBool))
_pmaybeLT Bool
whenBothNothing forall (s :: S) (rec_ :: [PLabeledType]).
((rec_ :: [PLabeledType])
 ~ ((':)
      @PLabeledType
      ("_0" ':= a)
      ('[] @PLabeledType) :: [PLabeledType])) =>
Term s (PDataRecord rec_)
-> Term s (PDataRecord rec_) -> Term s PBool
ltF = 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 (PMaybeData a)
x Term s (PMaybeData a)
y -> forall (a :: PType) (s :: S). TermCont @a s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
    Term s (PBuiltinPair PInteger (PBuiltinList PData))
a <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S).
Term s (PData :--> PBuiltinPair PInteger (PBuiltinList PData))
pasConstr forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S) (a :: PType). Term s (PAsData a) -> Term s PData
pforgetData forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata Term s (PMaybeData a)
x
    Term s (PBuiltinPair PInteger (PBuiltinList PData))
b <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S).
Term s (PData :--> PBuiltinPair PInteger (PBuiltinList PData))
pasConstr forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
#$ forall (s :: S) (a :: PType). Term s (PAsData a) -> Term s PData
pforgetData forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S).
PIsData a =>
Term s a -> Term s (PAsData a)
pdata Term s (PMaybeData a)
y

    Term s PInteger
cid1 <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
a
    Term s PInteger
cid2 <- forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> a)
pfstBuiltin forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
b

    forall (f :: Type -> Type) a. Applicative f => a -> f a
pure
      forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
        (Term s PInteger
cid1 forall (t :: PType) (s :: S).
PPartialOrd t =>
Term s t -> Term s t -> Term s PBool
#< Term s PInteger
cid2)
        (forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
False)
      forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
        (Term s PInteger
cid1 forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
cid2)
        {- Some hand optimization here: usually, the fields would be 'plet'ed here if using 'POrd' derivation
          machinery. However, in this case - there's no need for the fields for the 'Nothing' case.

          Would be nice if this could be done on the auto derivation case....
        -}
        ( forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif
            (Term s PInteger
cid1 forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s PInteger
0)
            (forall (s :: S) (rec_ :: [PLabeledType]).
((rec_ :: [PLabeledType])
 ~ ((':)
      @PLabeledType
      ("_0" ':= a)
      ('[] @PLabeledType) :: [PLabeledType])) =>
Term s (PDataRecord rec_)
-> Term s (PDataRecord rec_) -> Term s PBool
ltF (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
a) (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce forall a b. (a -> b) -> a -> b
$ forall (s :: S) (a :: PType) (b :: PType).
Term s (PBuiltinPair a b :--> b)
psndBuiltin forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PBuiltinPair PInteger (PBuiltinList PData))
b))
            -- Both are 'Nothing'. Let caller choose answer.
            forall a b. (a -> b) -> a -> b
$ forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
whenBothNothing
        )
      forall a b. (a -> b) -> a -> b
$ forall (p :: PType) (s :: S). PLift p => PLifted p -> Term s p
pconstant Bool
True