{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE KindSignatures     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}

module PlutusTx.Blueprint.Parameter where

import Prelude

import Data.Aeson (ToJSON (..), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Extra (buildObject, optionalField, requiredField)
import Data.Kind (Type)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import PlutusTx.Blueprint.Purpose (Purpose)
import PlutusTx.Blueprint.Schema (Schema)

{- | Blueprint that defines validator's compile-time parameter.

  The 'referencedTypes' phantom type parameter is used to track the types used in the contract
  making sure their schemas are included in the blueprint and that they are referenced
  in a type-safe way.
-}
data ParameterBlueprint (referencedTypes :: [Type]) = MkParameterBlueprint
  { forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Maybe Text
parameterTitle       :: Maybe Text
  -- ^ A short and descriptive name for the parameter.
  , forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Maybe Text
parameterDescription :: Maybe Text
  -- ^ An informative description of the parameter.
  , forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Set Purpose
parameterPurpose     :: Set Purpose
  -- ^ One of "spend", "mint", "withdraw" or "publish", or a oneOf applicator of those.
  , forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Schema referencedTypes
parameterSchema      :: Schema referencedTypes
  -- ^ A Plutus Data Schema.
  }
  deriving stock (Int -> ParameterBlueprint referencedTypes -> ShowS
[ParameterBlueprint referencedTypes] -> ShowS
ParameterBlueprint referencedTypes -> String
(Int -> ParameterBlueprint referencedTypes -> ShowS)
-> (ParameterBlueprint referencedTypes -> String)
-> ([ParameterBlueprint referencedTypes] -> ShowS)
-> Show (ParameterBlueprint referencedTypes)
forall (referencedTypes :: [*]).
Int -> ParameterBlueprint referencedTypes -> ShowS
forall (referencedTypes :: [*]).
[ParameterBlueprint referencedTypes] -> ShowS
forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall (referencedTypes :: [*]).
Int -> ParameterBlueprint referencedTypes -> ShowS
showsPrec :: Int -> ParameterBlueprint referencedTypes -> ShowS
$cshow :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> String
show :: ParameterBlueprint referencedTypes -> String
$cshowList :: forall (referencedTypes :: [*]).
[ParameterBlueprint referencedTypes] -> ShowS
showList :: [ParameterBlueprint referencedTypes] -> ShowS
Show, ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
(ParameterBlueprint referencedTypes
 -> ParameterBlueprint referencedTypes -> Bool)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes -> Bool)
-> Eq (ParameterBlueprint referencedTypes)
forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
== :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
$c/= :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
/= :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
Eq, Eq (ParameterBlueprint referencedTypes)
Eq (ParameterBlueprint referencedTypes) =>
(ParameterBlueprint referencedTypes
 -> ParameterBlueprint referencedTypes -> Ordering)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes -> Bool)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes -> Bool)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes -> Bool)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes -> Bool)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes)
-> (ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes
    -> ParameterBlueprint referencedTypes)
-> Ord (ParameterBlueprint referencedTypes)
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Ordering
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
forall (referencedTypes :: [*]).
Eq (ParameterBlueprint referencedTypes)
forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Ordering
forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
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 :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Ordering
compare :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Ordering
$c< :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
< :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
$c<= :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
<= :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
$c> :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
> :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
$c>= :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
>= :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes -> Bool
$cmax :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
max :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
$cmin :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
min :: ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
-> ParameterBlueprint referencedTypes
Ord)

instance ToJSON (ParameterBlueprint referencedTypes) where
  toJSON :: ParameterBlueprint referencedTypes -> Value
toJSON MkParameterBlueprint{Maybe Text
Set Purpose
Schema referencedTypes
parameterTitle :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Maybe Text
parameterDescription :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Maybe Text
parameterPurpose :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Set Purpose
parameterSchema :: forall (referencedTypes :: [*]).
ParameterBlueprint referencedTypes -> Schema referencedTypes
parameterTitle :: Maybe Text
parameterDescription :: Maybe Text
parameterPurpose :: Set Purpose
parameterSchema :: Schema referencedTypes
..} =
    (Object -> Object) -> Value
buildObject ((Object -> Object) -> Value) -> (Object -> Object) -> Value
forall a b. (a -> b) -> a -> b
$
      Key -> Schema referencedTypes -> Object -> Object
forall a. ToJSON a => Key -> a -> Object -> Object
requiredField Key
"schema" Schema referencedTypes
parameterSchema
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Text -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"title" Maybe Text
parameterTitle
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Text -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"description" Maybe Text
parameterDescription
        (Object -> Object) -> (Object -> Object) -> Object -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Maybe Value -> Object -> Object
forall a. ToJSON a => Key -> Maybe a -> Object -> Object
optionalField Key
"purpose" (Set Purpose -> Maybe Value
forall a. ToJSON a => Set a -> Maybe Value
oneOfASet Set Purpose
parameterPurpose)

----------------------------------------------------------------------------------------------------
-- Helper functions --------------------------------------------------------------------------------

oneOfASet :: (ToJSON a) => Set a -> Maybe Aeson.Value
oneOfASet :: forall a. ToJSON a => Set a -> Maybe Value
oneOfASet Set a
s =
  case Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
s of
    []  -> Maybe Value
forall a. Maybe a
Nothing
    [a
x] -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x
    [a]
xs  -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Aeson.object [Key
"oneOf" Key -> [a] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [a]
xs]