lude

commit 28d9bc9550ad835f3cea14d54c6226c6e4915580
parent 01d1b0101f473d851219a8c8600d111a61df252f
Author: Robert Russell <robert@rr3.xyz>
Date:   Tue, 10 Mar 2026 13:29:01 -0700

Add constrained example

Diffstat:
M
package.yaml
 | 
1
+
M
src/Lude/Algebra.hs
 | 
18
++++++++++++++++++

2 files changed, 19 insertions(+), 0 deletions(-)
diff --git a/package.yaml b/package.yaml
@@ -45,6 +45,7 @@ default-extensions:
 
 dependencies:
     - base
+    - containers
 
 library:
     source-dirs: src
diff --git a/src/Lude/Algebra.hs b/src/Lude/Algebra.hs
@@ -8,6 +8,10 @@ module Lude.Algebra (
     Op (..),
 ) where
 
+import Data.Set (Set)
+import Data.Set qualified as Set
+import Prelude (Eq, Ord)
+
 import Lude.Kind
 import Lude.Repr (Repr)
 import Lude.Repr qualified as Repr
@@ -43,6 +47,20 @@ class (Category cat0, Category cat1) => Functor cat0 cat1 f | cat0 f -> cat1, ca
 type Endofunctor :: forall k r. Cat k r -> (k -> k) -> Constraint
 type Endofunctor cat f = Functor cat cat f
 
+type Constrained :: forall k r. Cat k r -> (k -> Constraint) -> k -> k -> TypeL
+newtype Constrained cat obj a b = Constrained ((obj a, obj b) => cat a b)
+
+type (:-) :: forall k r. (k -> Constraint) -> Cat k r -> k -> k -> TypeL
+type obj :- cat = Constrained cat obj
+
+instance (Category cat) => Category (obj :- cat) where
+    type Ob (obj :- cat) a = (Ob cat a, obj a)
+    identity = Constrained identity
+    compose (Constrained f) (Constrained g) = Constrained (compose f g)
+
+instance Functor (Ord :- Hask) Hask Set where
+    map (Constrained f) = Set.map f
+
 --------------------------------------------------------------------------------
 -- Bifunctor