lude

commit a07f4375ece67cad8086befcddeb67c3ee41e50c
parent fe38de3ec6a2697a9a01ea082bff6b7288de3501
Author: Robert Russell <robert@rr3.xyz>
Date:   Mon, 14 Sep 2026 13:56:40 -0700

Lude.Algebra.Category: interop with base Functor/Monad classes

Diffstat:
M
src/Lude/Algebra/Category/Core.hs
 | 
21
+++++++++++++++++++++
M
src/Lude/Algebra/Category/Monad.hs
 | 
16
++++++++++++++++
M
src/Lude/Constraint/Predicate.hs
 | 
4
++++
M
src/Lude/IO.hs
 | 
14
--------------

4 files changed, 41 insertions(+), 14 deletions(-)
diff --git a/src/Lude/Algebra/Category/Core.hs b/src/Lude/Algebra/Category/Core.hs
@@ -24,10 +24,17 @@ module Lude.Algebra.Category.Core (
     type (==>),
     NTDom,
     NTCod,
+    --
+    InteropFunctor (..),
 ) where
 
+import Data.Coerce
+import Prelude qualified
+
 import Lude.Constraint.Predicate
 import Lude.Haskell
+import Lude.IO
+import Lude.List
 
 -- TODO: Allow non-BoxL morphism Repr?
 
@@ -219,3 +226,17 @@ instance Functorial Given where
     type Dom Given = Function
     type Cod Given = Entailment
     map = mapGiven
+
+--------------------------------------------------------------------------------
+-- Interop
+
+type InteropFunctor :: Endo (Endo Type)
+newtype InteropFunctor f a = MkInteropFunctor {unInteropFunctor :: f a}
+
+instance (Prelude.Functor f) => Functorial (InteropFunctor f) where
+    type Dom (InteropFunctor f) = Function
+    type Cod (InteropFunctor f) = Function
+    map = coerce Prelude.fmap
+
+deriving via InteropFunctor IO instance Functorial IO
+deriving via InteropFunctor List instance Functorial List
diff --git a/src/Lude/Algebra/Category/Monad.hs b/src/Lude/Algebra/Category/Monad.hs
@@ -10,9 +10,14 @@ module Lude.Algebra.Category.Monad (
     (<<),
 ) where
 
+import Data.Coerce
+import Prelude qualified
+
 import Lude.Algebra.Category.Core
 import Lude.Function (const, flip)
 import Lude.Haskell
+import Lude.IO
+import Lude.List
 
 -- TODO: Make applicative/monoidal functors a superclass.
 
@@ -64,3 +69,14 @@ fa >> fb = bind (const fb) fa
 
 (<<) :: forall f a b. (MonadicOn Function f) => f a -> f b -> f a
 fa << fb = bind (\a -> fb >> pure a) fa
+
+--------------------------------------------------------------------------------
+-- Interop
+
+instance (Prelude.Monad f) => Monadic (InteropFunctor f) where
+    pure = coerce Prelude.return
+    join = coerce (Prelude.>>= unInteropFunctor)
+    bind = coerce (Prelude.=<<)
+
+deriving via InteropFunctor IO instance Monadic IO
+deriving via InteropFunctor List instance Monadic List
diff --git a/src/Lude/Constraint/Predicate.hs b/src/Lude/Constraint/Predicate.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE IncoherentInstances #-}
+
 module Lude.Constraint.Predicate (
     Always,
     always,
@@ -14,6 +16,7 @@ import Lude.Haskell
 
 --------------------------------------------------------------------------------
 
+type role Always phantom
 type Always :: forall {i}. Predicate i
 class Always x
 instance forall x. Always x
@@ -23,6 +26,7 @@ always = Entail MkEvidence
 
 --------------------------------------------------------------------------------
 
+type role Never phantom
 type Never :: forall {i}. Predicate i
 class (Falsum) => Never x
 
diff --git a/src/Lude/IO.hs b/src/Lude/IO.hs
@@ -1,21 +1,7 @@
--- TODO
-{-# OPTIONS_GHC -Wno-orphans #-}
-
 module Lude.IO (
     IO,
 ) where
 
-import Control.Monad qualified
 import System.IO
 
-import Lude.Algebra.Category
-
 --------------------------------------------------------------------------------
-
-instance Functorial IO where
-    map = Control.Monad.fmap
-
-instance Monadic IO where
-    pure = Control.Monad.return
-    join = Control.Monad.join
-    bind = (Control.Monad.=<<)