lude

Haskell prelude alternative
git clone git://git.rr3.xyz/lude | git clone gits://git.rr3.xyz/lude
Log | Files | Refs | README | LICENSE

Generic.hs (3959B)

      1 {-# LANGUAGE UndecidableInstances #-}
      2 {-# LANGUAGE UndecidableSuperClasses #-}
      3 
      4 module Lude.Haskell.Generic (
      5     Generic (..),
      6     Generic1 (..),
      7     Genericity (..),
      8     grep,
      9     Generically,
     10     Genericity1 (..),
     11     grep1,
     12     Generically1,
     13     GVoid,
     14     elimGVoid,
     15     GUnit,
     16     pattern MkGUnit,
     17     elimGUnit,
     18     GConst,
     19     pattern MkGConst,
     20     unGConst,
     21     GMeta,
     22     pattern MkGMeta,
     23     unGMeta,
     24     GSum,
     25     pattern GLeft,
     26     pattern GRight,
     27     elimGSum,
     28     GProd,
     29     pattern GPair,
     30     elimGProd,
     31 ) where
     32 
     33 import GHC.Generics (Generic, Generic1)
     34 import GHC.Generics qualified as G
     35 
     36 import Lude.Haskell.Constraint
     37 import Lude.Haskell.Core
     38 import Lude.Haskell.Functional
     39 import Lude.Haskell.Type
     40 
     41 --------------------------------------------------------------------------------
     42 
     43 type Genericity :: Endo Type
     44 newtype Genericity a = MkGenericity {unGenericity :: a}
     45 
     46 grep :: forall (a :: Type). (Generic a) => Genericity a -> G.Rep a a
     47 grep (MkGenericity x) = G.from x
     48 
     49 type Generically :: Endo (Type -> Constraint)
     50 class (Generic a, c (G.Rep a a)) => Generically c a
     51 instance (Generic a, c (G.Rep a a)) => Generically c a
     52 
     53 --------------------------------------------------------------------------------
     54 
     55 type Genericity1 :: forall {k}. Endo (k -> Type)
     56 newtype Genericity1 f p = MkGenericity1 {unGenericity1 :: f p}
     57 
     58 grep1 :: forall {k} (f :: k -> Type) (p :: k). (Generic1 f) => Genericity1 f p -> G.Rep1 f p
     59 grep1 (MkGenericity1 x) = G.from1 x
     60 
     61 type Generically1 :: forall {k}. Endo ((k -> Type) -> Constraint)
     62 class (Generic1 f, c (G.Rep1 f)) => Generically1 c f
     63 instance (Generic1 f, c (G.Rep1 f)) => Generically1 c f
     64 
     65 --------------------------------------------------------------------------------
     66 
     67 type GVoid = G.V1
     68 
     69 elimGVoid :: forall {k} (p :: k) {r :: Repr} (b :: Type# r). GVoid p -> b
     70 elimGVoid = \case {}
     71 {-# INLINE elimGVoid #-}
     72 
     73 --------------------------------------------------------------------------------
     74 
     75 type GUnit = G.U1
     76 
     77 pattern MkGUnit :: forall {k} (p :: k). GUnit p
     78 pattern MkGUnit = G.U1
     79 {-# COMPLETE MkGUnit #-}
     80 
     81 elimGUnit :: forall {k} (p :: k) {r :: Repr} (b :: Type# r). Lev b -> (GUnit p -> b)
     82 elimGUnit unit = \MkGUnit -> unit
     83 {-# INLINE elimGUnit #-}
     84 
     85 --------------------------------------------------------------------------------
     86 
     87 type GConst = G.K1
     88 
     89 pattern MkGConst :: forall {k} i (a :: Type) (p :: k). a -> GConst i a p
     90 pattern MkGConst x = G.K1 x
     91 {-# COMPLETE MkGConst #-}
     92 
     93 unGConst :: forall {k} i (a :: Type) (p :: k). GConst i a p -> a
     94 unGConst = G.unK1
     95 
     96 --------------------------------------------------------------------------------
     97 
     98 type GMeta = G.M1
     99 
    100 pattern MkGMeta :: forall {k} i (m :: G.Meta) (f :: k -> Type) (p :: k). f p -> GMeta i m f p
    101 pattern MkGMeta x = G.M1 x
    102 {-# COMPLETE MkGMeta #-}
    103 
    104 unGMeta :: forall {k} i (m :: G.Meta) (f :: k -> Type) (p :: k). GMeta i m f p -> f p
    105 unGMeta = G.unM1
    106 
    107 --------------------------------------------------------------------------------
    108 
    109 type GSum = (G.:+:)
    110 
    111 pattern GLeft :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). f p -> GSum f g p
    112 pattern GLeft x = G.L1 x
    113 pattern GRight :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). g p -> GSum f g p
    114 pattern GRight y = G.R1 y
    115 {-# COMPLETE GLeft, GRight #-}
    116 
    117 elimGSum
    118     :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k) {r :: Repr} (b :: Type# r)
    119      . (f p -> b) -> (g p -> b) -> (GSum f g p -> b)
    120 elimGSum left right = \case
    121     GLeft x -> left x
    122     GRight y -> right y
    123 {-# INLINE elimGSum #-}
    124 
    125 --------------------------------------------------------------------------------
    126 
    127 type GProd = (G.:*:)
    128 
    129 pattern GPair :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k). f p -> g p -> GProd f g p
    130 pattern GPair x y = x G.:*: y
    131 {-# COMPLETE GPair #-}
    132 
    133 elimGProd
    134     :: forall {k} (f :: k -> Type) (g :: k -> Type) (p :: k) {r :: Repr} (b :: Type# r)
    135      . (f p -> g p -> b) -> (GProd f g p -> b)
    136 elimGProd pair = \(GPair x y) -> pair x y
    137 {-# INLINE elimGProd #-}