-- |
-- Module: Covenant.Constant
-- Copyright: (C) MLabs 2025
-- License: Apache 2.0
-- Maintainer: koz@mlabs.city, sean@mlabs.city
--
-- Representation of Plutus constants in Covenant.
--
-- @since 1.0.0
module Covenant.Constant
  ( -- * Types
    AConstant (..),

    -- * Functions
    typeConstant,
  )
where

import Covenant.Internal.Type
  ( BuiltinFlatT (BoolT, ByteStringT, IntegerT, StringT, UnitT),
    ValT (BuiltinFlat),
  )
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.Text (Text)
import Test.QuickCheck
  ( Arbitrary (arbitrary, shrink),
    oneof,
  )
import Test.QuickCheck.Instances.ByteString ()
import Test.QuickCheck.Instances.Text ()
import Test.QuickCheck.Instances.Vector ()

-- | A Plutus constant term.
--
-- @since 1.0.0
data AConstant
  = AUnit
  | ABoolean Bool
  | AnInteger Integer
  | AByteString ByteString
  | AString Text
  deriving stock
    ( -- | @since 1.0.0
      AConstant -> AConstant -> Bool
(AConstant -> AConstant -> Bool)
-> (AConstant -> AConstant -> Bool) -> Eq AConstant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AConstant -> AConstant -> Bool
== :: AConstant -> AConstant -> Bool
$c/= :: AConstant -> AConstant -> Bool
/= :: AConstant -> AConstant -> Bool
Eq,
      -- | @since 1.0.0
      Eq AConstant
Eq AConstant =>
(AConstant -> AConstant -> Ordering)
-> (AConstant -> AConstant -> Bool)
-> (AConstant -> AConstant -> Bool)
-> (AConstant -> AConstant -> Bool)
-> (AConstant -> AConstant -> Bool)
-> (AConstant -> AConstant -> AConstant)
-> (AConstant -> AConstant -> AConstant)
-> Ord AConstant
AConstant -> AConstant -> Bool
AConstant -> AConstant -> Ordering
AConstant -> AConstant -> AConstant
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AConstant -> AConstant -> Ordering
compare :: AConstant -> AConstant -> Ordering
$c< :: AConstant -> AConstant -> Bool
< :: AConstant -> AConstant -> Bool
$c<= :: AConstant -> AConstant -> Bool
<= :: AConstant -> AConstant -> Bool
$c> :: AConstant -> AConstant -> Bool
> :: AConstant -> AConstant -> Bool
$c>= :: AConstant -> AConstant -> Bool
>= :: AConstant -> AConstant -> Bool
$cmax :: AConstant -> AConstant -> AConstant
max :: AConstant -> AConstant -> AConstant
$cmin :: AConstant -> AConstant -> AConstant
min :: AConstant -> AConstant -> AConstant
Ord,
      -- | @since 1.0.0
      Int -> AConstant -> ShowS
[AConstant] -> ShowS
AConstant -> String
(Int -> AConstant -> ShowS)
-> (AConstant -> String)
-> ([AConstant] -> ShowS)
-> Show AConstant
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AConstant -> ShowS
showsPrec :: Int -> AConstant -> ShowS
$cshow :: AConstant -> String
show :: AConstant -> String
$cshowList :: [AConstant] -> ShowS
showList :: [AConstant] -> ShowS
Show
    )

-- | @since 1.0.0
instance Arbitrary AConstant where
  {-# INLINEABLE arbitrary #-}
  arbitrary :: Gen AConstant
arbitrary =
    [Gen AConstant] -> Gen AConstant
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ AConstant -> Gen AConstant
forall a. a -> Gen a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure AConstant
AUnit,
        Bool -> AConstant
ABoolean (Bool -> AConstant) -> Gen Bool -> Gen AConstant
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary,
        Integer -> AConstant
AnInteger (Integer -> AConstant) -> Gen Integer -> Gen AConstant
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Integer
forall a. Arbitrary a => Gen a
arbitrary,
        ByteString -> AConstant
AByteString (ByteString -> AConstant) -> Gen ByteString -> Gen AConstant
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ByteString
forall a. Arbitrary a => Gen a
arbitrary,
        Text -> AConstant
AString (Text -> AConstant) -> Gen Text -> Gen AConstant
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
      ]
  {-# INLINEABLE shrink #-}
  shrink :: AConstant -> [AConstant]
shrink = \case
    AConstant
AUnit -> []
    ABoolean Bool
b -> Bool -> AConstant
ABoolean (Bool -> AConstant) -> [Bool] -> [AConstant]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink Bool
b
    AnInteger Integer
i -> Integer -> AConstant
AnInteger (Integer -> AConstant) -> [Integer] -> [AConstant]
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
    AByteString ByteString
bs -> ByteString -> AConstant
AByteString (ByteString -> AConstant) -> [ByteString] -> [AConstant]
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
    AString Text
t -> Text -> AConstant
AString (Text -> AConstant) -> [Text] -> [AConstant]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
forall a. Arbitrary a => a -> [a]
shrink Text
t

-- | Produce the type of a given constant.
--
-- @since 1.0.0
typeConstant ::
  forall (a :: Type).
  AConstant -> ValT a
typeConstant :: forall a. AConstant -> ValT a
typeConstant =
  BuiltinFlatT -> ValT a
forall a. BuiltinFlatT -> ValT a
BuiltinFlat (BuiltinFlatT -> ValT a)
-> (AConstant -> BuiltinFlatT) -> AConstant -> ValT a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    AConstant
AUnit -> BuiltinFlatT
UnitT
    ABoolean Bool
_ -> BuiltinFlatT
BoolT
    AnInteger Integer
_ -> BuiltinFlatT
IntegerT
    AByteString ByteString
_ -> BuiltinFlatT
ByteStringT
    AString Text
_ -> BuiltinFlatT
StringT