From c4edfa30587ac8a5ae29be7351897554eaef8547 Mon Sep 17 00:00:00 2001
From: cjay <680672+cjay@users.noreply.github.com>
Date: Thu, 8 Sep 2022 15:49:37 +0200
Subject: [PATCH] PPair instances: PPartialOrd and POrd

---
 Plutarch/Pair.hs | 27 ++++++++++++++++++++++++---
 1 file changed, 24 insertions(+), 3 deletions(-)

diff --git a/Plutarch/Pair.hs b/Plutarch/Pair.hs
index c66c27f20..6505d0a97 100644
--- a/Plutarch/Pair.hs
+++ b/Plutarch/Pair.hs
@@ -1,15 +1,15 @@
 module Plutarch.Pair (PPair (..)) where
 
 import GHC.Generics (Generic)
-import Plutarch.Bool (PEq)
+import Plutarch.Bool (PEq ((#==)), POrd, PPartialOrd ((#<), (#<=)), pif)
 import Plutarch.Internal (PType, S, Term)
-import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType)
+import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType, pmatch)
 import Plutarch.Internal.ScottEncoding (PlutusTypeScott)
 import Plutarch.Show (PShow)
+import Plutarch.TermCont (tcont, unTermCont)
 
 {- |
   Plutus encoding of Pairs.
-
   Note: This is represented differently than 'BuiltinPair'. It is scott-encoded.
 -}
 data PPair (a :: PType) (b :: PType) (s :: S)
@@ -18,3 +18,24 @@ data PPair (a :: PType) (b :: PType) (s :: S)
   deriving anyclass (PlutusType, PEq, PShow)
 
 instance DerivePlutusType (PPair a b) where type DPTStrat _ = PlutusTypeScott
+
+instance (PPartialOrd a, PPartialOrd b) => PPartialOrd (PPair a b) where
+  a #<= b = unTermCont $ do
+    PPair a1 a2 <- tcont $ pmatch a
+    PPair b1 b2 <- tcont $ pmatch b
+    pure $
+      pif
+        (a1 #== b1)
+        (a2 #<= b2)
+        (a1 #<= b1)
+
+  a #< b = unTermCont $ do
+    PPair a1 a2 <- tcont $ pmatch a
+    PPair b1 b2 <- tcont $ pmatch b
+    pure $
+      pif
+        (a1 #== b1)
+        (a2 #< b2)
+        (a1 #< b1)
+
+instance (POrd a, POrd b) => POrd (PPair a b)