d028b37 · rel8 · git.iko.soy

git.iko.soy/rel8

Changes necessary to allow nesting Lift and HADT inside ListTable

commitd028b37ed4aa02e3bffd786425eb6c4f010b4a78 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 6 May 2021, 01:10 (6 years ago) parent5b1faf2

6 files changed+57−38

compare with master

unifiedsplit

src/Rel8/Column/Field.hs+1−1 src/Rel8/Column/List.hs+13−12 src/Rel8/Column/NonEmpty.hs+13−12 src/Rel8/Generic/Rel8able/Test.hs+11−3 src/Rel8/Table/HKD.hs+14−2 src/Rel8/Table/Unreify.hs+5−8

src/Rel8/Column/Field.hs+1−1

@@ -58,7 +58,7 @@ instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>

5858 Table (Reify context) (AField context necessity a)

5959 where

6060 type Context (AField context necessity a) = Reify context

61− type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)

61+ type Columns (AField context necessity a) = HIdentity ('Spec '[] necessity a)

6262 type Unreify (AField context necessity a) = Field context necessity a

6363

6464 fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a

src/Rel8/Column/List.hs+13−12

@@ -33,10 +33,7 @@ import Rel8.Table

3333 )

3434import Rel8.Table.List ( ListTable( ListTable ) )

3535import Rel8.Table.Recontextualize ( Recontextualize )

36−import Rel8.Table.Unreify

37− ( Unreifiability( Unreifiability )

38− , Unreifiable, unreifiability

39− )

36+import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability )

4037

4138

4239type HList :: K.Context -> Type -> Type

@@ -129,19 +126,23 @@ stoColumnsList = \case

129126 (\(AHList a) -> a)

130127

131128

132−sreifyList :: ()

129+sreifyList :: Table (Reify context) a

133130 => Unreifiability context a

134131 -> HList context (Unreify a)

135132 -> AHList context a

136−sreifyList (Unreifiability context) =

137− smapList context (reify Refl) hreify .

138− AHList

133+sreifyList = \case

134+ UResult -> AHList . fmap (reify Refl)

135+ Unreifiability context ->

136+ smapList context (reify Refl) hreify .

137+ AHList

139138

140139

141−sunreifyList :: ()

140+sunreifyList :: Table (Reify context) a

142141 => Unreifiability context a

143142 -> AHList context a

144143 -> HList context (Unreify a)

145−sunreifyList (Unreifiability context) =

146− (\(AHList a) -> a) .

147− smapList context (unreify Refl) hunreify

144+sunreifyList = \case

145+ UResult -> fmap (unreify Refl) . (\(AHList a) -> a)

146+ Unreifiability context ->

147+ (\(AHList a) -> a) .

148+ smapList context (unreify Refl) hunreify

src/Rel8/Column/NonEmpty.hs+13−12

@@ -34,10 +34,7 @@ import Rel8.Table

3434 )

3535import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )

3636import Rel8.Table.Recontextualize ( Recontextualize )

37−import Rel8.Table.Unreify

38− ( Unreifiability( Unreifiability )

39− , Unreifiable, unreifiability

40− )

37+import Rel8.Table.Unreify ( Unreifiability(..), Unreifiable, unreifiability )

4138

4239

4340type HNonEmpty :: K.Context -> Type -> Type

@@ -131,19 +128,23 @@ stoColumnsNonEmpty = \case

131128 (\(AHNonEmpty a) -> a)

132129

133130

134−sreifyNonEmpty :: ()

131+sreifyNonEmpty :: Table (Reify context) a

135132 => Unreifiability context a

136133 -> HNonEmpty context (Unreify a)

137134 -> AHNonEmpty context a

138−sreifyNonEmpty (Unreifiability context) =

139− smapNonEmpty context (reify Refl) hreify .

140− AHNonEmpty

135+sreifyNonEmpty = \case

136+ UResult -> AHNonEmpty . fmap (reify Refl)

137+ Unreifiability context ->

138+ smapNonEmpty context (reify Refl) hreify .

139+ AHNonEmpty

141140

142141

143−sunreifyNonEmpty :: ()

142+sunreifyNonEmpty :: Table (Reify context) a

144143 => Unreifiability context a

145144 -> AHNonEmpty context a

146145 -> HNonEmpty context (Unreify a)

147−sunreifyNonEmpty (Unreifiability context) =

148− (\(AHNonEmpty a) -> a) .

149− smapNonEmpty context (unreify Refl) hunreify

146+sunreifyNonEmpty = \case

147+ UResult -> fmap (unreify Refl) . (\(AHNonEmpty a) -> a)

148+ Unreifiability context ->

149+ (\(AHNonEmpty a) -> a) .

150+ smapNonEmpty context (unreify Refl) hunreify

src/Rel8/Generic/Rel8able/Test.hs+11−3

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

77{-# language MultiParamTypeClasses #-}

88{-# language StandaloneDeriving #-}

99{-# language TypeFamilies #-}

10+{-# language UndecidableInstances #-}

1011

1112{-# options_ghc -O0 #-}

1213

@@ -26,7 +27,7 @@ import Rel8

2627import Data.Text ( Text )

2728

2829

29−data Table f = Table

30+data TableTest f = TableTest

3031 { foo :: Column f Bool

3132 , bar :: Column f (Maybe Bool)

3233 }

@@ -97,6 +98,10 @@ data S3Object = S3Object

9798 deriving stock Generic

9899

99100

101+deriving via HKDT S3Object

102+ instance Table Result S3Object

103+

104+

100105deriving via HKDT S3Object

101106 instance x ~ HKD S3Object Expr => ToExprs x S3Object

102107

@@ -105,6 +110,10 @@ data HKDSum = HKDSumA Text | HKDSumB Bool Char

105110 deriving stock Generic

106111

107112

113+deriving via HKDT HKDSum

114+ instance Table Result HKDSum

115+

116+

108117deriving via HKDT HKDSum

109118 instance x ~ HKD HKDSum Expr => ToExprs x HKDSum

110119

@@ -142,8 +151,7 @@ data TableSum f

142151data TableProduct f = TableProduct

143152 { sum :: HADT f TableSum

144153 , list :: TableList f

145− , foos :: HList f (ADT TableSum f)

146− , bars :: HList f (HKD HKDSum f)

154+ , foos :: HList f (HADT f TableSum, Lift f HKDSum, HKDTest f)

147155 }

148156 deriving stock Generic

149157 deriving anyclass Rel8able

src/Rel8/Table/HKD.hs+14−2

@@ -28,6 +28,7 @@ where

2828import Data.Kind ( Constraint, Type )

2929import Data.Proxy ( Proxy( Proxy ) )

3030import Data.Type.Equality ( (:~:)( Refl ) )

31+import Data.Void ( Void )

3132import GHC.Generics ( Generic, Rep, from, to )

3233import Prelude

3334

@@ -62,10 +63,10 @@ import qualified Rel8.Schema.Kind as K

6263import Rel8.Schema.HTable ( HTable )

6364import Rel8.Schema.Insert ( Insert )

6465import Rel8.Schema.Name ( Name )

65−import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )

66+import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )

6667import Rel8.Schema.Result ( Result )

6768import Rel8.Table

68− ( Table, Columns

69+ ( Table, Columns, Context, Unreify

6970 , fromColumns, toColumns, reify, unreify

7071 , TTable, TColumns, TUnreify

7172 )

@@ -138,6 +139,17 @@ newtype HKDT a = HKDT

138139 }

139140

140141

142+instance HKDable a => Table Result (HKDT a) where

143+ type Columns (HKDT a) = GColumnsHKD a

144+ type Context (HKDT a) = Result

145+ type Unreify (HKDT a) = Void

146+

147+ fromColumns = HKDT . fromHKD . HKD

148+ toColumns = (\(HKD a) -> a) . toHKD . (\(HKDT a) -> a)

149+ reify = notReify

150+ unreify = notReify

151+

152+

141153instance

142154 ( Table Expr (HKD a Expr)

143155 , Columns (HKD a Expr) ~ GColumns (HKD a)

src/Rel8/Table/Unreify.hs+5−8

@@ -27,7 +27,7 @@

2727-- @Table@)

2828

2929module Rel8.Table.Unreify

30− ( Unreifiable, Unreifiability( Unreifiability ), unreifiability

30+ ( Unreifiable, Unreifiability(..), unreifiability

3131 , Unreifies

3232 )

3333where

@@ -61,7 +61,6 @@ class

6161 , Context a ~ Reify Expr => Unreifier Expr a

6262 , Context a ~ Reify Insert => Unreifier Insert a

6363 , Context a ~ Reify Name => Unreifier Name a

64− , Context a ~ Reify Result => Unreifier Result a

6564 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

6665 )

6766 => Unreifiable a

@@ -70,7 +69,6 @@ instance

7069 , Context a ~ Reify Expr => Unreifier Expr a

7170 , Context a ~ Reify Insert => Unreifier Insert a

7271 , Context a ~ Reify Name => Unreifier Name a

73− , Context a ~ Reify Result => Unreifier Result a

7472 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

7573 )

7674 => Unreifiable a

@@ -78,14 +76,12 @@ instance

7876

7977type Unreifier :: K.Context -> Type -> Constraint

8078class

81− ( Table (Reify context) a

82− , Table context (Unreify a)

79+ ( Table context (Unreify a)

8380 , Congruent a (Unreify a)

8481 )

8582 => Unreifier context a

8683instance

87− ( Table (Reify context) a

88− , Table context (Unreify a)

84+ ( Table context (Unreify a)

8985 , Congruent a (Unreify a)

9086 )

9187 => Unreifier context a

@@ -93,6 +89,7 @@ instance

9389

9490type Unreifiability :: K.Context -> Type -> Type

9591data Unreifiability context a where

92+ UResult :: Unreifiability Result a

9693 Unreifiability :: Unreifier context a

9794 => SContext context -> Unreifiability context a

9895

@@ -104,6 +101,6 @@ unreifiability = \case

104101 SExpr -> Unreifiability SExpr

105102 SInsert -> Unreifiability SInsert

106103 SName -> Unreifiability SName

107− SResult -> Unreifiability SResult

104+ SResult -> UResult

108105 SReify context -> case sReifiable context of

109106 Dict -> Unreifiability (SReify context)