{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusLedgerApi.V2.Orphans.Tx () where

import PlutusLedgerApi.V1.Orphans.Address ()
import PlutusLedgerApi.V1.Orphans.Scripts ()
import PlutusLedgerApi.V1.Orphans.Value qualified as Value
import PlutusLedgerApi.V2 qualified as PLA
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  functionMap,
  oneof,
  variant,
 )

-- | @since 1.0.0
instance Arbitrary PLA.OutputDatum where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen OutputDatum
arbitrary =
    [Gen OutputDatum] -> Gen OutputDatum
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ OutputDatum -> Gen OutputDatum
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure OutputDatum
PLA.NoOutputDatum
      , DatumHash -> OutputDatum
PLA.OutputDatumHash (DatumHash -> OutputDatum) -> Gen DatumHash -> Gen OutputDatum
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen DatumHash
forall a. Arbitrary a => Gen a
arbitrary
      , Datum -> OutputDatum
PLA.OutputDatum (Datum -> OutputDatum) -> Gen Datum -> Gen OutputDatum
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Datum
forall a. Arbitrary a => Gen a
arbitrary
      ]
  {-# INLINEABLE shrink #-}
  -- We only shrink the OutputDatum case, since the others wouldn't shrink
  -- anyway.
  shrink :: OutputDatum -> [OutputDatum]
shrink = \case
    PLA.OutputDatum Datum
d -> Datum -> OutputDatum
PLA.OutputDatum (Datum -> OutputDatum) -> [Datum] -> [OutputDatum]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Datum -> [Datum]
forall a. Arbitrary a => a -> [a]
shrink Datum
d
    OutputDatum
_ -> []

-- | @since 1.0.0
instance CoArbitrary PLA.OutputDatum where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. OutputDatum -> Gen b -> Gen b
coarbitrary = \case
    OutputDatum
PLA.NoOutputDatum -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int)
    PLA.OutputDatumHash DatumHash
dh -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
1 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DatumHash -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. DatumHash -> Gen b -> Gen b
coarbitrary DatumHash
dh
    PLA.OutputDatum Datum
d -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
2 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Datum -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Datum -> Gen b -> Gen b
coarbitrary Datum
d

-- | @since 1.0.0
instance Function PLA.OutputDatum where
  {-# INLINEABLE function #-}
  function :: forall b. (OutputDatum -> b) -> OutputDatum :-> b
function = (OutputDatum -> Maybe (Either DatumHash Datum))
-> (Maybe (Either DatumHash Datum) -> OutputDatum)
-> (OutputDatum -> b)
-> OutputDatum :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap OutputDatum -> Maybe (Either DatumHash Datum)
into Maybe (Either DatumHash Datum) -> OutputDatum
outOf
    where
      into :: PLA.OutputDatum -> Maybe (Either PLA.DatumHash PLA.Datum)
      into :: OutputDatum -> Maybe (Either DatumHash Datum)
into = \case
        OutputDatum
PLA.NoOutputDatum -> Maybe (Either DatumHash Datum)
forall a. Maybe a
Nothing
        PLA.OutputDatumHash DatumHash
dh -> Either DatumHash Datum -> Maybe (Either DatumHash Datum)
forall a. a -> Maybe a
Just (DatumHash -> Either DatumHash Datum
forall a b. a -> Either a b
Left DatumHash
dh)
        PLA.OutputDatum Datum
d -> Either DatumHash Datum -> Maybe (Either DatumHash Datum)
forall a. a -> Maybe a
Just (Datum -> Either DatumHash Datum
forall a b. b -> Either a b
Right Datum
d)
      outOf :: Maybe (Either PLA.DatumHash PLA.Datum) -> PLA.OutputDatum
      outOf :: Maybe (Either DatumHash Datum) -> OutputDatum
outOf = \case
        Maybe (Either DatumHash Datum)
Nothing -> OutputDatum
PLA.NoOutputDatum
        Just (Left DatumHash
dh) -> DatumHash -> OutputDatum
PLA.OutputDatumHash DatumHash
dh
        Just (Right Datum
d) -> Datum -> OutputDatum
PLA.OutputDatum Datum
d

-- | @since 1.0.0
instance Arbitrary PLA.TxOut where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen TxOut
arbitrary =
    Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PLA.TxOut
      (Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut)
-> Gen Address
-> Gen (Value -> OutputDatum -> Maybe ScriptHash -> TxOut)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Address
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Value -> OutputDatum -> Maybe ScriptHash -> TxOut)
-> Gen Value -> Gen (OutputDatum -> Maybe ScriptHash -> TxOut)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (UTxOValue -> Value
Value.getUtxoValue (UTxOValue -> Value) -> Gen UTxOValue -> Gen Value
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen UTxOValue
forall a. Arbitrary a => Gen a
arbitrary)
      Gen (OutputDatum -> Maybe ScriptHash -> TxOut)
-> Gen OutputDatum -> Gen (Maybe ScriptHash -> TxOut)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Gen OutputDatum
forall a. Arbitrary a => Gen a
arbitrary
      Gen (Maybe ScriptHash -> TxOut)
-> Gen (Maybe ScriptHash) -> Gen TxOut
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Gen (Maybe ScriptHash)
forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: TxOut -> [TxOut]
shrink (PLA.TxOut Address
addr Value
val OutputDatum
od Maybe ScriptHash
msh) =
    Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PLA.TxOut
      (Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut)
-> [Address] -> [Value -> OutputDatum -> Maybe ScriptHash -> TxOut]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Address -> [Address]
forall a. Arbitrary a => a -> [a]
shrink Address
addr
      [Value -> OutputDatum -> Maybe ScriptHash -> TxOut]
-> [Value] -> [OutputDatum -> Maybe ScriptHash -> TxOut]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> (UTxOValue -> Value
Value.getUtxoValue (UTxOValue -> Value) -> [UTxOValue] -> [Value]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> UTxOValue -> [UTxOValue]
forall a. Arbitrary a => a -> [a]
shrink (Value -> UTxOValue
Value.UTxOValue Value
val))
      [OutputDatum -> Maybe ScriptHash -> TxOut]
-> [OutputDatum] -> [Maybe ScriptHash -> TxOut]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> OutputDatum -> [OutputDatum]
forall a. Arbitrary a => a -> [a]
shrink OutputDatum
od
      [Maybe ScriptHash -> TxOut] -> [Maybe ScriptHash] -> [TxOut]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> Maybe ScriptHash -> [Maybe ScriptHash]
forall a. Arbitrary a => a -> [a]
shrink Maybe ScriptHash
msh

-- | @since 1.0.0
instance CoArbitrary PLA.TxOut where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. TxOut -> Gen b -> Gen b
coarbitrary (PLA.TxOut Address
addr Value
val OutputDatum
od Maybe ScriptHash
msh) =
    Address -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Address -> Gen b -> Gen b
coarbitrary Address
addr (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. Value -> Gen b -> Gen b
coarbitrary Value
val (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputDatum -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. OutputDatum -> Gen b -> Gen b
coarbitrary OutputDatum
od (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ScriptHash -> Gen b -> Gen b
forall b. Maybe ScriptHash -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Maybe ScriptHash
msh

-- | @since 1.0.0
instance Function PLA.TxOut where
  {-# INLINEABLE function #-}
  function :: forall b. (TxOut -> b) -> TxOut :-> b
function = (TxOut -> (Address, Value, OutputDatum, Maybe ScriptHash))
-> ((Address, Value, OutputDatum, Maybe ScriptHash) -> TxOut)
-> (TxOut -> b)
-> TxOut :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap TxOut -> (Address, Value, OutputDatum, Maybe ScriptHash)
into (Address, Value, OutputDatum, Maybe ScriptHash) -> TxOut
outOf
    where
      into ::
        PLA.TxOut ->
        (PLA.Address, PLA.Value, PLA.OutputDatum, Maybe PLA.ScriptHash)
      into :: TxOut -> (Address, Value, OutputDatum, Maybe ScriptHash)
into (PLA.TxOut Address
addr Value
val OutputDatum
od Maybe ScriptHash
msh) = (Address
addr, Value
val, OutputDatum
od, Maybe ScriptHash
msh)
      outOf ::
        (PLA.Address, PLA.Value, PLA.OutputDatum, Maybe PLA.ScriptHash) ->
        PLA.TxOut
      outOf :: (Address, Value, OutputDatum, Maybe ScriptHash) -> TxOut
outOf (Address
addr, Value
val, OutputDatum
od, Maybe ScriptHash
msh) = Address -> Value -> OutputDatum -> Maybe ScriptHash -> TxOut
PLA.TxOut Address
addr Value
val OutputDatum
od Maybe ScriptHash
msh