docs for utils; refactor tests; rewrite pnubSortBy

agora-test/Spec/Utils.hs

@@ -7,58 +7,66 @@ Tests for utility functions in 'Agora.Utils'.
 -}
 module Spec.Utils (tests) where
 
-import Agora.Utils (phalve, pmerge, pmsortOrd, tcmatch)
+import Agora.Utils (phalve, pmergeBy, pmsort)
 import Data.List (sort)
 import Test.Tasty (TestTree)
 import Test.Tasty.QuickCheck (testProperty)
 
 tests :: [TestTree]
 tests =
-  [ testProperty "Merge sort sorts a list properly" prop_msort_sorted
+  [ testProperty "Merge sort sorts a list properly" prop_msortSorted
-  , testProperty "Two sorted lists are merged into one sorted list" prop_pmerge_sorted
+  , testProperty "Two sorted lists are merged into one sorted list" prop_pmergeSorted
-  , testProperty "Split a list in half as expected" prop_halve_properly
+  , testProperty "Split a list in half as expected" prop_halveProperly
   ]
 
 --------------------------------------------------------------------------------
 
-prop_msort_sorted :: [Integer] -> Bool
+prop_msortSorted :: [Integer] -> Bool
-prop_msort_sorted arr = sort arr == sorted
+prop_msortSorted arr = sorted == expected
   where
-    parr :: Term _ (PBuiltinList PInteger)
+    -- Expected sorted list, using 'Data.List.sort'.
-    parr = pconstant arr
+    expected :: [Integer]
+    expected = sort arr
+
+    --
 
     psorted :: Term _ (PBuiltinList PInteger)
-    psorted = pmsortOrd # parr
+    psorted = pmsort # pconstant arr
 
     sorted :: [Integer]
     sorted = plift psorted
 
-prop_pmerge_sorted :: ([Integer], [Integer]) -> Bool
+prop_pmergeSorted :: [Integer] -> [Integer] -> Bool
-prop_pmerge_sorted (a, b) = merge sa sb == merged
+prop_pmergeSorted a b = merged == expected
   where
+    -- Sorted list a and b
     sa = sort a
     sb = sort b
 
+    -- Merge two lists which are assumed to be ordered.
+    merge :: [Integer] -> [Integer] -> [Integer]
     merge xs [] = xs
     merge [] ys = ys
     merge sx@(x : xs) sy@(y : ys)
       | x <= y = x : merge xs sy
       | otherwise = y : merge sx ys
 
-    psa :: Term _ (PBuiltinList PInteger)
+    expected :: [Integer]
-    psa = pconstant @(PBuiltinList PInteger) sa
+    expected = merge sa sb
-    psb :: Term _ (PBuiltinList PInteger)
+
-    psb = pconstant @(PBuiltinList PInteger) sb
+    --
 
     pmerged :: Term _ (PBuiltinList PInteger)
-    pmerged = pmerge # plam (#<) # psa # psb
+    pmerged = pmergeBy # plam (#<) # pconstant sa # pconstant sb
 
     merged :: [Integer]
     merged = plift pmerged
 
-prop_halve_properly :: [Integer] -> Bool
+prop_halveProperly :: [Integer] -> Bool
-prop_halve_properly arr = halve arr == halved
+prop_halveProperly arr = halved == expected
   where
+    -- Halve a list.
+    halve :: [Integer] -> ([Integer], [Integer])
     halve xs = go xs xs
       where
         go xs [] = ([], xs)
@@ -69,26 +77,16 @@ prop_halve_properly arr = halve arr == halved
            in (x : first, last)
         go [] _ = ([], [])
 
-    parr :: Term _ (PBuiltinList PInteger)
+    expected :: ([Integer], [Integer])
-    parr = pconstant arr
+    expected = halve arr
 
-    ppairFst :: Term _ (PPair a b :--> a)
+    --
-    ppairFst = phoistAcyclic $
-      plam $ \p -> unTermCont $ do
-        PPair x _ <- tcmatch p
-        return x
-
-    ppairSnd :: Term _ (PPair a b :--> b)
-    ppairSnd = phoistAcyclic $
-      plam $ \p -> unTermCont $ do
-        PPair _ y <- tcmatch p
-        return y
 
     phalved :: Term _ (PPair (PBuiltinList PInteger) (PBuiltinList PInteger))
-    phalved = phalve # parr
+    phalved = phalve # pconstant arr
 
     halved :: ([Integer], [Integer])
     halved =
-      let f = plift $ ppairFst # phalved
+      let f = plift $ pmatch phalved $ \(PPair x _) -> x
-          s = plift $ ppairSnd # phalved
+          s = plift $ pmatch phalved $ \(PPair _ x) -> x
        in (f, s)

agora/Agora/Proposal/Scripts.hs

@@ -21,7 +21,7 @@ import Agora.Utils (
   anyOutput,
   findTxOutByTxOutRef,
   getMintingPolicySymbol,
-  pisUniq,
+  pisUniqBy,
   psymbolValueOf,
   ptokenSpent,
   ptxSignedBy,
@@ -171,7 +171,10 @@ proposalValidator proposal =
           newSigs <- tclet $ pfield @"newCosigners" # r
 
           tcassert "Cosigners are unique" $
-            pisUniq # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y) # newSigs
+            pisUniqBy
+              # phoistAcyclic (plam (#==))
+              # phoistAcyclic (plam $ \(pfromData -> x) (pfromData -> y) -> x #< y)
+              # newSigs
 
           tcassert "Signed by all new cosigners" $
             pall # signedBy # newSigs

agora/Agora/Utils.hs

@@ -32,13 +32,14 @@ module Agora.Utils (
   pisJust,
   ptokenSpent,
   pkeysEqual,
-  pnub,
+  pnubSortBy,
   pisUniq,
-  pisUniqOrd,
+  pisUniqBy,
   pisDJust,
   pisUTXOSpent,
+  pmsortBy,
   pmsort,
-  pmsortOrd,
+  pnubSort,
 
   -- * Functions which should (probably) not be upstreamed
   anyOutput,
@@ -56,7 +57,7 @@ module Agora.Utils (
   mustBePJust,
   mustBePDJust,
   validatorHashToAddress,
-  pmerge,
+  pmergeBy,
   phalve,
 ) where
 
@@ -371,46 +372,67 @@ pkeysEqual = phoistAcyclic $
         (plength # pks #== plength # qks)
         ( unTermCont $ do
             let comp = phoistAcyclic $ plam $ \(pfromData -> x) (pfromData -> y) -> x #< y
-                spks = pmsort # comp # pks
+                spks = pmsortBy # comp # pks
-                sqks = pmsort # comp # qks
+                sqks = pmsortBy # comp # qks
 
             pure $ plistEquals # spks # sqks
         )
         (pcon PFalse)
 
--- | / O(nlogn) /. Clear out duplicates in a list. The order is not preserved.
+-- | / O(nlogn) /. Sort and remove dupicate elements in a list.
-pnub :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> list a)
+pnubSortBy ::
-pnub = phoistAcyclic $
+  forall list a (s :: S).
-  plam $ \comp xs -> unTermCont $ do
+  (PIsListLike list a) =>
-    sorted <- tclet $ pmsort # comp # xs
+  Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> list a)
-    pure $ pnubOrd # comp # sorted
+pnubSortBy = phoistAcyclic $
-  where
+  plam $ \eq comp l -> pif (pnull # l) l $
-    pnubOrd = phoistAcyclic $ pfix #$ plam pnubOrd'
+    unTermCont $ do
-    pnubOrd' self comp xs =
+      sl <- tclet $ pmsortBy # comp # l
-      pif (pnull # xs) pnil $
-        unTermCont $ do
-          xh <- tclet $ phead # xs
-          xt <- tclet $ ptail # xs
 
-          pure $
+      let x = phead # sl
-            pif (pnull # xt) xs $
+          xs = ptail # sl
-              unTermCont $ do
+
-                xh' <- tclet $ phead # xt
+      return $ pgo # eq # x # xs
-                pure $
+  where
-                  pif
+    pgo = phoistAcyclic pfix #$ plam pgo'
-                    (xh #== xh')
+    pgo' self eq seen l =
-                    (self # comp # xt)
+      pif (pnull # l) (psingleton # seen) $
-                    (pcons # xh #$ self # comp # xt)
+        unTermCont $ do
+          x <- tclet $ phead # l
+          xs <- tclet $ ptail # l
+
+          return $
+            pif
+              (eq # x # seen)
+              (self # eq # seen # xs)
+              (pcons # seen #$ self # eq # x # xs)
+
+-- | Special version of 'pnubSortBy', which requires elements have 'POrd'.
+pnubSort ::
+  forall list a (s :: S).
+  (PIsListLike list a, POrd a) =>
+  Term s (list a :--> list a)
+pnubSort = phoistAcyclic $ pnubSortBy # eq # comp
+  where
+    eq = phoistAcyclic $ plam (#==)
+    comp = phoistAcyclic $ plam (#<)
 
 -- | / O(nlogn) /. Check if a list contains no duplicates.
-pisUniq :: forall list a (s :: S). (PEq a, PIsListLike list a) => Term s ((a :--> a :--> PBool) :--> list a :--> PBool)
+pisUniqBy ::
-pisUniq = phoistAcyclic $
+  forall list a (s :: S).
-  plam $ \comp xs ->
+  (PIsListLike list a) =>
-    let nubbed = pnub # comp # xs in plength # xs #== plength # nubbed
+  Term s ((a :--> a :--> PBool) :--> (a :--> a :--> PBool) :--> list a :--> PBool)
+pisUniqBy = phoistAcyclic $
+  plam $ \eq comp xs ->
+    let nubbed = pnubSortBy # eq # comp # xs
+     in plength # xs #== plength # nubbed
 
--- | List elements should have 'POrd' instance.
+-- | A special case of 'pisUniqBy' which requires elements have 'POrd' instance.
-pisUniqOrd :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool)
+pisUniq :: forall list a (s :: S). (POrd a, PIsListLike list a) => Term s (list a :--> PBool)
-pisUniqOrd = phoistAcyclic $ pisUniq # plam (#<)
+pisUniq = phoistAcyclic $ pisUniqBy # eq # comp
+  where
+    eq = phoistAcyclic $ plam (#==)
+    comp = phoistAcyclic $ plam (#<)
 
 -- | Yield True if a given PMaybeData is of form @'PDJust' _@.
 pisDJust :: Term s (PMaybeData a :--> PBool)
@@ -423,19 +445,17 @@ pisDJust = phoistAcyclic $
           _ -> pconstant False
       )
 
-{- | Determines if a given UTXO is spent.
+-- | Determines if a given UTXO is spent.
- TODO: no need to pass the whole TxInfo here.
--}
 pisUTXOSpent :: Term s (PTxOutRef :--> PBuiltinList (PAsData PTxInInfo) :--> PBool)
 pisUTXOSpent = phoistAcyclic $
   plam $ \oref inputs -> P.do
     pisJust #$ pfindTxInByTxOutRef # oref # inputs
 
--- | Merge two ordered lists together.
+-- | / O(n) /. Merge two lists which are assumed to be ordered, given a custom comparator.
-pmerge :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a)
+pmergeBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a :--> l a)
-pmerge = phoistAcyclic $ pfix #$ plam pmerge'
+pmergeBy = phoistAcyclic $ pfix #$ plam pmergeBy'
   where
-    pmerge' self comp a b =
+    pmergeBy' self comp a b =
       pif (pnull # a) b $
         pif (pnull # b) a $
           unTermCont $ do
@@ -450,20 +470,24 @@ pmerge = phoistAcyclic $ pfix #$ plam pmerge'
                 (pcons # ah #$ self # comp # at # b)
                 (pcons # bh #$ self # comp # a # bt)
 
--- | / O(nlogn) /. Merge sort, bottom-up version.
+{- | / O(nlogn) /. Merge sort, bottom-up version, given a custom comparator.
-pmsort :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a)
+
-pmsort = phoistAcyclic $ pfix #$ plam pmsort'
+   Elements are arranged from lowest to highest,
+   keeping duplicates in the order they appeared in the input.
+-}
+pmsortBy :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a)
+pmsortBy = phoistAcyclic $ pfix #$ plam pmsortBy'
   where
-    pmsort' self comp xs = pif (pnull # xs) pnil $
+    pmsortBy' self comp xs = pif (pnull # xs) pnil $
       pif (pnull #$ ptail # xs) xs $
         pmatch (phalve # xs) $ \(PPair fh sh) ->
           let sfh = self # comp # fh
               ssh = self # comp # sh
-           in pmerge # comp # sfh # ssh
+           in pmergeBy # comp # sfh # ssh
 
--- | Required list elements have 'POrd' instance.
+-- | A special case of 'pmsortBy' which requires elements have 'POrd' instance.
-pmsortOrd :: (POrd a, PIsListLike l a) => Term s (l a :--> l a)
+pmsort :: (POrd a, PIsListLike l a) => Term s (l a :--> l a)
-pmsortOrd = phoistAcyclic $ pmsort # comp
+pmsort = phoistAcyclic $ pmsortBy # comp
   where
     comp = phoistAcyclic $ plam (#<)