lude

commit cdc3b2b3e893c8bb76c34d9153c6ed4944cda950
parent 375ae8f19c95cb47bd5133660135ed952e8e7f93
Author: Robert Russell <robert@rr3.xyz>
Date:   Wed, 16 Sep 2026 13:13:22 -0700

Haskell: add Generic module

Diffstat:
M
package.yaml
 | 
1
+
M
src/Lude/Haskell.hs
 | 
1
+
A
src/Lude/Haskell/Generic.hs
 | 
138
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

3 files changed, 140 insertions(+), 0 deletions(-)
diff --git a/package.yaml b/package.yaml
@@ -31,6 +31,7 @@ language: GHC2024
 default-extensions:
     - BlockArguments
     - DefaultSignatures
+    - DeriveAnyClass
     - DerivingVia
     - ExtendedLiterals
     - FunctionalDependencies
diff --git a/src/Lude/Haskell.hs b/src/Lude/Haskell.hs
@@ -8,6 +8,7 @@ import Lude.Haskell.Category as X -- TODO: Probably hide some stuff from here.
 import Lude.Haskell.Constraint as X
 import Lude.Haskell.Equality as X
 import Lude.Haskell.Functional as X
+import Lude.Haskell.Generic as X hiding (Rep, Rep1, from, from1, to, to1)
 import Lude.Haskell.Kind as X
 import Lude.Haskell.Repr as X (Repr)
 import Lude.Haskell.Type as X
diff --git a/src/Lude/Haskell/Generic.hs b/src/Lude/Haskell/Generic.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE UndecidableSuperClasses #-}
+
+module Lude.Haskell.Generic (
+    Generic (..),
+    Generic1 (..),
+    Genericity (..),
+    grep,
+    Generically,
+    Genericity1 (..),
+    grep1,
+    Generically1,
+    GVoid,
+    elimGVoid,
+    GUnit,
+    pattern MkGUnit,
+    elimGUnit,
+    GConst,
+    pattern MkGConst,
+    unGConst,
+    GMeta,
+    pattern MkGMeta,
+    unGMeta,
+    GSum,
+    pattern GLeft,
+    pattern GRight,
+    elimGSum,
+    GProd,
+    pattern GPair,
+    elimGProd,
+) where
+
+import GHC.Generics (Generic, Generic1)
+import GHC.Generics qualified as G
+
+import Lude.Haskell.Constraint
+import Lude.Haskell.Functional
+import Lude.Haskell.Kind
+import Lude.Haskell.Repr
+import Lude.Haskell.Type
+
+--------------------------------------------------------------------------------
+
+type Genericity :: Endo Type
+newtype Genericity a = MkGenericity {unGenericity :: a}
+
+grep :: forall (a :: Type). (Generic a) => Genericity a -> G.Rep a a
+grep (MkGenericity x) = G.from x
+
+type Generically :: Endo (Type -> Constraint)
+class (Generic a, c (G.Rep a a)) => Generically c a
+instance (Generic a, c (G.Rep a a)) => Generically c a
+
+--------------------------------------------------------------------------------
+
+type Genericity1 :: forall {k}. Endo (k -> Type)
+newtype Genericity1 f p = MkGenericity1 {unGenericity1 :: f p}
+
+grep1 :: forall {k} (f :: k -> Type) (p :: k). (Generic1 f) => Genericity1 f p -> G.Rep1 f p
+grep1 (MkGenericity1 x) = G.from1 x
+
+type Generically1 :: forall {k}. Endo ((k -> Type) -> Constraint)
+class (Generic1 f, c (G.Rep1 f)) => Generically1 c f
+instance (Generic1 f, c (G.Rep1 f)) => Generically1 c f
+
+--------------------------------------------------------------------------------
+
+type GVoid = G.V1
+
+elimGVoid :: forall {k} (p :: k) {r} (b :: Type @r). GVoid p -> b
+elimGVoid = \case {}
+{-# INLINE elimGVoid #-}
+
+--------------------------------------------------------------------------------
+
+type GUnit = G.U1
+
+pattern MkGUnit :: forall {k} (p :: k). GUnit p
+pattern MkGUnit = G.U1
+{-# COMPLETE MkGUnit #-}
+
+elimGUnit :: forall {k} (p :: k) {r} (b :: Type @r). Lev b -> (GUnit p -> b)
+elimGUnit unit = \MkGUnit -> unit
+{-# INLINE elimGUnit #-}
+
+--------------------------------------------------------------------------------
+
+type GConst = G.K1
+
+pattern MkGConst :: forall {k} i (a :: Type) (p :: k). a -> GConst i a p
+pattern MkGConst x = G.K1 x
+{-# COMPLETE MkGConst #-}
+
+unGConst :: forall {k} i (a :: Type) (p :: k). GConst i a p -> a
+unGConst = G.unK1
+
+--------------------------------------------------------------------------------
+
+type GMeta = G.M1
+
+pattern MkGMeta :: forall {k} i (m :: G.Meta) (f :: k -> Type) (p :: k). f p -> GMeta i m f p
+pattern MkGMeta x = G.M1 x
+{-# COMPLETE MkGMeta #-}
+
+unGMeta :: forall {k} i (m :: G.Meta) (f :: k -> Type) (p :: k). GMeta i m f p -> f p
+unGMeta = G.unM1
+
+--------------------------------------------------------------------------------
+
+type GSum = (G.:+:)
+
+pattern GLeft :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). f p -> GSum f g p
+pattern GLeft x = G.L1 x
+pattern GRight :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). g p -> GSum f g p
+pattern GRight y = G.R1 y
+{-# COMPLETE GLeft, GRight #-}
+
+elimGSum
+    :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k) {r :: Repr} (b :: Type @r)
+     . (f p -> b) -> (g p -> b) -> (GSum f g p -> b)
+elimGSum left right = \case
+    GLeft x -> left x
+    GRight y -> right y
+{-# INLINE elimGSum #-}
+
+--------------------------------------------------------------------------------
+
+type GProd = (G.:*:)
+
+pattern GPair :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). f p -> g p -> GProd f g p
+pattern GPair x y = x G.:*: y
+{-# COMPLETE GPair #-}
+
+elimGProd
+    :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k) {r :: Repr} (b :: Type @r)
+     . (f p -> g p -> b) -> (GProd f g p -> b)
+elimGProd pair = \(GPair x y) -> pair x y
+{-# INLINE elimGProd #-}