add tests for pmsort, pmerge and phalve

agora-test/Spec/Utils.hs

@@ -7,7 +7,88 @@ Tests for utility functions in 'Agora.Utils'.
 -}
 module Spec.Utils (tests) where
 
+import Agora.Utils (phalve, pmerge, pmsortOrd, tcmatch)
+import Data.List (sort)
 import Test.Tasty (TestTree)
+import Test.Tasty.QuickCheck (testProperty)
 
 tests :: [TestTree]
-tests = []
+tests =
+  [ testProperty "Merge sort sorts a list properly" prop_msort_sorted
+  , testProperty "Two sorted lists are merged into one sorted list" prop_pmerge_sorted
+  , testProperty "Split a list in half as expected" prop_halve_properly
+  ]
+
+--------------------------------------------------------------------------------
+
+prop_msort_sorted :: [Integer] -> Bool
+prop_msort_sorted arr = sort arr == sorted
+  where
+    parr :: Term _ (PBuiltinList PInteger)
+    parr = pconstant arr
+
+    psorted :: Term _ (PBuiltinList PInteger)
+    psorted = pmsortOrd # parr
+
+    sorted :: [Integer]
+    sorted = plift psorted
+
+prop_pmerge_sorted :: ([Integer], [Integer]) -> Bool
+prop_pmerge_sorted (a, b) = merge sa sb == merged
+  where
+    sa = sort a
+    sb = sort b
+
+    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)
+    psa = pconstant @(PBuiltinList PInteger) sa
+    psb :: Term _ (PBuiltinList PInteger)
+    psb = pconstant @(PBuiltinList PInteger) sb
+
+    pmerged :: Term _ (PBuiltinList PInteger)
+    pmerged = pmerge # plam (#<) # psa # psb
+
+    merged :: [Integer]
+    merged = plift pmerged
+
+prop_halve_properly :: [Integer] -> Bool
+prop_halve_properly arr = halve arr == halved
+  where
+    halve xs = go xs xs
+      where
+        go xs [] = ([], xs)
+        go (x : xs) [_] = ([x], xs)
+        go (x : xs) (_ : _ : ys) =
+          let (first, last) =
+                go xs ys
+           in (x : first, last)
+        go [] _ = ([], [])
+
+    parr :: Term _ (PBuiltinList PInteger)
+    parr = pconstant 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
+
+    halved :: ([Integer], [Integer])
+    halved =
+      let f = plift $ ppairFst # phalved
+          s = plift $ ppairSnd # phalved
+       in (f, s)

agora.cabal

@@ -119,6 +119,7 @@ common test-deps
     , tasty
     , tasty-hedgehog
     , tasty-hunit
+    , tasty-quickcheck
 
 common exe-opts
   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0

agora/Agora/Utils.hs

@@ -56,6 +56,8 @@ module Agora.Utils (
   mustBePJust,
   mustBePDJust,
   validatorHashToAddress,
+  pmerge,
+  phalve,
 ) where
 
 --------------------------------------------------------------------------------
@@ -446,7 +448,7 @@ pmerge = phoistAcyclic $ pfix #$ plam pmerge'
               pif
                 (comp # ah # bh)
                 (pcons # ah #$ self # comp # at # b)
-                (pcons # bh #$ self # comp # at # bt)
+                (pcons # bh #$ self # comp # a # bt)
 
 -- | / O(nlogn) /. Merge sort, bottom-up version.
 pmsort :: (PIsListLike l a) => Term s ((a :--> a :--> PBool) :--> l a :--> l a)