PList cosmetics

Author: bladyjoker

runtimes/haskell/lbr-plutarch/src/LambdaBuffers/Runtime/Plutarch.hs

@@ -16,9 +16,10 @@ module LambdaBuffers.Runtime.Plutarch (
   PMaybe (..),
   pcon,
   PList (..),
-  caseList,
-  pcons,
-  pnil,
+  plistCase,
+  plistCons,
+  plistNil,
+  plistFrom,
 ) where
 
 import Data.Functor.Const (Const)
@@ -697,13 +698,16 @@ pcon = pdata . Pl.pcon
 
 TODO(bladyjoker): Upstream with PList and plan to remove.
 -}
-caseList :: (PIsData a) => (Term s a -> Term s (PList a) -> Term s r) -> Term s r -> Term s (PList a) -> Term s r
-caseList consCase nilCase ls = pmatch (Pl.pto ls) $ \case
-  Pl.PCons x xs -> consCase (Pl.pfromData x) (Pl.pcon $ PList xs)
+plistCase :: (PIsData a) => Term s (a :--> PList a :--> r) -> Term s r -> Term s (PList a) -> Term s r
+plistCase consCase nilCase ls = pmatch (Pl.pto ls) $ \case
+  Pl.PCons x xs -> consCase # Pl.pfromData x # Pl.pcon (PList xs)
   Pl.PNil -> nilCase
 
-pcons :: PIsData a => Term s (a :--> (PList a :--> PList a))
-pcons = phoistAcyclic $ plam $ \x xs -> Pl.pcon $ PList (Pl.pcons # Pl.pdata x # Pl.pto xs)
+plistCons :: PIsData a => Term s (a :--> (PList a :--> PList a))
+plistCons = phoistAcyclic $ plam $ \x xs -> Pl.pcon $ PList (Pl.pcons # Pl.pdata x # Pl.pto xs)
 
-pnil :: Term s (PList a)
-pnil = Pl.pcon $ PList $ Pl.pcon Pl.PNil
+plistNil :: Term s (PList a)
+plistNil = Pl.pcon $ PList $ Pl.pcon Pl.PNil
+
+plistFrom :: PIsData a => [Term s a] -> Term s (PList a)
+plistFrom = foldr (\x -> (#) (plistCons # x)) plistNil

runtimes/haskell/lbr-plutarch/test/Test/LambdaBuffers/Runtime/Plutarch.hs

@@ -6,9 +6,9 @@ import Hedgehog.Gen qualified as Gen
 import Hedgehog.Range qualified as Range
 import LambdaBuffers.Runtime.Plutarch (PList)
 import LambdaBuffers.Runtime.Plutarch qualified as Lb
-import Plutarch (ClosedTerm, Config (Config), Term, TracingMode (DoTracingAndBinds), compile, pcon, perror, (#))
+import Plutarch (ClosedTerm, Config (Config), TracingMode (DoTracingAndBinds), compile, pcon, perror)
 import Plutarch.Evaluate (evalScript)
-import Plutarch.Prelude (PBool (PTrue), PEq ((#==)), PInteger, PIsData, pconstant, pif)
+import Plutarch.Prelude (PBool (PTrue), PEq ((#==)), PInteger, pconstant, pif)
 import Test.Tasty (TestTree, adjustOption, testGroup)
 import Test.Tasty.HUnit (assertFailure)
 import Test.Tasty.Hedgehog (testProperty)
@@ -19,22 +19,27 @@ test =
   adjustOption (\_ -> H.HedgehogTestLimit $ Just 1000) $
     testGroup
       "PList tests"
-      [ testProperty "forall xs :: [Integer] ys :: [Integer]. (xs == ys) === evalEq (toPlutarch xs) (toPlutarch ys)" $
+      [ testProperty "forall xs :: [Integer] ys :: [Integer]. (xs == ys) === evalEq (plistFrom xs) (plistFrom ys)" $
           H.property $
             H.forAll
               ((,) <$> genInts <*> genInts)
               >>= ( \(xs, ys) -> do
-                      b <- liftIO $ evalEq (fromList $ pconstant <$> xs) (fromList $ pconstant <$> ys)
+                      b <- liftIO $ evalEq (Lb.plistFrom $ pconstant <$> xs) (Lb.plistFrom $ pconstant <$> ys)
                       (xs == ys) H.=== b
                   )
+      , testProperty "forall xs :: [Integer]. evalEq (plistCase plistCons plistNil (plistFrom xs)) (plistFrom xs)" $
+          H.property $
+            H.forAll
+              genInts
+              >>= ( \xs -> do
+                      b <- liftIO $ evalEq (Lb.plistCase Lb.plistCons Lb.plistNil (Lb.plistFrom $ pconstant <$> xs)) (Lb.plistFrom $ pconstant <$> xs)
+                      True H.=== b
+                  )
       ]
   where
     genInts :: H.Gen [Integer]
     genInts = Gen.list (Range.linear 0 100) (Gen.integral (Range.linear 0 100))
 
-fromList :: PIsData a => [Term s a] -> Term s (PList a)
-fromList = foldr (\x -> (#) (Lb.pcons # x)) Lb.pnil
-
 evalEq :: ClosedTerm (PList PInteger) -> ClosedTerm (PList PInteger) -> IO Bool
 evalEq l r =
   let