{-# OPTIONS_GHC -Wno-orphans #-}

-- Note on Function instances
--
-- In many cases, we have hand-rolled instances of Function that merely delegate
-- to an inner type for a newtype. While in theory, this should be
-- via-derivable, because Function relies on an opaque type which we can't
-- coerce through, we have to do this by hand.

-- | QuickCheck orphans (plus a few helpers) for V2 Plutus ledger API types.
module PlutusLedgerApi.V2.Orphans (
  Value.NonAdaValue (..),
  Value.getNonAdaValue,
  Value.UTxOValue (..),
  Value.getUtxoValue,
  Value.FeeValue (..),
  Value.getFeeValue,
) where

import Data.ByteString (ByteString)
import Data.Coerce (coerce)
import PlutusCore.Data qualified as PLC
import PlutusLedgerApi.V1.Orphans.Address ()
import PlutusLedgerApi.V1.Orphans.Credential ()
import PlutusLedgerApi.V1.Orphans.DCert ()
import PlutusLedgerApi.V1.Orphans.Interval ()
import PlutusLedgerApi.V1.Orphans.Scripts ()
import PlutusLedgerApi.V1.Orphans.Time ()
import PlutusLedgerApi.V1.Orphans.Tx ()
import PlutusLedgerApi.V1.Orphans.Value ()
import PlutusLedgerApi.V1.Orphans.Value qualified as Value
import PlutusLedgerApi.V2 qualified as PLA
import PlutusLedgerApi.V2.Orphans.Contexts ()
import PlutusLedgerApi.V2.Orphans.Tx ()
import PlutusTx.Prelude qualified as PlutusTx
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  Arbitrary1 (liftArbitrary),
  CoArbitrary (coarbitrary),
  Function (function),
  Gen,
  NonNegative (NonNegative),
  functionMap,
  getNonNegative,
  oneof,
  resize,
  sized,
  variant,
 )
import Test.QuickCheck.Instances.ByteString ()

-- | @since 1.0.0
deriving via PlutusTx.BuiltinByteString instance Arbitrary PLA.LedgerBytes

-- | @since 1.0.0
deriving via PlutusTx.BuiltinByteString instance CoArbitrary PLA.LedgerBytes

-- | @since 1.0.0
instance Function PLA.LedgerBytes where
  {-# INLINEABLE function #-}
  function :: forall b. (LedgerBytes -> b) -> LedgerBytes :-> b
function = (LedgerBytes -> BuiltinByteString)
-> (BuiltinByteString -> LedgerBytes)
-> (LedgerBytes -> b)
-> LedgerBytes :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap LedgerBytes -> BuiltinByteString
forall a b. Coercible a b => a -> b
coerce BuiltinByteString -> LedgerBytes
PLA.LedgerBytes

-- | @since 1.0.0
instance Arbitrary PLA.ScriptContext where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen ScriptContext
arbitrary = TxInfo -> ScriptPurpose -> ScriptContext
PLA.ScriptContext (TxInfo -> ScriptPurpose -> ScriptContext)
-> Gen TxInfo -> Gen (ScriptPurpose -> ScriptContext)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxInfo
forall a. Arbitrary a => Gen a
arbitrary Gen (ScriptPurpose -> ScriptContext)
-> Gen ScriptPurpose -> Gen ScriptContext
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 ScriptPurpose
forall a. Arbitrary a => Gen a
arbitrary
  {-# INLINEABLE shrink #-}
  shrink :: ScriptContext -> [ScriptContext]
shrink (PLA.ScriptContext TxInfo
txi ScriptPurpose
purpose) = TxInfo -> ScriptPurpose -> ScriptContext
PLA.ScriptContext (TxInfo -> ScriptPurpose -> ScriptContext)
-> [TxInfo] -> [ScriptPurpose -> ScriptContext]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TxInfo -> [TxInfo]
forall a. Arbitrary a => a -> [a]
shrink TxInfo
txi [ScriptPurpose -> ScriptContext]
-> [ScriptPurpose] -> [ScriptContext]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> ScriptPurpose -> [ScriptPurpose]
forall a. Arbitrary a => a -> [a]
shrink ScriptPurpose
purpose

-- | @since 1.0.0
instance CoArbitrary PLA.ScriptContext where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. ScriptContext -> Gen b -> Gen b
coarbitrary (PLA.ScriptContext TxInfo
txi ScriptPurpose
purpose) =
    TxInfo -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. TxInfo -> Gen b -> Gen b
coarbitrary TxInfo
txi (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScriptPurpose -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
forall b. ScriptPurpose -> Gen b -> Gen b
coarbitrary ScriptPurpose
purpose

-- | @since 1.0.0
instance Function PLA.ScriptContext where
  {-# INLINEABLE function #-}
  function :: forall b. (ScriptContext -> b) -> ScriptContext :-> b
function = (ScriptContext -> (TxInfo, ScriptPurpose))
-> ((TxInfo, ScriptPurpose) -> ScriptContext)
-> (ScriptContext -> b)
-> ScriptContext :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap (\(PLA.ScriptContext TxInfo
txi ScriptPurpose
purpose) -> (TxInfo
txi, ScriptPurpose
purpose)) ((TxInfo -> ScriptPurpose -> ScriptContext)
-> (TxInfo, ScriptPurpose) -> ScriptContext
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry TxInfo -> ScriptPurpose -> ScriptContext
PLA.ScriptContext)

{- | This is a very general instance, able to produce 'PLC.Data' of basically
any shape. You probably want something more focused than this.

@since 1.0.0
-}
instance Arbitrary PLC.Data where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Data
arbitrary = (Int -> Gen Data) -> Gen Data
forall a. (Int -> Gen a) -> Gen a
sized ((Int -> Gen Data) -> Gen Data) -> (Int -> Gen Data) -> Gen Data
forall a b. (a -> b) -> a -> b
$ \Int
originalSize -> Int -> Int -> Gen Data
go Int
originalSize Int
originalSize
    where
      -- We have to track our original size (for contents) as well as a
      -- possibly-reduced size (for structure) separately. If we don't do this,
      -- 'leaf' data may end up being far smaller than it should be, biasing the
      -- generator.
      go :: Int -> Int -> Gen PLC.Data
      go :: Int -> Int -> Gen Data
go Int
originalSize Int
currentSize
        | Int
currentSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof [Int -> Gen Data
genB Int
originalSize, Int -> Gen Data
genI Int
originalSize]
        | Bool
otherwise =
            [Gen Data] -> Gen Data
forall a. HasCallStack => [Gen a] -> Gen a
oneof
              [ Int -> Gen Data
genB Int
originalSize
              , Int -> Gen Data
genI Int
originalSize
              , Int -> Int -> Gen Data
genConstr Int
originalSize Int
currentSize
              , Int -> Int -> Gen Data
genList Int
originalSize Int
currentSize
              , Int -> Int -> Gen Data
genMap Int
originalSize Int
currentSize
              ]
      genB :: Int -> Gen PLA.Data
      genB :: Int -> Gen Data
genB Int
size = ByteString -> Data
PLC.B (ByteString -> Data) -> Gen ByteString -> Gen Data
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString -> Gen ByteString
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
size Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary
      genI :: Int -> Gen PLA.Data
      genI :: Int -> Gen Data
genI Int
size = Integer -> Data
PLC.I (Integer -> Data) -> Gen Integer -> Gen Data
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Integer -> Gen Integer
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
size Gen Integer
forall a. Arbitrary a => Gen a
arbitrary
      genConstr :: Int -> Int -> Gen PLA.Data
      genConstr :: Int -> Int -> Gen Data
genConstr Int
contentSize Int
structureSize =
        Integer -> [Data] -> Data
PLA.Constr
          (Integer -> [Data] -> Data) -> Gen Integer -> Gen ([Data] -> Data)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Integer -> Gen Integer
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
contentSize (NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative (NonNegative Integer -> Integer)
-> Gen (NonNegative Integer) -> Gen Integer
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonNegative Integer)
forall a. Arbitrary a => Gen a
arbitrary)
          Gen ([Data] -> Data) -> Gen [Data] -> Gen Data
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
<*> Int -> Gen [Data] -> Gen [Data]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
structureSize (Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen Data -> Gen [Data]) -> (Int -> Gen Data) -> Int -> Gen [Data]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Gen Data
go Int
contentSize (Int -> Gen [Data]) -> Int -> Gen [Data]
forall a b. (a -> b) -> a -> b
$ Int
structureSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
      genList :: Int -> Int -> Gen PLA.Data
      genList :: Int -> Int -> Gen Data
genList Int
contentSize Int
structureSize =
        [Data] -> Data
PLA.List ([Data] -> Data) -> Gen [Data] -> Gen Data
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Data] -> Gen [Data]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize Int
structureSize (Gen Data -> Gen [Data]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen Data -> Gen [Data]) -> (Int -> Gen Data) -> Int -> Gen [Data]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Gen Data
go Int
contentSize (Int -> Gen [Data]) -> Int -> Gen [Data]
forall a b. (a -> b) -> a -> b
$ Int
structureSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
      genMap :: Int -> Int -> Gen PLA.Data
      genMap :: Int -> Int -> Gen Data
genMap Int
contentSize Int
structureSize = do
        let newStructureSize :: Int
newStructureSize = Int
structureSize Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2
        [(Data, Data)] -> Data
PLA.Map
          ([(Data, Data)] -> Data) -> Gen [(Data, Data)] -> Gen Data
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [(Data, Data)] -> Gen [(Data, Data)]
forall a. HasCallStack => Int -> Gen a -> Gen a
resize
            Int
structureSize
            ( Gen (Data, Data) -> Gen [(Data, Data)]
forall a. Gen a -> Gen [a]
forall (f :: Type -> Type) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary (Gen (Data, Data) -> Gen [(Data, Data)])
-> Gen (Data, Data) -> Gen [(Data, Data)]
forall a b. (a -> b) -> a -> b
$
                (,)
                  (Data -> Data -> (Data, Data))
-> Gen Data -> Gen (Data -> (Data, Data))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Gen Data
go Int
contentSize Int
newStructureSize
                  Gen (Data -> (Data, Data)) -> Gen Data -> Gen (Data, Data)
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
<*> Int -> Int -> Gen Data
go Int
contentSize Int
newStructureSize
            )
  {-# INLINEABLE shrink #-}
  shrink :: Data -> [Data]
shrink = \case
    PLC.I Integer
i -> Integer -> Data
PLC.I (Integer -> Data) -> [Integer] -> [Data]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
i
    PLC.B ByteString
bs -> ByteString -> Data
PLC.B (ByteString -> Data) -> [ByteString] -> [Data]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> [ByteString]
forall a. Arbitrary a => a -> [a]
shrink ByteString
bs
    PLC.Constr Integer
ix [Data]
dats ->
      Integer -> [Data] -> Data
PLC.Constr
        (Integer -> [Data] -> Data) -> [Integer] -> [[Data] -> Data]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ((NonNegative Integer -> Integer)
-> [NonNegative Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap NonNegative Integer -> Integer
forall a. NonNegative a -> a
getNonNegative ([NonNegative Integer] -> [Integer])
-> (Integer -> [NonNegative Integer]) -> Integer -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Integer -> [NonNegative Integer]
forall a. Arbitrary a => a -> [a]
shrink (NonNegative Integer -> [NonNegative Integer])
-> (Integer -> NonNegative Integer)
-> Integer
-> [NonNegative Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> NonNegative Integer
forall a. a -> NonNegative a
NonNegative (Integer -> [Integer]) -> Integer -> [Integer]
forall a b. (a -> b) -> a -> b
$ Integer
ix)
        [[Data] -> Data] -> [[Data]] -> [Data]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> [Data] -> [[Data]]
forall a. Arbitrary a => a -> [a]
shrink [Data]
dats
    PLC.List [Data]
ell -> [Data] -> Data
PLC.List ([Data] -> Data) -> [[Data]] -> [Data]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data] -> [[Data]]
forall a. Arbitrary a => a -> [a]
shrink [Data]
ell
    PLC.Map [(Data, Data)]
kvs -> [(Data, Data)] -> Data
PLC.Map ([(Data, Data)] -> Data) -> [[(Data, Data)]] -> [Data]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Data, Data)] -> [[(Data, Data)]]
forall a. Arbitrary a => a -> [a]
shrink [(Data, Data)]
kvs

-- | @since 1.0.0
instance CoArbitrary PLC.Data where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Data -> Gen b -> Gen b
coarbitrary = \case
    PLC.I Integer
i -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
0 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
i
    PLC.B ByteString
bs -> 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
. ByteString -> Gen b -> Gen b
forall b. ByteString -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary ByteString
bs
    PLC.Constr Integer
ix [Data]
dats -> 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
. Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Integer
ix (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Data] -> Gen b -> Gen b
forall b. [Data] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [Data]
dats
    PLC.List [Data]
ell -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
3 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Data] -> Gen b -> Gen b
forall b. [Data] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [Data]
ell
    PLC.Map [(Data, Data)]
kvs -> Int -> Gen b -> Gen b
forall n a. Integral n => n -> Gen a -> Gen a
variant (Int
4 :: Int) (Gen b -> Gen b) -> (Gen b -> Gen b) -> Gen b -> Gen b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Data, Data)] -> Gen b -> Gen b
forall b. [(Data, Data)] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary [(Data, Data)]
kvs

-- | @since 1.0.0
instance Function PLC.Data where
  {-# INLINEABLE function #-}
  function :: forall b. (Data -> b) -> Data :-> b
function = (Data
 -> Either
      Integer
      (Either
         ByteString
         (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))))
-> (Either
      Integer
      (Either
         ByteString
         (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
    -> Data)
-> (Data -> b)
-> Data :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Data
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
into Either
  Integer
  (Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
-> Data
outOf
    where
      into ::
        PLC.Data ->
        Either
          Integer
          ( Either
              ByteString
              ( Either
                  (Integer, [PLA.Data])
                  ( Either [PLA.Data] [(PLA.Data, PLA.Data)]
                  )
              )
          )
      into :: Data
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
into = \case
        PLC.I Integer
i -> Integer
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
forall a b. a -> Either a b
Left Integer
i
        PLC.B ByteString
bs -> Either
  ByteString
  (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
forall a b. b -> Either a b
Right (ByteString
-> Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
forall a b. a -> Either a b
Left ByteString
bs)
        PLC.Constr Integer
ix [Data]
dats -> Either
  ByteString
  (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
forall a b. b -> Either a b
Right (Either (Integer, [Data]) (Either [Data] [(Data, Data)])
-> Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
forall a b. b -> Either a b
Right ((Integer, [Data])
-> Either (Integer, [Data]) (Either [Data] [(Data, Data)])
forall a b. a -> Either a b
Left (Integer
ix, [Data]
dats)))
        PLC.List [Data]
ell -> Either
  ByteString
  (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
forall a b. b -> Either a b
Right (Either (Integer, [Data]) (Either [Data] [(Data, Data)])
-> Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
forall a b. b -> Either a b
Right (Either [Data] [(Data, Data)]
-> Either (Integer, [Data]) (Either [Data] [(Data, Data)])
forall a b. b -> Either a b
Right ([Data] -> Either [Data] [(Data, Data)]
forall a b. a -> Either a b
Left [Data]
ell)))
        PLC.Map [(Data, Data)]
kvs -> Either
  ByteString
  (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
-> Either
     Integer
     (Either
        ByteString
        (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
forall a b. b -> Either a b
Right (Either (Integer, [Data]) (Either [Data] [(Data, Data)])
-> Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)]))
forall a b. b -> Either a b
Right (Either [Data] [(Data, Data)]
-> Either (Integer, [Data]) (Either [Data] [(Data, Data)])
forall a b. b -> Either a b
Right ([(Data, Data)] -> Either [Data] [(Data, Data)]
forall a b. b -> Either a b
Right [(Data, Data)]
kvs)))
      outOf ::
        Either
          Integer
          ( Either
              ByteString
              ( Either
                  (Integer, [PLA.Data])
                  ( Either [PLA.Data] [(PLA.Data, PLA.Data)]
                  )
              )
          ) ->
        PLA.Data
      outOf :: Either
  Integer
  (Either
     ByteString
     (Either (Integer, [Data]) (Either [Data] [(Data, Data)])))
-> Data
outOf = \case
        Left Integer
i -> Integer -> Data
PLC.I Integer
i
        Right (Left ByteString
bs) -> ByteString -> Data
PLC.B ByteString
bs
        Right (Right (Left (Integer
ix, [Data]
dats))) -> Integer -> [Data] -> Data
PLC.Constr Integer
ix [Data]
dats
        Right (Right (Right (Left [Data]
ell))) -> [Data] -> Data
PLC.List [Data]
ell
        Right (Right (Right (Right [(Data, Data)]
kvs))) -> [(Data, Data)] -> Data
PLC.Map [(Data, Data)]
kvs