fix: Add some build fixes

Anastasia-Labs · Apr 25, 2024 · 305be8b · 305be8b
1 parent 6065627
commit 305be8b
Showing 1 changed file with 30 additions and 18 deletions.
diff --git a/src/Plutarch/SingularUTxOIndexerOneToMany.hs b/src/Plutarch/SingularUTxOIndexerOneToMany.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
 module Plutarch.SingularUTxOIndexerOneToMany (
   spend,
   SpendRedeemer (..),
@@ -34,35 +36,45 @@ newtype PSpendRedeemer (s :: S)
 instance DerivePlutusType PSpendRedeemer where type DPTStrat _ = PlutusTypeData
 instance PTryFrom PData PSpendRedeemer
 
-spend :: Term s (PTxOut :--> PBool) 
+data PMyAggregator (s :: S) = PMyAggregator (Term s PInteger) (Term s (PList PTxOut)) (Term s PInteger)
+  deriving stock (Generic)
+  deriving anyclass (PlutusType, PEq, PShow)
+
+instance DerivePlutusType PMyAggregator where type DPTStrat _ = PlutusTypeScott
+
+spend :: Term s (PTxOut :--> PBool)
   -> Term s (PTxOut :--> PTxOut :--> PBool)
   -> Term s (PBuiltinList PTxOut :--> PInteger :--> PBool)
   -> Term s PValidator
 spend inputValidator inputOutputValidator collectiveOutputValidator =
   plam $ \_datum redeemer ctx -> unTermCont $ do
     let red = punsafeCoerce @_ @_ @PSpendRedeemer redeemer
-    redF <- pletFieldsC @'["indx", "outIxs"] red
+    redF <- pletFieldsC @'["inIx", "outIxs"] red
     ctxF <- pletFieldsC @'["txInfo", "purpose"] ctx
     PSpending ownRef' <- pmatchC ctxF.purpose
     ownRef <- pletC $ pfield @"_0" # ownRef'
     txInfoF <- pletFieldsC @'["inputs", "outputs"] ctxF.txInfo
     let inIx = pasInt # redF.inIx
         outIxs = pmap # pasInt # redF.outIxs
-        (_, outTxOuts, outputCount) = 
+        aggregated =
             pfoldr # 
-              plan (\(curIdx (prevIdx, acc, count) -> pif 
-                  (curIdx #< prevIdx)
-                  (curIdx, pconcat # acc # psingleton (pelemAt @PBuiltinList # curIdx # txInfoF.outputs), count + 1))
-                  perror
-              ) #
-              (P.length # outputs, [], 0) #
-              outIxs
+              (plam $ \curIdx p ->
+                pmatch p $ \case
+                    PMyAggregator prevIdx acc count ->
+                      pif
+                        (curIdx #< prevIdx)
+                        (pcon (PMyAggregator curIdx (pconcat # acc #$ psingleton # (pelemAt @PBuiltinList # curIdx # txInfoF.outputs)) (count + 1)))
+                        perror
+              )
+              # pcon (PMyAggregator (plength # txInfoF.outputs) pnil 0) # outIxs
 
-        outOutput = pelemAt @PBuiltinList # outIdx # txInfoF.outputs
-    inInputF <- pletFieldsC @'["outRef", "resolved"] (pelemAt @PBuiltinList # inIx # txInfoF.inputs)
-    return $
-      popaque $
-        pif
-          (ptraceIfFalse "Indicated input must match the spending one" (ownRef #== inInputF.outRef))
-          (inputOutputValidator # inInputF.resolved # outOutput)
-          perror
+    return $ pmatch aggregated $ \case
+        PMyAggregator _ outTxOuts outputCount -> unTermCont $ do
+          let outOutput = pelemAt @PBuiltinList # outIxs # txInfoF.outputs
+          inInputF <- pletFieldsC @'["outRef", "resolved"] (pelemAt @PBuiltinList # inIx # txInfoF.inputs)
+          return $
+            popaque $
+              pif
+                (ptraceIfFalse "Indicated input must match the spending one" (ownRef #== inInputF.outRef))
+                (inputOutputValidator # inInputF.resolved # outOutput)
+                perror