From 310be96487914dfaa8cff486f1a551a809a4aec7 Mon Sep 17 00:00:00 2001
From: Emily Martins <emi@haskell.fyi>
Date: Wed, 23 Mar 2022 22:03:11 +0100
Subject: [PATCH] improve ergonomics and add documentation

---
 agora-test/Spec/Stake.hs | 22 +++++------
 agora-test/Spec/Util.hs  | 79 ++++++++++++++++++++++++++++++++++++----
 agora/Agora/SafeMoney.hs |  3 +-
 3 files changed, 82 insertions(+), 22 deletions(-)

diff --git a/agora-test/Spec/Stake.hs b/agora-test/Spec/Stake.hs
index c58598f..f432e1b 100644
--- a/agora-test/Spec/Stake.hs
+++ b/agora-test/Spec/Stake.hs
@@ -10,10 +10,6 @@ import Test.Tasty (TestTree, testGroup)
 
 --------------------------------------------------------------------------------
 
-import Plutarch.Builtin (pforgetData)
-
---------------------------------------------------------------------------------
-
 import Agora.Stake (StakeDatum (StakeDatum), StakeRedeemer (DepositWithdraw), stakePolicy, stakeValidator)
 
 --------------------------------------------------------------------------------
@@ -31,35 +27,35 @@ tests =
       [ policySucceedsWith
           "stakeCreation"
           (stakePolicy Stake.stake)
-          (pforgetData (pconstantData ()))
+          ()
           Stake.stakeCreation
       , policyFailsWith
           "stakeCreationWrongDatum"
           (stakePolicy Stake.stake)
-          (pforgetData (pconstantData ()))
+          ()
           Stake.stakeCreationWrongDatum
       , policyFailsWith
           "stakeCreationUnsigned"
           (stakePolicy Stake.stake)
-          (pforgetData (pconstantData ()))
+          ()
           Stake.stakeCreationUnsigned
       , validatorSucceedsWith
           "stakeDepositWithdraw deposit"
           (stakeValidator Stake.stake)
-          (pforgetData (pconstantData . toDatum $ StakeDatum 100_000 signer))
-          (pforgetData (pconstantData . toDatum $ DepositWithdraw 100_000))
+          (toDatum $ StakeDatum 100_000 signer)
+          (toDatum $ DepositWithdraw 100_000)
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = 100_000})
       , validatorSucceedsWith
           "stakeDepositWithdraw withdraw"
           (stakeValidator Stake.stake)
-          (pforgetData (pconstantData . toDatum $ StakeDatum 100_000 signer))
-          (pforgetData (pconstantData . toDatum $ DepositWithdraw (negate 100_000)))
+          (toDatum $ StakeDatum 100_000 signer)
+          (toDatum $ DepositWithdraw (negate 100_000))
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 100_000})
       , validatorFailsWith
           "stakeDepositWithdraw negative GT"
           (stakeValidator Stake.stake)
-          (pforgetData (pconstantData . toDatum $ StakeDatum 100_000 signer))
-          (pforgetData (pconstantData . toDatum $ DepositWithdraw (negate 1_000_000)))
+          (toDatum $ StakeDatum 100_000 signer)
+          (toDatum $ DepositWithdraw (negate 1_000_000))
           (Stake.stakeDepositWithdraw $ DepositWithdrawExample {startAmount = 100_000, delta = negate 1_000_000})
       ]
   ]
diff --git a/agora-test/Spec/Util.hs b/agora-test/Spec/Util.hs
index dafd5e2..240ff3a 100644
--- a/agora-test/Spec/Util.hs
+++ b/agora-test/Spec/Util.hs
@@ -32,30 +32,93 @@ import Test.Tasty.HUnit (assertFailure, testCase)
 
 import Plutarch
 import Plutarch.Api.V1 (PMintingPolicy, PValidator)
+import Plutarch.Builtin (pforgetData)
 import Plutarch.Crypto (pblake2b_256)
 import Plutarch.Evaluate (evalScript)
+import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
 import Plutarch.Prelude ()
+import Plutus.V1.Ledger.Contexts (ScriptContext)
 import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script)
 import PlutusTx.Builtins qualified as PlutusTx
 import PlutusTx.IsData qualified as PlutusTx
 
 --------------------------------------------------------------------------------
 
-policySucceedsWith :: String -> ClosedTerm PMintingPolicy -> ClosedTerm PData -> _ -> TestTree
+policySucceedsWith ::
+  ( PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PMintingPolicy ->
+  PLifted redeemer ->
+  ScriptContext ->
+  TestTree
 policySucceedsWith tag policy redeemer scriptContext =
-  scriptSucceeds tag $ compile (policy # redeemer # pconstant scriptContext)
+  scriptSucceeds tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
 
-policyFailsWith :: String -> ClosedTerm PMintingPolicy -> ClosedTerm PData -> _ -> TestTree
+policyFailsWith ::
+  ( PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PMintingPolicy ->
+  PLifted redeemer ->
+  ScriptContext ->
+  TestTree
 policyFailsWith tag policy redeemer scriptContext =
-  scriptFails tag $ compile (policy # redeemer # pconstant scriptContext)
+  scriptFails tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
 
-validatorSucceedsWith :: String -> ClosedTerm PValidator -> ClosedTerm PData -> ClosedTerm PData -> _ -> TestTree
+validatorSucceedsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  , PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  PLifted redeemer ->
+  ScriptContext ->
+  TestTree
 validatorSucceedsWith tag policy datum redeemer scriptContext =
-  scriptSucceeds tag $ compile (policy # datum # redeemer # pconstant scriptContext)
+  scriptSucceeds tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData datum)
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
 
-validatorFailsWith :: String -> ClosedTerm PValidator -> ClosedTerm PData -> ClosedTerm PData -> _ -> TestTree
+validatorFailsWith ::
+  ( PLift datum
+  , PlutusTx.ToData (PLifted datum)
+  , PLift redeemer
+  , PlutusTx.ToData (PLifted redeemer)
+  ) =>
+  String ->
+  ClosedTerm PValidator ->
+  PLifted datum ->
+  PLifted redeemer ->
+  ScriptContext ->
+  TestTree
 validatorFailsWith tag policy datum redeemer scriptContext =
-  scriptFails tag $ compile (policy # datum # redeemer # pconstant scriptContext)
+  scriptFails tag $
+    compile
+      ( policy
+          # pforgetData (pconstantData datum)
+          # pforgetData (pconstantData redeemer)
+          # pconstant scriptContext
+      )
 
 scriptSucceeds :: String -> Script -> TestTree
 scriptSucceeds name script = testCase name $ do
diff --git a/agora/Agora/SafeMoney.hs b/agora/Agora/SafeMoney.hs
index 1eeb2c7..6730bc7 100644
--- a/agora/Agora/SafeMoney.hs
+++ b/agora/Agora/SafeMoney.hs
@@ -75,6 +75,7 @@ pgeqDiscrete = phoistAcyclic $
     PDiscrete y' <- pmatch y
     y' #<= x'
 
+-- | Conjure zero discrete unit for any moneyclass
 pzeroDiscrete :: forall (mc :: MoneyClass) (s :: S). Term s (PDiscrete mc)
 pzeroDiscrete = phoistAcyclic $ pcon (PDiscrete 0)
 
@@ -113,7 +114,7 @@ pvalueDiscrete = phoistAcyclic $
         # f
 
 {- | Get a `PValue` from a `PDiscrete`.
-     __NOTE__: `pdiscreteValue` after `pvalueDiscrete` is loses information
+     __NOTE__: `pdiscreteValue` after `pvalueDiscrete` loses information
 -}
 pdiscreteValue ::
   forall (moneyClass :: MoneyClass) (ac :: Symbol) (n :: Symbol) (scale :: Nat) s.