{-# OPTIONS_GHC -Wno-orphans #-}

-- | @since 1.3.0
module PlutusCore.Value.Orphans () where

import Data.ByteString (ByteString)
import Data.Maybe (fromJust, maybeToList)
import GHC.Exts (fromListN)
import PlutusCore.Builtin (BuiltinResult (BuiltinSuccess, BuiltinSuccessWithLogs))
import PlutusCore.Value qualified as PlutusCore
import Test.QuickCheck (
  Arbitrary (arbitrary, shrink),
  CoArbitrary (coarbitrary),
  Function (function),
  Gen,
  chooseInt,
  chooseInteger,
  functionMap,
  suchThatMap,
  vectorOf,
 )
import Test.QuickCheck.Instances ()

-- | @since 1.3.0
instance Arbitrary PlutusCore.K where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen K
arbitrary = Gen ByteString -> (ByteString -> Maybe K) -> Gen K
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap Gen ByteString
mkBoundedBS ByteString -> Maybe K
PlutusCore.k
  {-# INLINEABLE shrink #-}
  shrink :: K -> [K]
shrink K
k = do
    ByteString
bs' <- ByteString -> [ByteString]
forall a. Arbitrary a => a -> [a]
shrink (ByteString -> [ByteString])
-> (K -> ByteString) -> K -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. K -> ByteString
PlutusCore.unK (K -> [ByteString]) -> K -> [ByteString]
forall a b. (a -> b) -> a -> b
$ K
k
    Maybe K -> [K]
forall a. Maybe a -> [a]
maybeToList (Maybe K -> [K]) -> (ByteString -> Maybe K) -> ByteString -> [K]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe K
PlutusCore.k (ByteString -> [K]) -> ByteString -> [K]
forall a b. (a -> b) -> a -> b
$ ByteString
bs'

-- | @since 1.3.0
instance CoArbitrary PlutusCore.K where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. K -> Gen b -> Gen b
coarbitrary K
k = ByteString -> Gen b -> Gen b
forall b. ByteString -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (K -> ByteString
PlutusCore.unK K
k)

-- | @since 1.3.0
instance Function PlutusCore.K where
  {-# INLINEABLE function #-}
  -- Note (Koz, 08/04/2026): This is safe, as we can never get any input that
  -- isn't valid.
  function :: forall b. (K -> b) -> K :-> b
function = (K -> ByteString) -> (ByteString -> K) -> (K -> b) -> K :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap K -> ByteString
PlutusCore.unK (Maybe K -> K
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe K -> K) -> (ByteString -> Maybe K) -> ByteString -> K
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe K
PlutusCore.k)

-- | @since 1.3.0
instance Arbitrary PlutusCore.Quantity where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Quantity
arbitrary =
    Gen Integer -> (Integer -> Maybe Quantity) -> Gen Quantity
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap
      ((Integer, Integer) -> Gen Integer
chooseInteger (-(Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
127 :: Integer)), Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
127 :: Integer) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1))
      Integer -> Maybe Quantity
PlutusCore.quantity
  {-# INLINEABLE shrink #-}
  shrink :: Quantity -> [Quantity]
shrink Quantity
q = do
    Integer
i' <- Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink (Integer -> [Integer])
-> (Quantity -> Integer) -> Quantity -> [Integer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> Integer
PlutusCore.unQuantity (Quantity -> [Integer]) -> Quantity -> [Integer]
forall a b. (a -> b) -> a -> b
$ Quantity
q
    Maybe Quantity -> [Quantity]
forall a. Maybe a -> [a]
maybeToList (Maybe Quantity -> [Quantity])
-> (Integer -> Maybe Quantity) -> Integer -> [Quantity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Quantity
PlutusCore.quantity (Integer -> [Quantity]) -> Integer -> [Quantity]
forall a b. (a -> b) -> a -> b
$ Integer
i'

-- | @since 1.3.0
instance CoArbitrary PlutusCore.Quantity where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Quantity -> Gen b -> Gen b
coarbitrary Quantity
q = Integer -> Gen b -> Gen b
forall b. Integer -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Quantity -> Integer
PlutusCore.unQuantity Quantity
q)

-- | @since 1.3.0
instance Function PlutusCore.Quantity where
  {-# INLINEABLE function #-}
  function :: forall b. (Quantity -> b) -> Quantity :-> b
function = (Quantity -> Integer)
-> (Integer -> Quantity) -> (Quantity -> b) -> Quantity :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Quantity -> Integer
PlutusCore.unQuantity (Maybe Quantity -> Quantity
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Quantity -> Quantity)
-> (Integer -> Maybe Quantity) -> Integer -> Quantity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Quantity
PlutusCore.quantity)

-- | @since 1.3.0
instance Arbitrary PlutusCore.Value where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen Value
arbitrary = Gen [(K, [(K, Quantity)])]
-> ([(K, [(K, Quantity)])] -> Maybe Value) -> Gen Value
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap Gen [(K, [(K, Quantity)])]
forall a. Arbitrary a => Gen a
arbitrary (BuiltinResult Value -> Maybe Value
fromResult (BuiltinResult Value -> Maybe Value)
-> ([(K, [(K, Quantity)])] -> BuiltinResult Value)
-> [(K, [(K, Quantity)])]
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(K, [(K, Quantity)])] -> BuiltinResult Value
PlutusCore.fromList)
  {-# INLINEABLE shrink #-}
  shrink :: Value -> [Value]
shrink Value
v = do
    let asList :: [(K, [(K, Quantity)])]
asList = Value -> [(K, [(K, Quantity)])]
PlutusCore.toList Value
v
    [(K, [(K, Quantity)])]
asList' <- [(K, [(K, Quantity)])] -> [[(K, [(K, Quantity)])]]
forall a. Arbitrary a => a -> [a]
shrink [(K, [(K, Quantity)])]
asList
    Maybe Value -> [Value]
forall a. Maybe a -> [a]
maybeToList (Maybe Value -> [Value])
-> ([(K, [(K, Quantity)])] -> Maybe Value)
-> [(K, [(K, Quantity)])]
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinResult Value -> Maybe Value
fromResult (BuiltinResult Value -> Maybe Value)
-> ([(K, [(K, Quantity)])] -> BuiltinResult Value)
-> [(K, [(K, Quantity)])]
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(K, [(K, Quantity)])] -> BuiltinResult Value
PlutusCore.fromList ([(K, [(K, Quantity)])] -> [Value])
-> [(K, [(K, Quantity)])] -> [Value]
forall a b. (a -> b) -> a -> b
$ [(K, [(K, Quantity)])]
asList'

-- | @since 1.3.0
instance CoArbitrary PlutusCore.Value where
  {-# INLINEABLE coarbitrary #-}
  coarbitrary :: forall b. Value -> Gen b -> Gen b
coarbitrary Value
x = [(K, [(K, Quantity)])] -> Gen b -> Gen b
forall b. [(K, [(K, Quantity)])] -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary (Value -> [(K, [(K, Quantity)])]
PlutusCore.toList Value
x)

-- | @since 1.3.0
instance Function PlutusCore.Value where
  {-# INLINEABLE function #-}
  function :: forall b. (Value -> b) -> Value :-> b
function = (Value -> [(K, [(K, Quantity)])])
-> ([(K, [(K, Quantity)])] -> Value) -> (Value -> b) -> Value :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
functionMap Value -> [(K, [(K, Quantity)])]
PlutusCore.toList (Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Value -> Value)
-> ([(K, [(K, Quantity)])] -> Maybe Value)
-> [(K, [(K, Quantity)])]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinResult Value -> Maybe Value
fromResult (BuiltinResult Value -> Maybe Value)
-> ([(K, [(K, Quantity)])] -> BuiltinResult Value)
-> [(K, [(K, Quantity)])]
-> Maybe Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(K, [(K, Quantity)])] -> BuiltinResult Value
PlutusCore.fromList)

-- Helpers

mkBoundedBS :: Gen ByteString
mkBoundedBS :: Gen ByteString
mkBoundedBS = do
  Int
len <- (Int, Int) -> Gen Int
chooseInt (Int
0, Int
32)
  [Word8]
bytes <- Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
len Gen Word8
forall a. Arbitrary a => Gen a
arbitrary
  ByteString -> Gen ByteString
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> Gen ByteString)
-> ([Word8] -> ByteString) -> [Word8] -> Gen ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Item ByteString] -> ByteString
forall l. IsList l => Int -> [Item l] -> l
fromListN Int
len ([Word8] -> Gen ByteString) -> [Word8] -> Gen ByteString
forall a b. (a -> b) -> a -> b
$ [Word8]
bytes

fromResult :: BuiltinResult PlutusCore.Value -> Maybe PlutusCore.Value
fromResult :: BuiltinResult Value -> Maybe Value
fromResult = \case
  BuiltinSuccess Value
x -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x
  BuiltinSuccessWithLogs DList Text
_ Value
x -> Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x
  BuiltinResult Value
_ -> Maybe Value
forall a. Maybe a
Nothing