From 538e809d2c97cbb3def2334abcc0742c3c69a3a0 Mon Sep 17 00:00:00 2001 From: fanghr Date: Fri, 13 May 2022 20:03:17 +0800 Subject: [PATCH] add all agora types --- agora-purescript-bridge/AgoraTypes.hs | 51 +++++++++++++++++++++++++++ agora-purescript-bridge/Bridge.hs | 26 +++++++++++++- agora-purescript-bridge/Options.hs | 51 +++++++++++++++++++++++++++ agora.cabal | 4 +++ agora/Agora/AuthorityToken.hs | 10 ++++-- agora/Agora/Governor.hs | 4 +++ agora/Agora/Proposal.hs | 4 +-- agora/Agora/Stake.hs | 2 +- 8 files changed, 145 insertions(+), 7 deletions(-) create mode 100644 agora-purescript-bridge/AgoraTypes.hs create mode 100644 agora-purescript-bridge/Options.hs diff --git a/agora-purescript-bridge/AgoraTypes.hs b/agora-purescript-bridge/AgoraTypes.hs new file mode 100644 index 0000000..e56d4d8 --- /dev/null +++ b/agora-purescript-bridge/AgoraTypes.hs @@ -0,0 +1,51 @@ +module AgoraTypes (agoraTypes) where + +-------------------------------------------------------------------------------- + +import Language.PureScript.Bridge ( + Language (Haskell), + SumType, + mkSumType, + ) + +-------------------------------------------------------------------------------- + +import Agora.AuthorityToken qualified as AuthorityToken +import Agora.Effect.TreasuryWithdrawal qualified as TreasuryWithdrawalEffect +import Agora.Governor qualified as Governor +import Agora.MultiSig qualified as MultiSig +import Agora.Proposal qualified as Proposal +import Agora.Stake qualified as Stake +import Agora.Treasury qualified as Treasury + +-------------------------------------------------------------------------------- + +agoraTypes :: [SumType 'Haskell] +agoraTypes = + [ -- Proposal + mkSumType @Proposal.ProposalId + , mkSumType @Proposal.ResultTag + , mkSumType @Proposal.ProposalStatus + , mkSumType @Proposal.ProposalThresholds + , mkSumType @Proposal.ProposalVotes + , mkSumType @Proposal.ProposalDatum + , mkSumType @Proposal.ProposalRedeemer + , mkSumType @Proposal.Proposal + , -- Governor + mkSumType @Governor.GovernorDatum + , mkSumType @Governor.GovernorRedeemer + , mkSumType @Governor.Governor + , -- MultiSig + mkSumType @MultiSig.MultiSig + , -- Stake + mkSumType @Stake.Stake + , mkSumType @Stake.ProposalLock + , mkSumType @Stake.StakeRedeemer + , mkSumType @Stake.StakeDatum + , -- Treasury + mkSumType @Treasury.TreasuryRedeemer + , -- AuthorityToken + mkSumType @AuthorityToken.AuthorityToken + , -- Effects + mkSumType @TreasuryWithdrawalEffect.TreasuryWithdrawalDatum + ] diff --git a/agora-purescript-bridge/Bridge.hs b/agora-purescript-bridge/Bridge.hs index c8dbf9f..686d21a 100644 --- a/agora-purescript-bridge/Bridge.hs +++ b/agora-purescript-bridge/Bridge.hs @@ -1,4 +1,28 @@ module Main (main) where +import Language.PureScript.Bridge ( + buildBridge, + defaultBridge, + writePSTypes, + ) + +-------------------------------------------------------------------------------- + +import Control.Monad (unless) + +-------------------------------------------------------------------------------- + +import AgoraTypes (agoraTypes) +import Options (Options (..), parseOptions) + +-------------------------------------------------------------------------------- + main :: IO () -main = return () +main = do + options <- parseOptions + + unless options.quiet $ do + putStrLn $ "Writing purescript stuff to " <> options.output + putStrLn "" + + writePSTypes options.output (buildBridge defaultBridge) agoraTypes diff --git a/agora-purescript-bridge/Options.hs b/agora-purescript-bridge/Options.hs new file mode 100644 index 0000000..cd1d1cc --- /dev/null +++ b/agora-purescript-bridge/Options.hs @@ -0,0 +1,51 @@ +module Options (Options (..), parseOptions) where + +import Options.Applicative ((<**>)) +import Options.Applicative qualified as Opt + +import Data.Maybe (fromJust) +import Path (fromRelDir, parseRelDir, ()) + +data Options = Options + { output :: FilePath + , quiet :: Bool + } + +outputOpt :: Opt.Parser FilePath +outputOpt = + srcFilePath + <$> ( Opt.strOption $ + Opt.long "output-path" + <> Opt.short 'o' + <> Opt.metavar "OUTPUT_PATH" + <> Opt.value "./" + <> Opt.help "Output purescripts will be in OUTPUT_PATH/src" + ) + +quietOpt :: Opt.Parser Bool +quietOpt = + Opt.switch $ + Opt.long "quiet" + <> Opt.short 'q' + <> Opt.help "Disable verbose log messages" + +bridgeOpt :: Opt.Parser Options +bridgeOpt = Options <$> outputOpt <*> quietOpt + +parseOptions :: IO Options +parseOptions = Opt.execParser p + where + p = + Opt.info + (bridgeOpt <**> Opt.helper) + ( Opt.fullDesc + <> Opt.progDesc "Generate purescript types of Agora types" + ) + +-- Give a directory path, return the path of its src subdirectory. +srcFilePath :: FilePath -> FilePath +srcFilePath path = fromRelDir $ + fromJust $ do + dir <- parseRelDir $ path + srcSubDir <- parseRelDir "src" + return $ dir srcSubDir diff --git a/agora.cabal b/agora.cabal index c8c4b5c..e5fd3b6 100644 --- a/agora.cabal +++ b/agora.cabal @@ -207,6 +207,10 @@ executable agora-purescript-bridge build-depends: , agora , optparse-applicative + , path , purescript-bridge hs-source-dirs: agora-purescript-bridge + other-modules: + AgoraTypes + Options diff --git a/agora/Agora/AuthorityToken.hs b/agora/Agora/AuthorityToken.hs index 4e286e2..cac8869 100644 --- a/agora/Agora/AuthorityToken.hs +++ b/agora/Agora/AuthorityToken.hs @@ -11,6 +11,8 @@ module Agora.AuthorityToken ( AuthorityToken (..), ) where +-------------------------------------------------------------------------------- + import Plutarch.Api.V1 ( PAddress (..), PCredential (..), @@ -25,8 +27,11 @@ import Plutarch.Api.V1.AssocMap (PMap (PMap)) import Plutarch.Api.V1.Value (PValue (PValue)) import Plutarch.Builtin (pforgetData) import Plutus.V1.Ledger.Value (AssetClass (AssetClass)) +import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) -import Prelude +-------------------------------------------------------------------------------- + +import GHC.Generics qualified as GHC -------------------------------------------------------------------------------- @@ -38,7 +43,6 @@ import Agora.Utils ( tcassert, tcmatch, ) -import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) -------------------------------------------------------------------------------- @@ -51,7 +55,7 @@ import Plutarch.Api.V1.Extra (passetClass, passetClassValueOf) newtype AuthorityToken = AuthorityToken { authority :: AssetClass -- ^ Token that must move in order for minting this to be valid. - } + } deriving stock (GHC.Generic) -------------------------------------------------------------------------------- diff --git a/agora/Agora/Governor.hs b/agora/Agora/Governor.hs index d2923e6..bf35726 100644 --- a/agora/Agora/Governor.hs +++ b/agora/Agora/Governor.hs @@ -21,6 +21,7 @@ module Agora.Governor ( ) where import Agora.Proposal (ProposalId, ProposalThresholds) +import GHC.Generics qualified as GHC import Plutarch.Api.V1 (PMintingPolicy, PValidator) import PlutusTx qualified @@ -31,6 +32,7 @@ data GovernorDatum = GovernorDatum , nextProposalId :: ProposalId -- ^ What tag the next proposal will get upon creating. } + deriving stock (GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorDatum [('GovernorDatum, 0)] @@ -46,12 +48,14 @@ data GovernorRedeemer | -- | Checks that a SINGLE proposal finished correctly, -- and allows minting GATs for each effect script. MintGATs + deriving stock (GHC.Generic) PlutusTx.makeIsDataIndexed ''GovernorRedeemer [('CreateProposal, 0), ('MintGATs, 1)] -- | Parameters for creating Governor scripts. data Governor = Governor + deriving stock (GHC.Generic) -------------------------------------------------------------------------------- diff --git a/agora/Agora/Proposal.hs b/agora/Agora/Proposal.hs index 494d206..b0f0bb0 100644 --- a/agora/Agora/Proposal.hs +++ b/agora/Agora/Proposal.hs @@ -82,7 +82,7 @@ newtype ProposalId = ProposalId {proposalTag :: Integer} @ -} newtype ResultTag = ResultTag {getResultTag :: Integer} - deriving stock (Eq, Show, Ord) + deriving stock (Eq, Show, Ord, GHC.Generic) deriving newtype (PlutusTx.ToData, PlutusTx.FromData, PlutusTx.UnsafeFromData) {- | The "status" of the proposal. This is only useful for state transitions that @@ -247,7 +247,7 @@ data Proposal = Proposal , maximumCosigners :: Integer -- ^ Arbitrary limit for maximum amount of cosigners on a proposal. } - deriving stock (Show, Eq) + deriving stock (Show, Eq, GHC.Generic) -------------------------------------------------------------------------------- -- Plutarch-land diff --git a/agora/Agora/Stake.hs b/agora/Agora/Stake.hs index 2ce89d7..351eab6 100644 --- a/agora/Agora/Stake.hs +++ b/agora/Agora/Stake.hs @@ -81,7 +81,7 @@ data Stake = Stake { gtClassRef :: Tagged GTTag AssetClass -- ^ Used when inlining the AssetClass of a 'PDiscrete' in the script code. , proposalSTClass :: AssetClass - } + } deriving stock (GHC.Generic) {- | A lock placed on a Stake datum in order to prevent depositing and withdrawing when votes are in place.