{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE TemplateHaskell    #-}

module PlutusTx.Blueprint.Preamble where

import Prelude

import Data.Aeson (Options (..), defaultOptions)
import Data.Aeson.Extra (stripPrefix)
import Data.Aeson.TH (deriveToJSON)
import Data.Text (Text)
import GHC.Generics (Generic)
import PlutusTx.Blueprint.PlutusVersion (PlutusVersion)

-- | Meta-information about the contract
data Preamble = MkPreamble
  { Preamble -> Text
preambleTitle         :: Text
  -- ^ A short and descriptive title of the contract application
  , Preamble -> Maybe Text
preambleDescription   :: Maybe Text
  -- ^ A more elaborate description
  , Preamble -> Text
preambleVersion       :: Text
  -- ^ A version number for the project.
  , Preamble -> PlutusVersion
preamblePlutusVersion :: PlutusVersion
  -- ^ The Plutus version assumed for all validators
  , Preamble -> Maybe Text
preambleLicense       :: Maybe Text
  -- ^ A license under which the specification
  -- and contract code is distributed
  }
  deriving stock (Int -> Preamble -> ShowS
[Preamble] -> ShowS
Preamble -> String
(Int -> Preamble -> ShowS)
-> (Preamble -> String) -> ([Preamble] -> ShowS) -> Show Preamble
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Preamble -> ShowS
showsPrec :: Int -> Preamble -> ShowS
$cshow :: Preamble -> String
show :: Preamble -> String
$cshowList :: [Preamble] -> ShowS
showList :: [Preamble] -> ShowS
Show, (forall x. Preamble -> Rep Preamble x)
-> (forall x. Rep Preamble x -> Preamble) -> Generic Preamble
forall x. Rep Preamble x -> Preamble
forall x. Preamble -> Rep Preamble x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Preamble -> Rep Preamble x
from :: forall x. Preamble -> Rep Preamble x
$cto :: forall x. Rep Preamble x -> Preamble
to :: forall x. Rep Preamble x -> Preamble
Generic)

$(deriveToJSON defaultOptions{fieldLabelModifier = stripPrefix "preamble"} ''Preamble)