e432f6d · rel8 · git.iko.soy

rel8.cabal+1

compare with master

unifiedsplit

@@ -67,6 +67,7 @@ library

67 Rel8.Kind.Labels

68 Rel8.Kind.Necessity

69

70+ Rel8.Generic.Map

70 Rel8.Generic.Record

71 Rel8.Generic.Record

71 Rel8.Generic.Table

72 Rel8.Generic.Table

72

73

src/Rel8/Generic/Map.hsnew file+93

@@ -0,0 +1,93 @@

1+{-# language AllowAmbiguousTypes #-}

2+{-# language DataKinds #-}

3+{-# language EmptyCase #-}

4+{-# language FlexibleInstances #-}

5+{-# language LambdaCase #-}

6+{-# language MultiParamTypeClasses #-}

7+{-# language RankNTypes #-}

8+{-# language ScopedTypeVariables #-}

9+{-# language StandaloneKindSignatures #-}

10+{-# language TypeApplications #-}

11+{-# language TypeFamilies #-}

12+{-# language TypeOperators #-}

13+{-# language UndecidableInstances #-}

14+

15+module Rel8.Generic.Map

16+ ( GMap, GMappable (gmap, gunmap)

17+ )

18+where

19+

20+-- base

21+import Data.Kind ( Constraint, Type )

22+import GHC.Generics

23+ ( (:+:)( L1, R1 ), (:*:)( (:*:) ), K1( K1 ), M1( M1 ), U1( U1 ), V1

24+ )

25+import Prelude ()

26+

27+-- rel8

28+import Rel8.FCF ( Eval, Exp )

29+

30+

31+type GMap :: (Type -> Exp Type) -> (Type -> Type) -> Type -> Type

32+type family GMap f rep where

33+ GMap f (M1 i c rep) = M1 i c (GMap f rep)

34+ GMap _ V1 = V1

35+ GMap f (rep1 :+: rep2) = GMap f rep1 :+: GMap f rep2

36+ GMap _ U1 = U1

37+ GMap f (rep1 :*: rep2) = GMap f rep1 :*: GMap f rep2

38+ GMap f (K1 i a) = K1 i (Eval (f a))

39+

40+

41+type GMappable :: (Type -> Exp Constraint) -> (Type -> Type) -> Constraint

42+class GMappable constraint rep where

43+ gmap :: ()

44+ => proxy f

45+ -> (forall a. Eval (constraint a) => a -> Eval (f a))

46+ -> rep x

47+ -> GMap f rep x

48+

49+ gunmap :: ()

50+ => proxy f

51+ -> (forall a. Eval (constraint a) => Eval (f a) -> a)

52+ -> GMap f rep x

53+ -> rep x

54+

55+

56+instance GMappable constraint rep => GMappable constraint (M1 i c rep) where

57+ gmap proxy f (M1 a) = M1 (gmap @constraint proxy f a)

58+ gunmap proxy f (M1 a) = M1 (gunmap @constraint proxy f a)

59+

60+

61+instance GMappable constraint V1 where

62+ gmap _ _ = \case

63+ gunmap _ _ = \case

64+

65+

66+instance (GMappable constraint rep1, GMappable constraint rep2) =>

67+ GMappable constraint (rep1 :+: rep2)

68+ where

69+ gmap proxy f = \case

70+ L1 a -> L1 (gmap @constraint proxy f a)

71+ R1 a -> R1 (gmap @constraint proxy f a)

72+ gunmap proxy f = \case

73+ L1 a -> L1 (gunmap @constraint proxy f a)

74+ R1 a -> R1 (gunmap @constraint proxy f a)

75+

76+

77+instance GMappable constraint U1 where

78+ gmap _ _ U1 = U1

79+ gunmap _ _ U1 = U1

80+

81+

82+instance (GMappable constraint rep1, GMappable constraint rep2) =>

83+ GMappable constraint (rep1 :*: rep2)

84+ where

85+ gmap proxy f (a :*: b) =

86+ gmap @constraint proxy f a :*: gmap @constraint proxy f b

87+ gunmap proxy f (a :*: b) =

88+ gunmap @constraint proxy f a :*: gunmap @constraint proxy f b

89+

90+

91+instance Eval (constraint a) => GMappable constraint (K1 i a) where

92+ gmap _ f (K1 a) = K1 (f a)

93+ gunmap _ f (K1 a) = K1 (f a)

src/Rel8/Generic/Table.hs+1−38

@@ -12,8 +12,7 @@

12{-# language UndecidableInstances #-}

13

14module Rel8.Generic.Table

15− ( GTable, GColumns, GContext, GUnreify

16− , fromGColumns, toGColumns, gtable, greify, gunreify

15+ ( GTable, GColumns, GContext, fromGColumns, toGColumns, gtable

17 )

16 )

18where

17where

19

18

@@ -54,14 +53,6 @@ type family GContext _Context rep where

54 GContext _Context (K1 _ a) = Eval (_Context a)

53 GContext _Context (K1 _ a) = Eval (_Context a)

55

54

56

55

57−type GUnreify :: (Type -> Exp a) -> (Type -> Type) -> Type -> Type

58−type family GUnreify _Unreify rep where

59− GUnreify _Unreify (M1 i c rep) = M1 i c (GUnreify _Unreify rep)

60− GUnreify _Unreify (rep1 :*: rep2) =

61− GUnreify _Unreify rep1 :*: GUnreify _Unreify rep2

62− GUnreify _Unreify (K1 i a) = K1 i (Eval (_Unreify a))

63−

64−

65type GTable

56type GTable

66 :: (Type -> Exp Constraint)

57 :: (Type -> Exp Constraint)

67 -> (Type -> Exp K.HTable)

58 -> (Type -> Exp K.HTable)

@@ -82,18 +73,6 @@ class GTable _Table _Columns context rep

82 => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)

73 => (forall a. Eval (_Table a) => Proxy a -> Eval (_Columns a) context)

83 -> GColumns _Columns rep context

74 -> GColumns _Columns rep context

84

75

85− greify :: ()

86− => Proxy _Unreify

87− -> (forall a. Eval (_Table a) => Eval (_Unreify a) -> a)

88− -> GUnreify _Unreify rep x

89− -> rep x

90−

91− gunreify :: ()

92− => Proxy _Unreify

93− -> (forall a. Eval (_Table a) => a -> Eval (_Unreify a))

94− -> rep x

95− -> GUnreify _Unreify rep x

96−

97

76

98instance GTable _Table _Columns context rep =>

77instance GTable _Table _Columns context rep =>

99 GTable _Table _Columns context (M1 D c rep)

78 GTable _Table _Columns context (M1 D c rep)

@@ -103,10 +82,6 @@ instance GTable _Table _Columns context rep =>

103 toGColumns toColumns (M1 a) =

82 toGColumns toColumns (M1 a) =

104 toGColumns @_Table @_Columns @context @rep toColumns a

83 toGColumns @_Table @_Columns @context @rep toColumns a

105 gtable = gtable @_Table @_Columns @context @rep

84 gtable = gtable @_Table @_Columns @context @rep

106− greify proxy reify (M1 a) =

107− M1 (greify @_Table @_Columns @context @rep proxy reify a)

108− gunreify proxy unreify (M1 a) =

109− M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)

110

85

111

86

112instance GTable _Table _Columns context rep =>

87instance GTable _Table _Columns context rep =>

@@ -117,10 +92,6 @@ instance GTable _Table _Columns context rep =>

117 toGColumns toColumns (M1 a) =

92 toGColumns toColumns (M1 a) =

118 toGColumns @_Table @_Columns @context @rep toColumns a

93 toGColumns @_Table @_Columns @context @rep toColumns a

119 gtable = gtable @_Table @_Columns @context @rep

94 gtable = gtable @_Table @_Columns @context @rep

120− greify proxy reify (M1 a) =

121− M1 (greify @_Table @_Columns @context @rep proxy reify a)

122− gunreify proxy unreify (M1 a) =

123− M1 (gunreify @_Table @_Columns @context @rep proxy unreify a)

124

95

125

96

126instance

97instance

@@ -138,12 +109,6 @@ instance

138 gtable table = HProduct

109 gtable table = HProduct

139 (gtable @_Table @_Columns @context @rep1 table)

110 (gtable @_Table @_Columns @context @rep1 table)

140 (gtable @_Table @_Columns @context @rep2 table)

111 (gtable @_Table @_Columns @context @rep2 table)

141− greify proxy reify (a :*: b) =

142− greify @_Table @_Columns @context @rep1 proxy reify a :*:

143− greify @_Table @_Columns @context @rep2 proxy reify b

144− gunreify proxy unreify (a :*: b) =

145− gunreify @_Table @_Columns @context @rep1 proxy unreify a :*:

146− gunreify @_Table @_Columns @context @rep2 proxy unreify b

147

112

148

113

149instance

114instance

@@ -159,5 +124,3 @@ instance

159 fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler

124 fromGColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler

160 toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)

125 toGColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)

161 gtable table = hlabel hlabeler (table (Proxy @a))

126 gtable table = hlabel hlabeler (table (Proxy @a))

162− greify _ reify (M1 (K1 a)) = M1 (K1 (reify a))

163− gunreify _ unreify (M1 (K1 a)) = M1 (K1 (unreify a))

src/Rel8/Schema/Field.hs+1

@@ -3,6 +3,7 @@

3{-# language GADTs #-}

4{-# language LambdaCase #-}

5{-# language MultiParamTypeClasses #-}

6+{-# language RankNTypes #-}

6{-# language StandaloneKindSignatures #-}

7{-# language StandaloneKindSignatures #-}

7{-# language TypeFamilies #-}

8{-# language TypeFamilies #-}

8{-# language UndecidableInstances #-}

9{-# language UndecidableInstances #-}

src/Rel8/Schema/Generic.hs+8−13

@@ -30,12 +30,9 @@ import Rel8.Kind.Context

30 , Reifiable, contextSing

31 , sLabelable, sReifiable

32 )

33+import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )

33import Rel8.Generic.Record ( Record(..) )

34import Rel8.Generic.Record ( Record(..) )

34−import Rel8.Generic.Table

35− ( GTable, GColumns, fromGColumns, toGColumns

35+import Rel8.Generic.Table ( GTable, GColumns, fromGColumns, toGColumns )

36− , GUnreify

37− )

38−import qualified Rel8.Generic.Table as G

39import Rel8.Schema.Context ( Col )

36import Rel8.Schema.Context ( Col )

40import Rel8.Schema.Context.Label ( Labelable )

37import Rel8.Schema.Context.Label ( Labelable )

41import Rel8.Schema.Dict ( Dict( Dict ) )

38import Rel8.Schema.Dict ( Dict( Dict ) )

@@ -160,29 +157,27 @@ class HTable (GRep t) => Rel8able t where

160 default greify :: forall context.

157 default greify :: forall context.

161 ( Generic (Record (t context))

158 ( Generic (Record (t context))

162 , Generic (Record (t (Reify context)))

159 , Generic (Record (t (Reify context)))

163− , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))

160+ , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))

164− , Rep (Record (t context)) ~ GUnreify TUnreify (Rep (Record (t (Reify context))))

161+ , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))

165 )

162 )

166 => t context -> t (Reify context)

163 => t context -> t (Reify context)

167 greify =

164 greify =

168 unrecord .

165 unrecord .

169 to .

166 to .

170− G.greify @(TTable (Reify context)) @TColumns @(Col (Reify context)) (Proxy @TUnreify)

167+ gunmap @(TTable (Reify context)) (Proxy @TUnreify) (reify Refl) .

171− (reify Refl) .

172 from .

168 from .

173 Record

169 Record

174

170

175 default gunreify :: forall context.

171 default gunreify :: forall context.

176 ( Generic (Record (t context))

172 ( Generic (Record (t context))

177 , Generic (Record (t (Reify context)))

173 , Generic (Record (t (Reify context)))

178− , GTable (TTable (Reify context)) TColumns (Col (Reify context)) (Rep (Record (t (Reify context))))

174+ , GMappable (TTable (Reify context)) (Rep (Record (t (Reify context))))

179− , Rep (Record (t context)) ~ GUnreify TUnreify (Rep (Record (t (Reify context))))

175+ , Rep (Record (t context)) ~ GMap TUnreify (Rep (Record (t (Reify context))))

180 )

176 )

181 => t (Reify context) -> t context

177 => t (Reify context) -> t context

182 gunreify =

178 gunreify =

183 unrecord .

179 unrecord .

184 to .

180 to .

185− G.gunreify @(TTable (Reify context)) @TColumns @(Col (Reify context)) (Proxy @TUnreify)

181+ gmap @(TTable (Reify context)) (Proxy @TUnreify) (unreify Refl) .

186− (unreify Refl) .

187 from .

182 from .

188 Record

183 Record

src/Rel8/Schema/HTable.hs+6−1

@@ -16,7 +16,7 @@

16module Rel8.Schema.HTable

17 ( HTable (HField, HConstrainTable)

18 , hfield, htabulate, htraverse, hdicts, hspecs

19− , htabulateA

19+ , hmap, htabulateA

20 )

21where

22

@@ -114,6 +114,11 @@ class HTable t where

114 {-# INLINABLE hspecs #-}

115

116

117+hmap :: HTable t

118+ => (forall spec. context spec -> context' spec) -> t context -> t context'

119+hmap f a = htabulate $ \field -> f (hfield a field)

120+

121+

117htabulateA :: (HTable t, Apply m)

122htabulateA :: (HTable t, Apply m)

118 => (forall spec. HField t spec -> m (context spec)) -> m (t context)

123 => (forall spec. HField t spec -> m (context spec)) -> m (t context)

119htabulateA f = htraverse getCompose $ htabulate $ Compose . f

124htabulateA f = htraverse getCompose $ htabulate $ Compose . f

src/Rel8/Schema/Reify.hs+3−4

@@ -24,7 +24,7 @@ import Prelude

24-- rel8

25import Rel8.Schema.Context ( Interpretation, Col )

26import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )

27−import Rel8.Schema.HTable ( HTable, hfield, htabulate )

27+import Rel8.Schema.HTable ( HTable, hmap )

28import Rel8.Schema.Kind ( Context )

29

30

@@ -42,12 +42,11 @@ instance Labelable context => Labelable (Reify context) where

42

43

44hreify :: HTable t => t (Col context) -> t (Col (Reify context))

45−hreify a = htabulate $ \field -> Reify (hfield a field)

45+hreify = hmap Reify

46

47

48hunreify :: HTable t => t (Col (Reify context)) -> t (Col context)

49−hunreify a = htabulate $ \field -> case hfield a field of

49+hunreify = hmap (\(Reify a) -> a)

50− Reify x -> x

51

50

52

51

53type UnwrapReify :: Context -> Context

52type UnwrapReify :: Context -> Context

src/Rel8/Table.hs+8−10

@@ -33,9 +33,9 @@ import Prelude hiding ( null )

33

34-- rel8

35import Rel8.FCF ( Eval, Exp )

36+import Rel8.Generic.Map ( GMap, GMappable, gmap, gunmap )

36import Rel8.Generic.Table

37import Rel8.Generic.Table

37− ( GTable, GColumns, GContext, GUnreify

38+ ( GTable, GColumns, GContext, fromGColumns, toGColumns

38− , fromGColumns, toGColumns, greify, gunreify

39 )

40import Rel8.Generic.Record ( Record(..) )

41import Rel8.Schema.Context ( Col(..) )

@@ -124,30 +124,28 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

124 default reify ::

125 ( Generic (Record a)

126 , Generic (Record (Unreify a))

127− , GTable (TTable context) TColumns (Col context) (Rep (Record a))

127+ , GMappable (TTable context) (Rep (Record a))

128− , Rep (Record (Unreify a)) ~ GUnreify TUnreify (Rep (Record a))

128+ , Rep (Record (Unreify a)) ~ GMap TUnreify (Rep (Record a))

129 )

130 => context :~: Reify ctx -> Unreify a -> a

131 reify Refl =

132 unrecord .

133 to .

134− greify @(TTable context) @TColumns @(Col context) (Proxy @TUnreify)

134+ gunmap @(TTable context) (Proxy @TUnreify) (reify Refl) .

135− (reify Refl) .

136 from .

135 from .

137 Record

136 Record

138

137

139 default unreify ::

138 default unreify ::

140 ( Generic (Record a)

139 ( Generic (Record a)

141 , Generic (Record (Unreify a))

140 , Generic (Record (Unreify a))

142− , GTable (TTable context) TColumns (Col context) (Rep (Record a))

141+ , GMappable (TTable context) (Rep (Record a))

143− , Rep (Record (Unreify a)) ~ GUnreify TUnreify (Rep (Record a))

142+ , Rep (Record (Unreify a)) ~ GMap TUnreify (Rep (Record a))

144 )

143 )

145 => context :~: Reify ctx -> a -> Unreify a

144 => context :~: Reify ctx -> a -> Unreify a

146 unreify Refl =

145 unreify Refl =

147 unrecord .

146 unrecord .

148 to .

147 to .

149− gunreify @(TTable context) @TColumns @(Col context) (Proxy @TUnreify)

148+ gmap @(TTable context) (Proxy @TUnreify) (unreify Refl) .

150− (unreify Refl) .

151 from .

149 from .

152 Record

150 Record

153

151