{-# OPTIONS_GHC -Wno-orphans #-}

{- FIXME: All of the following instances and
   types ought to belong in either plutarch or
   plutarch-extra.

   A number of these have been "stolen" from Mango's
   PR: https://github.com/Plutonomicon/plutarch/pull/438/
-}

module Agora.Plutarch.Orphans () where

import Control.Arrow (first)
import Plutarch.Api.V1 (PAddress, PCredential, PCurrencySymbol, PDatumHash, PMap, PMaybeData, PPOSIXTime, PPubKeyHash, PStakingCredential, PTokenName, PTxId, PTxOutRef, PValidatorHash, PValue)
import Plutarch.Builtin (PBuiltinMap)
import Plutarch.DataRepr (PIsDataReprInstances (..))
import Plutarch.Numeric.Additive (AdditiveSemigroup ((+)))
import Plutarch.Reducible (Reduce, Reducible)
import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
import Plutarch.Unsafe (punsafeCoerce)
import Prelude hiding ((+))

instance Reducible (f x y) => Reducible (Flip f y x) where
  type Reduce (Flip f y x) = Reduce (f x y)

newtype Flip f a b = Flip (f b a)

-- | @since 0.1.0
instance PTryFrom PData (PAsData b) => PTryFrom PData (PAsData (DerivePNewtype c b)) where
  type
    PTryFromExcess PData (PAsData (DerivePNewtype c b)) =
      PTryFromExcess PData (PAsData b)
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData (DerivePNewtype c b)),
     Reduce
       @Type (PTryFromExcess PData (PAsData (DerivePNewtype c b)) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
d (Term s (PAsData (DerivePNewtype c b)),
 Reduce
   @Type (PTryFromExcess PData (PAsData (DerivePNewtype c b)) s))
-> Term s r
k =
    forall (a :: PType) (b :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce @Type (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom' @_ @(PAsData b) Term s PData
d (((Term s (PAsData b),
   Reduce @Type (PTryFromExcess PData (PAsData b) s))
  -> Term s r)
 -> Term s r)
-> ((Term s (PAsData b),
     Reduce @Type (PTryFromExcess PData (PAsData b) s))
    -> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ (Term s (PAsData (DerivePNewtype c b)),
 Reduce @Type (PTryFromExcess PData (PAsData b) s))
-> Term s r
(Term s (PAsData (DerivePNewtype c b)),
 Reduce
   @Type (PTryFromExcess PData (PAsData (DerivePNewtype c b)) s))
-> Term s r
k ((Term s (PAsData (DerivePNewtype c b)),
  Reduce @Type (PTryFromExcess PData (PAsData b) s))
 -> Term s r)
-> ((Term s (PAsData b),
     Reduce @Type (PTryFromExcess PData (PAsData b) s))
    -> (Term s (PAsData (DerivePNewtype c b)),
        Reduce @Type (PTryFromExcess PData (PAsData b) s)))
-> (Term s (PAsData b),
    Reduce @Type (PTryFromExcess PData (PAsData b) s))
-> Term s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Term s (PAsData b) -> Term s (PAsData (DerivePNewtype c b)))
-> (Term s (PAsData b),
    Reduce @Type (PTryFromExcess PData (PAsData b) s))
-> (Term s (PAsData (DerivePNewtype c b)),
    Reduce @Type (PTryFromExcess PData (PAsData b) s))
forall (a :: Type -> Type -> Type) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Term s (PAsData b) -> Term s (PAsData (DerivePNewtype c b))
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce

-- | @since 0.1.0
instance PTryFrom PData (PAsData PPubKeyHash) where
  type PTryFromExcess PData (PAsData PPubKeyHash) = Flip Term PPubKeyHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PPubKeyHash),
     Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = TermCont
  @r
  s
  (Term s (PAsData PPubKeyHash),
   Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
-> ((Term s (PAsData PPubKeyHash),
     Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
    -> Term s r)
-> Term s r
forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont (TermCont
   @r
   s
   (Term s (PAsData PPubKeyHash),
    Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
 -> ((Term s (PAsData PPubKeyHash),
      Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
     -> Term s r)
 -> Term s r)
-> TermCont
     @r
     s
     (Term s (PAsData PPubKeyHash),
      Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
-> ((Term s (PAsData PPubKeyHash),
     Reduce @Type (PTryFromExcess PData (PAsData PPubKeyHash) s))
    -> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ do
    (Term s (PAsData (PByteString @S))
wrapped :: Term _ (PAsData PByteString), Term s (PByteString @S)
unwrapped :: Term _ PByteString) <-
      (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
  -> Term s r)
 -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont ((((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
   -> Term s r)
  -> Term s r)
 -> TermCont
      @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S)))
-> (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
     -> Term s r)
    -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce @Type (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq
    ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont (((() -> Term s r) -> Term s r) -> TermCont @r s ())
-> ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f -> Term s PBool -> Term s r -> Term s r -> Term s r
forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s (PByteString @S :--> PInteger @S)
forall (s :: S). Term s (PByteString @S :--> PInteger @S)
plengthBS Term s (PByteString @S :--> PInteger @S)
-> Term s (PByteString @S) -> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PByteString @S)
unwrapped Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s (PInteger @S)
28) (() -> Term s r
f ()) (Term s (PString @S) -> Term s r
forall (s :: S) (a :: PType). Term s (PString @S) -> Term s a
ptraceError Term s (PString @S)
"a PubKeyHash should be 28 bytes long")
    (Term s (PAsData PPubKeyHash), Term s PPubKeyHash)
-> TermCont @r s (Term s (PAsData PPubKeyHash), Term s PPubKeyHash)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s (PAsData (PByteString @S)) -> Term s (PAsData PPubKeyHash)
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PAsData (PByteString @S))
wrapped, Term s (PByteString @S) -> Term s PPubKeyHash
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PByteString @S)
unwrapped)

-- | @since 0.1.0
instance AdditiveSemigroup (Term s PPOSIXTime) where
  (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce @_ @_ @PInteger -> Term s (PInteger @S)
x) + :: Term s PPOSIXTime -> Term s PPOSIXTime -> Term s PPOSIXTime
+ (forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce @_ @_ @PInteger -> Term s (PInteger @S)
y) = Term s (PInteger @S) -> Term s PPOSIXTime
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce (Term s (PInteger @S) -> Term s PPOSIXTime)
-> Term s (PInteger @S) -> Term s PPOSIXTime
forall a b. (a -> b) -> a -> b
$ Term s (PInteger @S)
x Term s (PInteger @S)
-> Term s (PInteger @S) -> Term s (PInteger @S)
forall a. AdditiveSemigroup a => a -> a -> a
+ Term s (PInteger @S)
y

-- | @since 0.1.0
deriving via
  PAsData (DerivePNewtype PPOSIXTime PInteger)
  instance
    PTryFrom PData (PAsData PPOSIXTime)

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances PTxId)
  instance
    PTryFrom PData (PAsData PTxId)

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances PTxOutRef)
  instance
    PTryFrom PData (PAsData PTxOutRef)

-- | @since 0.1.0
deriving via
  PAsData (DerivePNewtype (PMap g k v) (PBuiltinMap k v))
  instance
    ( PTryFrom PData (PAsData k)
    , PTryFrom PData (PAsData v)
    ) =>
    PTryFrom PData (PAsData (PMap g k v))

-- | @since 0.1.0
instance PTryFrom PData (PAsData PValidatorHash) where
  type PTryFromExcess PData (PAsData PValidatorHash) = Flip Term PValidatorHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PValidatorHash),
     Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = TermCont
  @r
  s
  (Term s (PAsData PValidatorHash),
   Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
-> ((Term s (PAsData PValidatorHash),
     Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
    -> Term s r)
-> Term s r
forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont (TermCont
   @r
   s
   (Term s (PAsData PValidatorHash),
    Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
 -> ((Term s (PAsData PValidatorHash),
      Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
     -> Term s r)
 -> Term s r)
-> TermCont
     @r
     s
     (Term s (PAsData PValidatorHash),
      Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
-> ((Term s (PAsData PValidatorHash),
     Reduce @Type (PTryFromExcess PData (PAsData PValidatorHash) s))
    -> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ do
    (Term s (PAsData (PByteString @S))
wrapped :: Term _ (PAsData PByteString), Term s (PByteString @S)
unwrapped :: Term _ PByteString) <-
      (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
  -> Term s r)
 -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont ((((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
   -> Term s r)
  -> Term s r)
 -> TermCont
      @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S)))
-> (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
     -> Term s r)
    -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce @Type (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq
    ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont (((() -> Term s r) -> Term s r) -> TermCont @r s ())
-> ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f -> Term s PBool -> Term s r -> Term s r -> Term s r
forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s (PByteString @S :--> PInteger @S)
forall (s :: S). Term s (PByteString @S :--> PInteger @S)
plengthBS Term s (PByteString @S :--> PInteger @S)
-> Term s (PByteString @S) -> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PByteString @S)
unwrapped Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s (PInteger @S)
28) (() -> Term s r
f ()) (Term s (PString @S) -> Term s r
forall (s :: S) (a :: PType). Term s (PString @S) -> Term s a
ptraceError Term s (PString @S)
"a ValidatorHash should be 28 bytes long")
    (Term s (PAsData PValidatorHash), Term s PValidatorHash)
-> TermCont
     @r s (Term s (PAsData PValidatorHash), Term s PValidatorHash)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s (PAsData (PByteString @S))
-> Term s (PAsData PValidatorHash)
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PAsData (PByteString @S))
wrapped, Term s (PByteString @S) -> Term s PValidatorHash
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PByteString @S)
unwrapped)

-- | @since 0.1.0
instance PTryFrom PData (PAsData PDatumHash) where
  type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
  ptryFrom' :: forall (s :: S) (r :: PType).
Term s PData
-> ((Term s (PAsData PDatumHash),
     Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
    -> Term s r)
-> Term s r
ptryFrom' Term s PData
opq = TermCont
  @r
  s
  (Term s (PAsData PDatumHash),
   Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
-> ((Term s (PAsData PDatumHash),
     Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
    -> Term s r)
-> Term s r
forall (r :: PType) (s :: S) a.
TermCont @r s a -> (a -> Term s r) -> Term s r
runTermCont (TermCont
   @r
   s
   (Term s (PAsData PDatumHash),
    Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
 -> ((Term s (PAsData PDatumHash),
      Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
     -> Term s r)
 -> Term s r)
-> TermCont
     @r
     s
     (Term s (PAsData PDatumHash),
      Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
-> ((Term s (PAsData PDatumHash),
     Reduce @Type (PTryFromExcess PData (PAsData PDatumHash) s))
    -> Term s r)
-> Term s r
forall a b. (a -> b) -> a -> b
$ do
    (Term s (PAsData (PByteString @S))
wrapped :: Term _ (PAsData PByteString), Term s (PByteString @S)
unwrapped :: Term _ PByteString) <-
      (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
  -> Term s r)
 -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont ((((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
   -> Term s r)
  -> Term s r)
 -> TermCont
      @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S)))
-> (((Term s (PAsData (PByteString @S)), Term s (PByteString @S))
     -> Term s r)
    -> Term s r)
-> TermCont
     @r s (Term s (PAsData (PByteString @S)), Term s (PByteString @S))
forall a b. (a -> b) -> a -> b
$ forall (b :: PType) (a :: PType) (s :: S) (r :: PType).
PTryFrom a b =>
Term s a
-> ((Term s b, Reduce @Type (PTryFromExcess a b s)) -> Term s r)
-> Term s r
ptryFrom @(PAsData PByteString) Term s PData
opq
    ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a (s :: S) (r :: PType).
((a -> Term s r) -> Term s r) -> TermCont @r s a
tcont (((() -> Term s r) -> Term s r) -> TermCont @r s ())
-> ((() -> Term s r) -> Term s r) -> TermCont @r s ()
forall a b. (a -> b) -> a -> b
$ \() -> Term s r
f -> Term s PBool -> Term s r -> Term s r -> Term s r
forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif (Term s (PByteString @S :--> PInteger @S)
forall (s :: S). Term s (PByteString @S :--> PInteger @S)
plengthBS Term s (PByteString @S :--> PInteger @S)
-> Term s (PByteString @S) -> Term s (PInteger @S)
forall (s :: S) (a :: PType) (b :: PType).
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PByteString @S)
unwrapped Term s (PInteger @S) -> Term s (PInteger @S) -> Term s PBool
forall (t :: PType) (s :: S).
PEq t =>
Term s t -> Term s t -> Term s PBool
#== Term s (PInteger @S)
32) (() -> Term s r
f ()) (Term s (PString @S) -> Term s r
forall (s :: S) (a :: PType). Term s (PString @S) -> Term s a
ptraceError Term s (PString @S)
"a DatumHash should be 32 bytes long")
    (Term s (PAsData PDatumHash), Term s PDatumHash)
-> TermCont @r s (Term s (PAsData PDatumHash), Term s PDatumHash)
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Term s (PAsData (PByteString @S)) -> Term s (PAsData PDatumHash)
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PAsData (PByteString @S))
wrapped, Term s (PByteString @S) -> Term s PDatumHash
forall (s :: S) (a :: PType) (b :: PType). Term s a -> Term s b
punsafeCoerce Term s (PByteString @S)
unwrapped)

-- | @since 0.1.0
deriving via
  PAsData (DerivePNewtype PCurrencySymbol PByteString)
  instance
    PTryFrom PData (PAsData PCurrencySymbol)

-- | @since 0.1.0
deriving via
  PAsData (DerivePNewtype PTokenName PByteString)
  instance
    PTryFrom PData (PAsData PTokenName)

-- | @since 0.1.0
deriving via
  PAsData (DerivePNewtype (PValue k v) (PMap k PCurrencySymbol (PMap k PTokenName PInteger)))
  instance
    PTryFrom PData (PAsData (PValue k v))

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances (PMaybeData a))
  instance
    PTryFrom PData (PAsData a) => PTryFrom PData (PAsData (PMaybeData a))

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances PAddress)
  instance
    PTryFrom PData (PAsData PAddress)

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances PCredential)
  instance
    PTryFrom PData (PAsData PCredential)

-- | @since 0.1.0
deriving via
  PAsData (PIsDataReprInstances PStakingCredential)
  instance
    PTryFrom PData (PAsData PStakingCredential)