commit 01875046d33b997d26a7b423becceb57f320ea9e
parent 132a8f28c8603554788ec3291eb5fbeab3962434
Author: Robert Russell <robert@rr3.xyz>
Date: Wed, 16 Sep 2026 22:21:59 -0700
Order: init
Diffstat:
8 files changed, 224 insertions(+), 1 deletion(-)
diff --git a/src/Lude.hs b/src/Lude.hs
@@ -13,6 +13,7 @@ import Lude.IO as X
import Lude.List as X
import Lude.Maybe as X
import Lude.Natural as X
+import Lude.Order as X
import Lude.Pair as X
import Lude.Text as X
import Lude.Unit as X
diff --git a/src/Lude/Maybe.hs b/src/Lude/Maybe.hs
@@ -1,7 +1,18 @@
module Lude.Maybe (
Maybe (..),
+ unsafeFromJust,
) where
-import Prelude (Maybe (..))
+import Data.Maybe (Maybe (..))
+import Data.Maybe qualified as Base
+
+import Lude.Haskell
+
+-- TODO: Versions for other reprs? Look at Todo/Lude.hs.
+
+-- TODO: Defaulting operators
--------------------------------------------------------------------------------
+
+unsafeFromJust :: forall (a :: Type). Maybe a -> a
+unsafeFromJust = Base.fromJust
diff --git a/src/Lude/Order.hs b/src/Lude/Order.hs
@@ -0,0 +1,11 @@
+module Lude.Order (
+ module X,
+) where
+
+import Lude.Order.Bound as X
+import Lude.Order.Lattice as X
+import Lude.Order.Ordering as X
+import Lude.Order.Partial as X
+import Lude.Order.Total as X
+
+--------------------------------------------------------------------------------
diff --git a/src/Lude/Order/Bound.hs b/src/Lude/Order/Bound.hs
@@ -0,0 +1,31 @@
+module Lude.Order.Bound (
+ BoundedBelow (..),
+ BoundedAbove (..),
+ Bounded,
+) where
+
+import Data.Coerce
+import Prelude qualified as Base
+
+import Lude.Haskell
+import Lude.Order.Partial
+
+--------------------------------------------------------------------------------
+
+type BoundedBelow :: forall {r :: Repr}. Type @r -> Constraint
+class (PartiallyOrdered a) => BoundedBelow a where
+ bot :: Lev a
+
+type BoundedAbove :: forall {r :: Repr}. Type @r -> Constraint
+class (PartiallyOrdered a) => BoundedAbove a where
+ top :: Lev a
+
+type Bounded :: forall {r :: Repr}. Type @r -> Constraint
+class (BoundedBelow a, BoundedAbove a) => Bounded a
+instance (BoundedBelow a, BoundedAbove a) => Bounded a
+
+--------------------------------------------------------------------------------
+-- Interop
+
+instance (Base.Ord a, Base.Bounded a) => BoundedBelow (BaseInterop a) where bot = coerce Base.minBound
+instance (Base.Ord a, Base.Bounded a) => BoundedAbove (BaseInterop a) where top = coerce Base.maxBound
diff --git a/src/Lude/Order/Lattice.hs b/src/Lude/Order/Lattice.hs
@@ -0,0 +1,49 @@
+module Lude.Order.Lattice (
+ GlbLatticed (..),
+ LubLatticed (..),
+ Latticed,
+ BoundedGlbLatticed,
+ BoundedLubLatticed,
+ BoundedLatticed,
+) where
+
+import Data.Coerce
+import Prelude qualified as Base
+
+import Lude.Haskell
+import Lude.Order.Bound
+import Lude.Order.Partial
+
+-- TODO: Infix operators for glb and lub?
+
+--------------------------------------------------------------------------------
+
+type GlbLatticed :: forall {r :: Repr}. Type @r -> Constraint
+class (PartiallyOrdered a) => GlbLatticed a where
+ glb :: Biendo a
+
+type LubLatticed :: forall {r :: Repr}. Type @r -> Constraint
+class (PartiallyOrdered a) => LubLatticed a where
+ lub :: Biendo a
+
+type Latticed :: forall {r :: Repr}. Type @r -> Constraint
+class (GlbLatticed a, LubLatticed a) => Latticed a
+instance (GlbLatticed a, LubLatticed a) => Latticed a
+
+type BoundedGlbLatticed :: forall {r :: Repr}. Type @r -> Constraint
+class (BoundedAbove a, GlbLatticed a) => BoundedGlbLatticed a
+instance (BoundedAbove a, GlbLatticed a) => BoundedGlbLatticed a
+
+type BoundedLubLatticed :: forall {r :: Repr}. Type @r -> Constraint
+class (BoundedBelow a, LubLatticed a) => BoundedLubLatticed a
+instance (BoundedBelow a, LubLatticed a) => BoundedLubLatticed a
+
+type BoundedLatticed :: forall {r :: Repr}. Type @r -> Constraint
+class (BoundedGlbLatticed a, BoundedLubLatticed a) => BoundedLatticed a
+instance (BoundedGlbLatticed a, BoundedLubLatticed a) => BoundedLatticed a
+
+--------------------------------------------------------------------------------
+-- Interop
+
+instance (Base.Ord a) => GlbLatticed (BaseInterop a) where glb = coerce Base.min
+instance (Base.Ord a) => LubLatticed (BaseInterop a) where lub = coerce Base.max
diff --git a/src/Lude/Order/Ordering.hs b/src/Lude/Order/Ordering.hs
@@ -0,0 +1,7 @@
+module Lude.Order.Ordering (
+ Ordering (..),
+) where
+
+import Prelude (Ordering (..))
+
+--------------------------------------------------------------------------------
diff --git a/src/Lude/Order/Partial.hs b/src/Lude/Order/Partial.hs
@@ -0,0 +1,70 @@
+module Lude.Order.Partial (
+ Ordering (..),
+ (==),
+ (<>),
+ --
+ PartiallyOrdered (..),
+ (<),
+ (<=),
+ (>=),
+ (>),
+) where
+
+import Data.Coerce
+import Prelude qualified as Base
+
+import Lude.Bool
+import Lude.Equivalence
+import Lude.Function
+import Lude.Haskell
+import Lude.Maybe
+import Lude.Order.Ordering
+
+--------------------------------------------------------------------------------
+
+infix 4 <, <=, >=, >
+
+--------------------------------------------------------------------------------
+
+type PartiallyOrdered :: forall {r :: Repr}. Type @r -> Constraint
+class (Equivalential a) => PartiallyOrdered (a :: Type @r) where
+ {-# MINIMAL pcmp #-}
+
+ pcmp :: a -> a -> Maybe Ordering
+
+ lt :: a -> a -> Bool
+ default lt :: (Functional# r) => a -> a -> Bool
+ lt = lam2# \x y -> case app2# pcmp x y of Just LT -> True; _ -> False
+
+ le :: a -> a -> Bool
+ default le :: (Functional# r) => a -> a -> Bool
+ le = lam2# \x y -> case app2# pcmp x y of Just GT -> False; _ -> True
+
+ ge :: a -> a -> Bool
+ default ge :: (Functional# r) => a -> a -> Bool
+ ge = lam2# \x y -> case app2# pcmp x y of Just LT -> False; _ -> True
+
+ gt :: a -> a -> Bool
+ default gt :: (Functional# r) => a -> a -> Bool
+ gt = lam2# \x y -> case app2# pcmp x y of Just GT -> True; _ -> False
+
+(<), (<=), (>=), (>) :: forall {r :: Repr} (a :: Type @r). (PartiallyOrdered a) => a -> a -> Bool
+(<) = lt
+(<=) = le
+(>=) = ge
+(>) = gt
+
+--------------------------------------------------------------------------------
+-- Generics
+
+-- TODO
+
+--------------------------------------------------------------------------------
+-- Interop
+
+instance (Base.Ord a) => PartiallyOrdered (BaseInterop a) where
+ pcmp = Just .* coerce Base.compare
+ lt = coerce (Base.<)
+ le = coerce (Base.<=)
+ ge = coerce (Base.>=)
+ gt = coerce (Base.>)
diff --git a/src/Lude/Order/Total.hs b/src/Lude/Order/Total.hs
@@ -0,0 +1,43 @@
+module Lude.Order.Total (
+ Ordering (..),
+ (==),
+ (<>),
+ (<),
+ (<=),
+ (>=),
+ (>),
+ --
+ TotallyOrdered (..),
+ min,
+ max,
+) where
+
+import Data.Coerce
+import Prelude qualified as Base
+
+import Lude.Equivalence
+import Lude.Function
+import Lude.Haskell
+import Lude.Maybe
+import Lude.Order.Lattice
+import Lude.Order.Partial
+
+--------------------------------------------------------------------------------
+
+type TotallyOrdered :: forall {r :: Repr}. Type @r -> Constraint
+class (Latticed a) => TotallyOrdered (a :: Type @r) where
+ {-# MINIMAL #-}
+
+ cmp :: a -> a -> Ordering
+ default cmp :: (Functional# r) => a -> a -> Ordering
+ cmp = unsafeFromJust .* pcmp
+
+min, max :: forall {r :: Repr} (a :: Type @r). (TotallyOrdered a) => Biendo a
+min = glb
+max = lub
+
+--------------------------------------------------------------------------------
+-- Interop
+
+instance (Base.Ord a) => TotallyOrdered (BaseInterop a) where
+ cmp = coerce Base.compare
