add all agora types

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
+  ]

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

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

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

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)
 
 --------------------------------------------------------------------------------
 

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)
 
 --------------------------------------------------------------------------------
 

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

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.