e432f6d · rel8 · git.iko.soy

git.iko.soy/rel8

Split greify and gunreify out of GTable

There is actually nothing specific to `reify` in the `Generic` version of these operations, they're actually just a specific instance of a much more general `gmap` operation. This now lives in `Rel8.Generic.Map`.

commite432f6d06836f25689d30719b14953f253826d71 authorShane O'Brien <shane.obrien@circuithub.com> dateMon 26 Apr 2021, 22:26 (6 years ago) parent1c73ec6

8 files changed+121−66

compare with master

unifiedsplit

rel8.cabal+1 src/Rel8/Generic/Map.hs+93 src/Rel8/Generic/Table.hs+1−38 src/Rel8/Schema/Field.hs+1 src/Rel8/Schema/Generic.hs+8−13 src/Rel8/Schema/HTable.hs+6−1 src/Rel8/Schema/Reify.hs+3−4 src/Rel8/Table.hs+8−10

rel8.cabal+1

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

6767 Rel8.Kind.Labels

6868 Rel8.Kind.Necessity

6969

70+ Rel8.Generic.Map

7071 Rel8.Generic.Record

7172 Rel8.Generic.Table

7273

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 @@

1212{-# language UndecidableInstances #-}

1313

1414module Rel8.Generic.Table

15− ( GTable, GColumns, GContext, GUnreify

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

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

1716 )

1817where

1918

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

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

5554

5655

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−

6556type GTable

6657 :: (Type -> Exp Constraint)

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

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

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

8374 -> GColumns _Columns rep context

8475

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−

9776

9877instance GTable _Table _Columns context rep =>

9978 GTable _Table _Columns context (M1 D c rep)

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

10382 toGColumns toColumns (M1 a) =

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

10584 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)

11085

11186

11287instance GTable _Table _Columns context rep =>

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

11792 toGColumns toColumns (M1 a) =

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

11994 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)

12495

12596

12697instance

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

138109 gtable table = HProduct

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

140111 (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

147112

148113

149114instance

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

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

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

161126 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 @@

33{-# language GADTs #-}

44{-# language LambdaCase #-}

55{-# language MultiParamTypeClasses #-}

6+{-# language RankNTypes #-}

67{-# language StandaloneKindSignatures #-}

78{-# language TypeFamilies #-}

89{-# language UndecidableInstances #-}

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

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

3030 , Reifiable, contextSing

3131 , sLabelable, sReifiable

3232 )

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

3334import Rel8.Generic.Record ( Record(..) )

34−import Rel8.Generic.Table

35− ( GTable, GColumns, fromGColumns, toGColumns

36− , GUnreify

37− )

38−import qualified Rel8.Generic.Table as G

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

3936import Rel8.Schema.Context ( Col )

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

4138import Rel8.Schema.Dict ( Dict( Dict ) )

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

160157 default greify :: forall context.

161158 ( Generic (Record (t context))

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

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

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

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

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

165162 )

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

167164 greify =

168165 unrecord .

169166 to .

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

171− (reify Refl) .

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

172168 from .

173169 Record

174170

175171 default gunreify :: forall context.

176172 ( Generic (Record (t context))

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

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

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

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

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

180176 )

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

182178 gunreify =

183179 unrecord .

184180 to .

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

186− (unreify Refl) .

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

187182 from .

188183 Record

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

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

1616module Rel8.Schema.HTable

1717 ( HTable (HField, HConstrainTable)

1818 , hfield, htabulate, htraverse, hdicts, hspecs

19− , htabulateA

19+ , hmap, htabulateA

2020 )

2121where

2222

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

114114 {-# INLINABLE hspecs #-}

115115

116116

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+

117122htabulateA :: (HTable t, Apply m)

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

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

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

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

2424-- rel8

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

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

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

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

2828import Rel8.Schema.Kind ( Context )

2929

3030

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

4242

4343

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

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

45+hreify = hmap Reify

4646

4747

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

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

50− Reify x -> x

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

5150

5251

5352type UnwrapReify :: Context -> Context

src/Rel8/Table.hs+8−10

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

3333

3434-- rel8

3535import Rel8.FCF ( Eval, Exp )

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

3637import Rel8.Generic.Table

37− ( GTable, GColumns, GContext, GUnreify

38− , fromGColumns, toGColumns, greify, gunreify

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

3939 )

4040import Rel8.Generic.Record ( Record(..) )

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

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

124124 default reify ::

125125 ( Generic (Record a)

126126 , Generic (Record (Unreify a))

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

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

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

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

129129 )

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

131131 reify Refl =

132132 unrecord .

133133 to .

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

135− (reify Refl) .

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

136135 from .

137136 Record

138137

139138 default unreify ::

140139 ( Generic (Record a)

141140 , Generic (Record (Unreify a))

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

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

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

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

144143 )

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

146145 unreify Refl =

147146 unrecord .

148147 to .

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

150− (unreify Refl) .

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

151149 from .

152150 Record

153151