9b5abf2 · rel8 · git.iko.soy

git.iko.soy/rel8

Use data family for HTable contexts

commit9b5abf299f166b22840a987f43140dec0c371926 authorShane O'Brien <shane.obrien@circuithub.com> dateWed 24 Mar 2021, 02:13 (6 years ago) parent88e6ea5

54 files changed+834−798

compare with master

unifiedsplit

rel8.cabal+2−3

@@ -87,15 +87,14 @@ library

8787

8888 Rel8.Schema.Column

8989 Rel8.Schema.Context

90+ Rel8.Schema.Context.Identity

9091 Rel8.Schema.Context.Label

9192 Rel8.Schema.Context.Nullify

92− Rel8.Schema.Context.Result

9393 Rel8.Schema.Dict

9494 Rel8.Schema.Field

9595 Rel8.Schema.Generic

9696 Rel8.Schema.Generic.Test

9797 Rel8.Schema.HTable

98− Rel8.Schema.HTable.Context

9998 Rel8.Schema.HTable.Either

10099 Rel8.Schema.HTable.Identity

101100 Rel8.Schema.HTable.Label

@@ -110,9 +109,9 @@ library

110109 Rel8.Schema.HTable.Trio

111110 Rel8.Schema.HTable.Type

112111 Rel8.Schema.HTable.Vectorize

112+ Rel8.Schema.Kind

113113 Rel8.Schema.Nullability

114114 Rel8.Schema.Spec

115− Rel8.Schema.Spec.ConstrainContext

116115 Rel8.Schema.Spec.ConstrainDBType

117116 Rel8.Schema.Spec.ConstrainType

118117 Rel8.Schema.Table

src/Rel8/Query/Either.hs+3−3

@@ -12,12 +12,12 @@ where

1212import Prelude

1313

1414-- rel8

15+import Rel8.Expr ( Expr )

1516import Rel8.Expr.Eq ( (==.) )

1617import Rel8.Query ( Query )

1718import Rel8.Query.Filter ( where_ )

1819import Rel8.Query.Maybe ( optional )

1920import Rel8.Query.Set ( unionAll )

20−import Rel8.Schema.Context ( DB )

2121import Rel8.Table ( Table )

2222import Rel8.Table.Bool ( bool )

2323import Rel8.Table.Either

@@ -40,14 +40,14 @@ keepRightTable e@(EitherTable _ _ b) = do

4040 pure b

4141

4242

43−bindEitherTable :: (Table DB a, Monad m)

43+bindEitherTable :: (Table Expr a, Monad m)

4444 => (i -> m (EitherTable a b)) -> EitherTable a i -> m (EitherTable a b)

4545bindEitherTable query e@(EitherTable input a i) = do

4646 EitherTable output a' b <- query i

4747 pure $ EitherTable (input <> output) (bool a a' (isRightTable e)) b

4848

4949

50−bitraverseEitherTable :: (Table DB c, Table DB d)

50+bitraverseEitherTable :: (Table Expr c, Table Expr d)

5151 => (a -> Query c)

5252 -> (b -> Query d)

5353 -> EitherTable a b

src/Rel8/Query/List.hs+3−3

@@ -9,10 +9,10 @@ where

99import Prelude

1010

1111-- rel8

12+import Rel8.Expr ( Expr )

1213import Rel8.Query ( Query )

1314import Rel8.Query.Aggregate ( aggregate )

1415import Rel8.Query.Maybe ( optional )

15−import Rel8.Schema.Context ( DB )

1616import Rel8.Table ( Table )

1717import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )

1818import Rel8.Table.List ( ListTable )

@@ -28,7 +28,7 @@ import Rel8.Table.NonEmpty ( NonEmptyTable )

2828--

2929-- @some@ is analogous to 'Control.Applicative.some' from

3030-- @Control.Applicative@.

31−some :: Table DB a => Query a -> Query (NonEmptyTable a)

31+some :: Table Expr a => Query a -> Query (NonEmptyTable a)

3232some = aggregate . fmap nonEmptyAgg

3333

3434

@@ -39,5 +39,5 @@ some = aggregate . fmap nonEmptyAgg

3939--

4040-- @many@ is analogous to 'Control.Applicative.many' from

4141-- @Control.Applicative@.

42−many :: Table DB a => Query a -> Query (ListTable a)

42+many :: Table Expr a => Query a -> Query (ListTable a)

4343many = fmap (maybeTable mempty id) . optional . aggregate . fmap listAgg

src/Rel8/Query/SQL.hs+5−4

@@ -23,11 +23,12 @@ import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )

2323import qualified Opaleye.Internal.Sql as Opaleye

2424

2525-- rel8

26+import Rel8.Expr ( Expr )

2627import Rel8.Expr.Opaleye ( toPrimExpr )

2728import Rel8.Query ( Query )

2829import Rel8.Query.Opaleye ( toOpaleye )

2930import qualified Rel8.Query.Optimize as Rel8 ( optimize )

30−import Rel8.Schema.Context ( DB( DB ), Name( Name ) )

31+import Rel8.Schema.Context ( Col'(..), Name( Name ) )

3132import Rel8.Schema.HTable ( htabulateA, hfield )

3233import Rel8.Table ( Table, toColumns )

3334import Rel8.Table.Name ( namesFromLabels )

@@ -36,11 +37,11 @@ import Rel8.Table.Recontextualize ( Selects )

3637

3738-- | Convert a query to a 'String' containing the query as a @SELECT@

3839-- statement.

39−showQuery :: Table DB a => Query a -> String

40+showQuery :: Table Expr a => Query a -> String

4041showQuery = fold . sqlForQuery

4142

4243

43−sqlForQuery :: Table DB a

44+sqlForQuery :: Table Expr a

4445 => Query a -> Maybe String

4546sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toColumns

4647

@@ -68,7 +69,7 @@ selectFrom (toColumns -> names) (toColumns -> exprs) query =

6869 where

6970 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query

7071 attributes = getConst $ htabulateA $ \field -> case hfield names field of

71− Name name -> case hfield exprs field of

72+ Col (Name name) -> case hfield exprs field of

7273 DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))

7374 makeAttr label expr =

7475 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))

src/Rel8/Query/Set.hs+4−4

@@ -14,12 +14,12 @@ import Prelude ()

1414import qualified Opaleye.Binary as Opaleye

1515

1616-- rel8

17+import Rel8.Expr ( Expr )

1718import {-# SOURCE #-} Rel8.Query ( Query )

1819import Rel8.Query.Opaleye ( zipOpaleyeWith )

1920import Rel8.Table ( Table )

2021import Rel8.Table.Eq ( EqTable )

2122import Rel8.Table.Opaleye ( binaryspec )

22−import Rel8.Schema.Context ( DB )

2323

2424

2525-- | Combine the results of two queries of the same type, collapsing

@@ -36,7 +36,7 @@ union = zipOpaleyeWith (Opaleye.unionExplicit binaryspec)

3636--

3737-- >>> select c $ values [lit True, lit True, lit False] `unionAll` values [lit True]

3838-- [True,True,False,True]

39−unionAll :: Table DB a => Query a -> Query a -> Query a

39+unionAll :: Table Expr a => Query a -> Query a -> Query a

4040unionAll = zipOpaleyeWith (Opaleye.unionAllExplicit binaryspec)

4141

4242

@@ -54,7 +54,7 @@ intersect = zipOpaleyeWith (Opaleye.intersectExplicit binaryspec)

5454--

5555-- >>> select c $ values [lit True, lit True, lit False] `intersectAll` values [lit True, lit True]

5656-- [True,True]

57−intersectAll :: Table DB a => Query a -> Query a -> Query a

57+intersectAll :: Table Expr a => Query a -> Query a -> Query a

5858intersectAll = zipOpaleyeWith (Opaleye.intersectAllExplicit binaryspec)

5959

6060

@@ -72,5 +72,5 @@ except = zipOpaleyeWith (Opaleye.exceptExplicit binaryspec)

7272--

7373-- >>> select c $ values [lit True, lit False, lit False] `exceptAll` values [lit True]

7474-- [False,False]

75−exceptAll :: Table DB a => Query a -> Query a -> Query a

75+exceptAll :: Table Expr a => Query a -> Query a -> Query a

7676exceptAll = zipOpaleyeWith (Opaleye.exceptAllExplicit binaryspec)

src/Rel8/Query/These.hs+3−4

@@ -29,7 +29,6 @@ import Rel8.Query ( Query )

2929import Rel8.Query.Filter ( where_ )

3030import Rel8.Query.Maybe ( traverseMaybeTable )

3131import Rel8.Query.Opaleye ( zipOpaleyeWith )

32−import Rel8.Schema.Context ( DB )

3332import Rel8.Table ( Table )

3433import Rel8.Table.Either ( EitherTable( EitherTable ) )

3534import Rel8.Table.Maybe ( MaybeTable( MaybeTable ), isJustTable )

@@ -41,7 +40,7 @@ import Rel8.Table.These

4140import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ) )

4241

4342

44−alignBy :: (Table DB a, Table DB b)

43+alignBy :: (Table Expr a, Table Expr b)

4544 => (a -> b -> Expr Bool)

4645 -> Query a -> Query b -> Query (TheseTable a b)

4746alignBy condition as bs =

@@ -108,14 +107,14 @@ loseThoseTable t@(TheseTable (MaybeTable _ a) (MaybeTable _ b)) = do

108107 tag = boolExpr (litExpr IsLeft) (litExpr IsRight) (isThatTable t)

109108

110109

111−bindTheseTable :: (Table DB a, Semigroup a, Monad m)

110+bindTheseTable :: (Table Expr a, Semigroup a, Monad m)

112111 => (i -> m (TheseTable a b)) -> TheseTable a i -> m (TheseTable a b)

113112bindTheseTable query (TheseTable here (MaybeTable input i)) = do

114113 TheseTable here' (MaybeTable output b) <- query i

115114 pure $ TheseTable (here <> here') (MaybeTable (input <> output) b)

116115

117116

118−bitraverseTheseTable :: (Table DB c, Table DB d)

117+bitraverseTheseTable :: (Table Expr c, Table Expr d)

119118 => (a -> Query c)

120119 -> (b -> Query d)

121120 -> TheseTable a b

src/Rel8/Query/Values.hs+2−2

@@ -13,11 +13,11 @@ import Prelude

1313import qualified Opaleye.Values as Opaleye

1414

1515-- rel8

16+import Rel8.Expr ( Expr )

1617import {-# SOURCE #-} Rel8.Query ( Query )

1718import Rel8.Query.Opaleye ( fromOpaleye )

1819import Rel8.Table ( Table )

1920import Rel8.Table.Opaleye ( valuesspec )

20−import Rel8.Schema.Context ( DB )

2121

2222

2323-- | Construct a query that returns the given input list of rows. This is like

@@ -29,5 +29,5 @@ import Rel8.Schema.Context ( DB )

2929-- >>> mapM_ Data.Text.IO.putStrLn =<< select c (values [ lit "Hello", lit "World!" ])

3030-- Hello

3131-- World!

32−values :: (Table DB a, Foldable f) => f a -> Query a

32+values :: (Table Expr a, Foldable f) => f a -> Query a

3333values = fromOpaleye . Opaleye.valuesExplicit valuesspec . toList

src/Rel8/Schema/Column.hs+19−18

@@ -13,6 +13,7 @@ module Rel8.Schema.Column

1313where

1414

1515-- base

16+import Data.Functor.Identity ( Identity )

1617import Data.Kind ( Type )

1718import Data.List.NonEmpty ( NonEmpty )

1819import GHC.TypeLits ( Symbol )

@@ -21,10 +22,10 @@ import Prelude

2122-- rel8

2223import Rel8.Kind.Labels ( Labels )

2324import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )

24−import Rel8.Schema.Context ( Result, IsSpecialContext )

25+import Rel8.Schema.Context ( IsSpecialContext )

2526import Rel8.Schema.Field ( Field )

27+import qualified Rel8.Schema.Kind as K

2628import Rel8.Schema.Nullability ( Unnullify )

27−import Rel8.Schema.Spec ( Context )

2829import Rel8.Schema.Structure

2930 ( Structure

3031 , Shape( Either, List, Maybe, NonEmpty, These )

@@ -73,7 +74,7 @@ type family UnwrapDefault a where

7374 UnwrapDefault a = a

7475

7576

76−type Column :: Context -> Type -> Type

77+type Column :: K.Context -> Type -> Type

7778type Column context a =

7879 Field context (GetLabel a)

7980 (GetNecessity (UnwrapLabel a))

@@ -81,61 +82,61 @@ type Column context a =

8182 (UnwrapDefault (UnwrapLabel a))

8283

8384

84−type IHEither :: Bool -> Context -> Type -> Type -> Type

85+type IHEither :: Bool -> K.Context -> Type -> Type -> Type

8586type family IHEither isSpecialContext context where

8687 IHEither 'False _ = EitherTable

87− IHEither 'True Result = Either

88+ IHEither 'True Identity = Either

8889 IHEither 'True Structure = Shape2 'Either

8990 IHEither 'True _ = EitherTable

9091

9192

92−type IHList :: Bool -> Context -> Type -> Type

93+type IHList :: Bool -> K.Context -> Type -> Type

9394type family IHList isSpecialContext context where

9495 IHList 'False _ = ListTable

95− IHList 'True Result = []

96+ IHList 'True Identity = []

9697 IHList 'True Structure = Shape1 'List

9798 IHList 'True _ = ListTable

9899

99100

100−type IHMaybe :: Bool -> Context -> Type -> Type

101+type IHMaybe :: Bool -> K.Context -> Type -> Type

101102type family IHMaybe isSpecialContext context where

102103 IHMaybe 'False _ = MaybeTable

103− IHMaybe 'True Result = Maybe

104+ IHMaybe 'True Identity = Maybe

104105 IHMaybe 'True Structure = Shape1 'Maybe

105106 IHMaybe 'True _ = MaybeTable

106107

107108

108−type IHNonEmpty :: Bool -> Context -> Type -> Type

109+type IHNonEmpty :: Bool -> K.Context -> Type -> Type

109110type family IHNonEmpty isSpecialContext context where

110111 IHNonEmpty 'False _ = NonEmptyTable

111− IHNonEmpty 'True Result = NonEmpty

112+ IHNonEmpty 'True Identity = NonEmpty

112113 IHNonEmpty 'True Structure = Shape1 'NonEmpty

113114 IHNonEmpty 'True _ = NonEmptyTable

114115

115116

116−type IHThese :: Bool -> Context -> Type -> Type -> Type

117+type IHThese :: Bool -> K.Context -> Type -> Type -> Type

117118type family IHThese isSpecialContext context where

118119 IHThese 'False _ = TheseTable

119− IHThese 'True Result = These

120+ IHThese 'True Identity = These

120121 IHThese 'True Structure = Shape2 'These

121122 IHThese 'True _ = TheseTable

122123

123124

124−type HEither :: Context -> Type -> Type -> Type

125+type HEither :: K.Context -> Type -> Type -> Type

125126type HEither context = IHEither (IsSpecialContext context) context

126127

127128

128−type HList :: Context -> Type -> Type

129+type HList :: K.Context -> Type -> Type

129130type HList context = IHList (IsSpecialContext context) context

130131

131132

132−type HMaybe :: Context -> Type -> Type

133+type HMaybe :: K.Context -> Type -> Type

133134type HMaybe context = IHMaybe (IsSpecialContext context) context

134135

135136

136−type HNonEmpty :: Context -> Type -> Type

137+type HNonEmpty :: K.Context -> Type -> Type

137138type HNonEmpty context = IHNonEmpty (IsSpecialContext context) context

138139

139140

140−type HThese :: Context -> Type -> Type -> Type

141+type HThese :: K.Context -> Type -> Type -> Type

141142type HThese context = IHThese (IsSpecialContext context) context

src/Rel8/Schema/Context.hs+49−80

@@ -1,8 +1,10 @@

11{-# language DataKinds #-}

22{-# language DerivingStrategies #-}

3+{-# language FlexibleContexts #-}

34{-# language FlexibleInstances #-}

45{-# language GADTs #-}

56{-# language GeneralizedNewtypeDeriving #-}

7+{-# language MultiParamTypeClasses #-}

68{-# language ScopedTypeVariables #-}

79{-# language StandaloneDeriving #-}

810{-# language StandaloneKindSignatures #-}

@@ -11,121 +13,88 @@

1113{-# language UndecidableInstances #-}

1214

1315module Rel8.Schema.Context

14− ( Aggregation( Aggregation )

15− , DB( DB, unDB )

16− , Insertion( RequiredInsert, OptionalInsert )

17− , Name( Name )

18− , Result( Result )

16+ ( Col'( .. )

17+ , Interpretation, Col

18+ , Insertion(..)

19+ , Name(..)

1920 , IsSpecialContext

2021 )

2122where

2223

2324-- base

24−import Control.Applicative ( liftA2 )

25+import Data.Functor.Identity ( Identity )

26+import Data.Kind ( Constraint )

2527import Data.String ( IsString )

2628import Prelude

2729

2830-- rel8

2931import Rel8.Aggregate ( Aggregate )

3032import Rel8.Expr ( Expr )

31−import Rel8.Kind.Necessity

32− ( Necessity( Optional, Required )

33− , SNecessity( SOptional, SRequired )

34− , KnownNecessity, necessitySing

35− )

36−import Rel8.Schema.Nullability ( Sql )

37−import Rel8.Schema.Spec ( Context, Spec( Spec ) )

33+import Rel8.Kind.Necessity ( Necessity( Optional, Required ) )

34+import qualified Rel8.Schema.Kind as K

35+import Rel8.Schema.Spec ( Spec( Spec ) )

3836import Rel8.Schema.Structure ( Structure )

39−import Rel8.Type.Monoid ( DBMonoid )

40−import Rel8.Type.Semigroup ( DBSemigroup )

41−

4237

43−type Aggregation :: Context

44−data Aggregation spec where

45− Aggregation :: ()

46− => Aggregate (Expr a)

47− -> Aggregation ('Spec labels necessity dbType a)

4838

39+type Interpretation' :: Bool -> K.Context -> Constraint

40+class IsSpecialContext f ~ isSpecial => Interpretation' isSpecial f where

41+ data Col' isSpecial f :: K.HContext

4942

50−type DB :: Context

51−data DB spec where

52− DB :: ()

53− => { unDB :: Expr a }

54− -> DB ('Spec labels necessity dbType a)

55−deriving stock instance Show (DB spec)

5643

44+instance Interpretation' 'True Aggregate where

45+ data Col' 'True Aggregate _spec where

46+ Aggregation :: ()

47+ => Aggregate (Expr a)

48+ -> Col' 'True Aggregate ('Spec labels necessity db a)

5749

58−instance (spec ~ 'Spec labels necessity dbType a, Sql DBSemigroup a) =>

59− Semigroup (DB spec)

60− where

61− DB a <> DB b = DB (a <> b)

6250

51+instance Interpretation' 'True Expr where

52+ data Col' 'True Expr _spec where

53+ DB :: ()

54+ => { unDB :: Expr a }

55+ -> Col' 'True Expr ('Spec labels necessity db a)

6356

64−instance (spec ~ 'Spec labels necessity dbType a, Sql DBMonoid a) =>

65− Monoid (DB spec)

66− where

67− mempty = DB mempty

6857

58+instance Interpretation' 'True Identity where

59+ data Col' 'True Identity _spec where

60+ Result :: a -> Col' 'True Identity ('Spec labels necessity db a)

6961

70−type Insertion :: Context

71−data Insertion spec where

72− RequiredInsert :: ()

73− => Expr a

74− -> Insertion ('Spec labels 'Required dbType a)

75− OptionalInsert :: ()

76− => Maybe (Expr a)

77− -> Insertion ('Spec labels 'Optional dbType a)

78−deriving stock instance Show (Insertion spec)

7962

63+instance Interpretation' 'True Insertion where

64+ data Col' 'True Insertion _spec where

65+ RequiredInsert :: Expr a -> Col' 'True Insertion ('Spec labels 'Required db a)

66+ OptionalInsert :: Maybe (Expr a) -> Col' 'True Insertion ('Spec labels 'Optional db a)

8067

81−instance (spec ~ 'Spec labels necessity dbType a, Sql DBSemigroup a) =>

82− Semigroup (Insertion spec)

83− where

84− RequiredInsert a <> RequiredInsert b = RequiredInsert (a <> b)

85− OptionalInsert ma <> OptionalInsert mb = OptionalInsert (liftA2 (<>) ma mb)

8668

69+instance IsSpecialContext f ~ 'False => Interpretation' 'False f where

70+ data Col' 'False f _spec where

71+ Col :: f a -> Col' 'False f ('Spec labels necessity db a)

8772

88−instance

89− ( spec ~ 'Spec labels necessity dbType a

90− , KnownNecessity necessity

91− , Sql DBMonoid a

92− ) => Monoid (Insertion spec)

93− where

94− mempty = case necessitySing @necessity of

95− SRequired -> RequiredInsert mempty

96− SOptional -> OptionalInsert (Just mempty)

9773

74+type Interpretation :: K.Context -> Constraint

75+class Interpretation' (IsSpecialContext context) context => Interpretation context

76+instance Interpretation' (IsSpecialContext context) context => Interpretation context

9877

99−type Name :: Context

100−newtype Name spec = Name String

101− deriving stock Show

102− deriving newtype (IsString, Monoid, Semigroup)

10378

79+type Col :: K.Context -> K.HContext

80+type Col context = Col' (IsSpecialContext context) context

10481

105−type Result :: Context

106−data Result spec where

107− Result :: a -> Result ('Spec labels necessity dbType a)

108−deriving stock instance Show a =>

109− Show (Result ('Spec labels necessity dbType a))

11082

83+type Insertion :: K.Context

84+newtype Insertion a = Insertion (Expr a)

11185

112−instance (spec ~ 'Spec labels necessity dbType a, Semigroup a) =>

113− Semigroup (Result spec)

114− where

115− Result a <> Result b = Result (a <> b)

11686

117−

118−instance (spec ~ 'Spec labels necessity dbType a, Monoid a) =>

119− Monoid (Result spec)

120− where

121− mempty = Result mempty

87+type Name :: K.Context

88+newtype Name a = Name String

89+ deriving stock Show

90+ deriving newtype (IsString, Monoid, Semigroup)

12291

12392

124−type IsSpecialContext :: Context -> Bool

93+type IsSpecialContext :: K.Context -> Bool

12594type family IsSpecialContext context where

126− IsSpecialContext Aggregation = 'True

127− IsSpecialContext DB = 'True

95+ IsSpecialContext Aggregate = 'True

96+ IsSpecialContext Expr = 'True

12897 IsSpecialContext Insertion = 'True

129− IsSpecialContext Result = 'True

98+ IsSpecialContext Identity = 'True

13099 IsSpecialContext Structure = 'True

131100 IsSpecialContext _ = 'False

src/Rel8/Schema/Context/Result.hs → src/Rel8/Schema/Context/Identity.hsrenamed+28−28

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

33{-# language NamedFieldPuns #-}

44{-# language TypeFamilies #-}

6−module Rel8.Schema.Context.Result

6+module Rel8.Schema.Context.Identity

77 ( fromHEitherTable, toHEitherTable

88 , fromHListTable, toHListTable

99 , fromHMaybeTable, toHMaybeTable

@@ -14,13 +14,13 @@ where

1414

1515-- base

1616import Data.Functor ( ($>) )

17+import Data.Functor.Identity ( Identity )

1718import Data.List.NonEmpty ( NonEmpty )

1819import Prelude hiding ( null )

1920

2021-- rel8

21−import Rel8.Schema.Context ( Result( Result ) )

22+import Rel8.Schema.Context ( Col, Col'( Result ) )

2223import Rel8.Schema.HTable ( HTable )

23−import Rel8.Schema.HTable.Context ( H )

2424import Rel8.Schema.HTable.Either ( HEitherTable(..) )

2525import Rel8.Schema.HTable.Identity ( HIdentity(..) )

2626import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )

@@ -41,8 +41,8 @@ import Data.These.Combinators ( justHere, justThere )

4141

4242

4343toHEitherTable :: (HTable t, HTable u)

44− => Either (t (H Result)) (u (H Result))

45− -> HEitherTable t u (H Result)

44+ => Either (t (Col Identity)) (u (Col Identity))

45+ -> HEitherTable t u (Col Identity)

4646toHEitherTable = either hleft hright

4747 where

4848 hleft table = HEitherTable

@@ -59,8 +59,8 @@ toHEitherTable = either hleft hright

5959

6060

6161fromHEitherTable :: (HTable t, HTable u)

62− => HEitherTable t u (H Result)

63− -> Either (t (H Result)) (u (H Result))

62+ => HEitherTable t u (Col Identity)

63+ -> Either (t (Col Identity)) (u (Col Identity))

6464fromHEitherTable HEitherTable {htag, hleft, hright} = case htag of

6565 HIdentity (Result tag) -> case tag of

6666 IsLeft -> maybe err Left $ hunnullify unnullifier hleft

@@ -70,17 +70,17 @@ fromHEitherTable HEitherTable {htag, hleft, hright} = case htag of

7070{-# INLINABLE fromHEitherTable #-}

7171

7272

73−toHListTable :: HTable t => [t (H Result)] -> HListTable t (H Result)

73+toHListTable :: HTable t => [t (Col Identity)] -> HListTable t (Col Identity)

7474toHListTable = hvectorize vectorizer

7575{-# INLINABLE toHListTable #-}

7676

7777

78−fromHListTable :: HTable t => HListTable t (H Result) -> [t (H Result)]

78+fromHListTable :: HTable t => HListTable t (Col Identity) -> [t (Col Identity)]

7979fromHListTable = hunvectorize unvectorizer

8080{-# INLINABLE fromHListTable #-}

8181

8282

83−toHMaybeTable :: HTable t => Maybe (t (H Result)) -> HMaybeTable t (H Result)

83+toHMaybeTable :: HTable t => Maybe (t (Col Identity)) -> HMaybeTable t (Col Identity)

8484toHMaybeTable = maybe hnothing hjust

8585 where

8686 hnothing = HMaybeTable

@@ -94,7 +94,7 @@ toHMaybeTable = maybe hnothing hjust

9494{-# INLINABLE toHMaybeTable #-}

9595

9696

97−fromHMaybeTable :: HTable t => HMaybeTable t (H Result) -> Maybe (t (H Result))

97+fromHMaybeTable :: HTable t => HMaybeTable t (Col Identity) -> Maybe (t (Col Identity))

9898fromHMaybeTable HMaybeTable {htag, hjust} = case htag of

9999 HIdentity (Result tag) -> tag $>

100100 case hunnullify unnullifier hjust of

@@ -103,19 +103,19 @@ fromHMaybeTable HMaybeTable {htag, hjust} = case htag of

103103{-# INLINABLE fromHMaybeTable #-}

104104

105105

106−toHNonEmptyTable :: HTable t => NonEmpty (t (H Result)) -> HNonEmptyTable t (H Result)

106+toHNonEmptyTable :: HTable t => NonEmpty (t (Col Identity)) -> HNonEmptyTable t (Col Identity)

107107toHNonEmptyTable = hvectorize vectorizer

108108{-# INLINABLE toHNonEmptyTable #-}

109109

110110

111−fromHNonEmptyTable :: HTable t => HNonEmptyTable t (H Result) -> NonEmpty (t (H Result))

111+fromHNonEmptyTable :: HTable t => HNonEmptyTable t (Col Identity) -> NonEmpty (t (Col Identity))

112112fromHNonEmptyTable = hunvectorize unvectorizer

113113{-# INLINABLE fromHNonEmptyTable #-}

114114

115115

116116toHTheseTable :: (HTable t, HTable u)

117− => These (t (H Result)) (u (H Result))

118− -> HTheseTable t u (H Result)

117+ => These (t (Col Identity)) (u (Col Identity))

118+ -> HTheseTable t u (Col Identity)

119119toHTheseTable tables = HTheseTable

120120 { hhereTag = relabel hhereTag

121121 , hhere

@@ -135,8 +135,8 @@ toHTheseTable tables = HTheseTable

135135

136136

137137fromHTheseTable :: (HTable t, HTable u)

138− => HTheseTable t u (H Result)

139− -> These (t (H Result)) (u (H Result))

138+ => HTheseTable t u (Col Identity)

139+ -> These (t (Col Identity)) (u (Col Identity))

140140fromHTheseTable HTheseTable {hhereTag, hhere, hthereTag, hthere} =

141141 case (fromHMaybeTable mhere, fromHMaybeTable mthere) of

142142 (Just a, Nothing) -> This a

@@ -155,14 +155,14 @@ fromHTheseTable HTheseTable {hhereTag, hhere, hthereTag, hthere} =

155155{-# INLINABLE fromHTheseTable #-}

156156

157157

158−null :: Result ('Spec labels necessity db (Maybe db))

158+null :: Col Identity ('Spec labels necessity db (Maybe db))

159159null = Result Nothing

160160

161161

162162nullifier :: ()

163163 => SSpec ('Spec labels necessity db a)

164− -> Result ('Spec labels necessity db a)

165− -> Result ('Spec labels necessity db (Maybe db))

164+ -> Col Identity ('Spec labels necessity db a)

165+ -> Col Identity ('Spec labels necessity db (Maybe db))

166166nullifier SSpec {nullability} (Result a) = Result $ case nullability of

167167 Nullable -> a

168168 NonNullable -> Just a

@@ -170,8 +170,8 @@ nullifier SSpec {nullability} (Result a) = Result $ case nullability of

170170

171171unnullifier :: ()

172172 => SSpec ('Spec labels necessity db a)

173− -> Result ('Spec labels necessity db (Maybe db))

174− -> Maybe (Result ('Spec labels necessity db a))

173+ -> Col Identity ('Spec labels necessity db (Maybe db))

174+ -> Maybe (Col Identity ('Spec labels necessity db a))

175175unnullifier SSpec {nullability} (Result a) =

176176 case nullability of

177177 Nullable -> pure $ Result a

@@ -180,19 +180,19 @@ unnullifier SSpec {nullability} (Result a) =

180180

181181vectorizer :: Functor f

182182 => SSpec ('Spec labels necessity db a)

183− -> f (Result ('Spec labels necessity db a))

184− -> Result ('Spec labels necessity (f a) (f a))

183+ -> f (Col Identity ('Spec labels necessity db a))

184+ -> Col Identity ('Spec labels necessity (f a) (f a))

185185vectorizer _ = Result . fmap (\(Result a) -> a)

186186

187187

188188unvectorizer :: Functor f

189189 => SSpec ('Spec labels necessity db a)

190− -> Result ('Spec labels necessity (f a) (f a))

191− -> f (Result ('Spec labels necessity db a))

190+ -> Col Identity ('Spec labels necessity (f a) (f a))

191+ -> f (Col Identity ('Spec labels necessity db a))

192192unvectorizer _ (Result results) = Result <$> results

193193

194194

195195relabel :: ()

196− => HIdentity ('Spec labels necessity db a) (H Result)

197− -> HIdentity ('Spec relabels necessity db a) (H Result)

196+ => HIdentity ('Spec labels necessity db a) (Col Identity)

197+ -> HIdentity ('Spec relabels necessity db a) (Col Identity)

198198relabel (HIdentity (Result a)) = HIdentity (Result a)

src/Rel8/Schema/Context/Label.hs+42−20

@@ -8,41 +8,43 @@

99module Rel8.Schema.Context.Label

1010 ( Labelable( labeler, unlabeler )

11+ , HLabelable( hlabeler, hunlabeler )

1112 )

1213where

1314

1415-- base

16+import Data.Functor.Identity ( Identity )

1517import Data.Kind ( Constraint )

1618import Prelude hiding ( null )

1719

1820-- rel8

21+import Rel8.Aggregate ( Aggregate )

22+import Rel8.Expr ( Expr )

1923import Rel8.Schema.Context

20− ( Aggregation( Aggregation )

21− , DB( DB )

22− , Insertion( RequiredInsert, OptionalInsert )

23− , Name( Name )

24− , Result( Result )

24+ ( Interpretation, Col, Col'(..), IsSpecialContext

25+ , Insertion

2526 )

26−import Rel8.Schema.Spec ( Context, Spec( Spec ) )

27+import qualified Rel8.Schema.Kind as K

28+import Rel8.Schema.Spec ( Spec( Spec ) )

2729

2830

29−type Labelable :: Context -> Constraint

30−class Labelable context where

31+type Labelable :: K.Context -> Constraint

32+class Interpretation context => Labelable context where

3133 labeler :: ()

32− => context ('Spec labels necessity db a)

33− -> context ('Spec (label ': labels) necessity db a)

34+ => Col context ('Spec labels necessity db a)

35+ -> Col context ('Spec (label ': labels) necessity db a)

3436

3537 unlabeler :: ()

36− => context ('Spec (label ': labels) necessity db a)

37− -> context ('Spec labels necessity db a)

38+ => Col context ('Spec (label ': labels) necessity db a)

39+ -> Col context ('Spec labels necessity db a)

3840

3941

40−instance Labelable Aggregation where

42+instance Labelable Aggregate where

4143 labeler (Aggregation aggregate) = Aggregation aggregate

4244 unlabeler (Aggregation aggregate) = Aggregation aggregate

4345

4446

45−instance Labelable DB where

47+instance Labelable Expr where

4648 labeler (DB a) = DB a

4749 unlabeler (DB a) = DB a

4850

@@ -57,11 +59,31 @@ instance Labelable Insertion where

5759 OptionalInsert ma -> OptionalInsert ma

5860

5961

60−instance Labelable Name where

61− labeler (Name name) = Name name

62− unlabeler (Name name) = Name name

63−

64−

65−instance Labelable Result where

62+instance Labelable Identity where

6663 labeler (Result a) = Result a

6764 unlabeler (Result a) = Result a

65+

66+

67+instance {-# OVERLAPPABLE #-} IsSpecialContext context ~ 'False =>

68+ Labelable context

69+ where

70+ labeler (Col a) = Col a

71+ unlabeler (Col a) = Col a

72+

73+

74+type HLabelable :: K.HContext -> Constraint

75+class HLabelable context where

76+ hlabeler :: ()

77+ => context ('Spec labels necessity db a)

78+ -> context ('Spec (label ': labels) necessity db a)

79+

80+ hunlabeler :: ()

81+ => context ('Spec (label ': labels) necessity db a)

82+ -> context ('Spec labels necessity db a)

83+

84+

85+instance (Labelable context, x ~ IsSpecialContext context) =>

86+ HLabelable (Col' x context)

87+ where

88+ hlabeler = labeler

89+ hunlabeler = hunlabeler

src/Rel8/Schema/Context/Nullify.hs+20−19

@@ -36,41 +36,42 @@ import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

3636import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )

3737import Rel8.Kind.Necessity ( Necessity( Required ) )

3838import Rel8.Schema.Context

39− ( Aggregation( Aggregation )

40− , DB( DB )

41− , Insertion( RequiredInsert, OptionalInsert )

39+ ( Interpretation

40+ , Col, Col'(..)

41+ , Insertion

4242 , Name( Name )

4343 )

44+import qualified Rel8.Schema.Kind as K

4445import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ), Sql )

45−import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )

46+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

4647import Rel8.Type.Eq ( DBEq )

4748import Rel8.Type.Monoid ( DBMonoid )

4849

4950

50−type Nullifiable :: Context -> Constraint

51−class Nullifiable context where

51+type Nullifiable :: K.Context -> Constraint

52+class Interpretation context => Nullifiable context where

5253 encodeTag :: (Sql DBEq a, KnownLabels labels)

5354 => Expr a

54− -> context ('Spec labels 'Required db a)

55+ -> Col context ('Spec labels 'Required db a)

5556

5657 decodeTag :: Sql DBMonoid a

57− => context ('Spec labels 'Required db a)

58+ => Col context ('Spec labels 'Required db a)

5859 -> Expr a

5960

6061 nullifier :: ()

6162 => Expr Bool

6263 -> SSpec ('Spec labels necessity db a)

63− -> context ('Spec labels necessity db a)

64− -> context ('Spec labels necessity db (Maybe db))

64+ -> Col context ('Spec labels necessity db a)

65+ -> Col context ('Spec labels necessity db (Maybe db))

6566

6667 unnullifier :: ()

6768 => Expr Bool

6869 -> SSpec ('Spec labels necessity db a)

69− -> context ('Spec labels necessity db (Maybe db))

70− -> context ('Spec labels necessity db a)

70+ -> Col context ('Spec labels necessity db (Maybe db))

71+ -> Col context ('Spec labels necessity db a)

7172

7273

73−instance Nullifiable Aggregation where

74+instance Nullifiable Aggregate where

7475 encodeTag = Aggregation . groupByExpr

7576 decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate

7677

@@ -87,7 +88,7 @@ instance Nullifiable Aggregation where

8788 {-# INLINABLE unnullifier #-}

8889

8990

90−instance Nullifiable DB where

91+instance Nullifiable Expr where

9192 encodeTag = DB

9293 decodeTag (DB a) = a

9394 nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a

@@ -120,8 +121,8 @@ instance Nullifiable Insertion where

120121instance Nullifiable Name where

121122 encodeTag _ = nameFromLabel

122123 decodeTag _ = mempty

123− nullifier _ _ (Name name) = Name name

124− unnullifier _ _ (Name name) = Name name

124+ nullifier _ _ (Col (Name name)) = Col (Name name)

125+ unnullifier _ _ (Col (Name name)) = Col (Name name)

125126

126127 {-# INLINABLE encodeTag #-}

127128 {-# INLINABLE decodeTag #-}

@@ -129,7 +130,7 @@ instance Nullifiable Name where

129130 {-# INLINABLE unnullifier #-}

130131

131132

132−type NullifiableEq :: Context -> Context -> Constraint

133+type NullifiableEq :: K.Context -> K.Context -> Constraint

133134class (a ~ b, Nullifiable b) => NullifiableEq a b

134135instance (a ~ b, Nullifiable b) => NullifiableEq a b

135136

@@ -157,6 +158,6 @@ undoGroupBy = getFirst . foldInputs go

157158

158159

159160nameFromLabel :: forall labels necessity db a.

160− KnownLabels labels => Name ('Spec labels necessity db a)

161+ KnownLabels labels => Col Name ('Spec labels necessity db a)

161162nameFromLabel = case labelsSing @labels of

162− labels -> Name (NonEmpty.last (renderLabels labels))

163+ labels -> Col (Name (NonEmpty.last (renderLabels labels)))

src/Rel8/Schema/Field.hs+10−11

@@ -9,6 +9,7 @@ module Rel8.Schema.Field

99where

1010

1111-- base

12+import Data.Functor.Identity ( Identity )

1213import Data.Kind ( Type )

1314import Prelude

1415

@@ -17,25 +18,23 @@ import Rel8.Aggregate ( Aggregate )

1718import Rel8.Expr ( Expr )

1819import Rel8.Kind.Labels ( Labels )

1920import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )

20−import Rel8.Schema.Context

21− ( Aggregation, DB, Insertion, Result

22− , IsSpecialContext

23− )

24−import Rel8.Schema.Spec ( Context, Spec( Spec ) )

21+import Rel8.Schema.Context ( Insertion, IsSpecialContext )

22+import qualified Rel8.Schema.Kind as K

23+import Rel8.Schema.Spec ( Spec( Spec ) )

2524import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )

2625

2726

28−type IField :: Bool -> Context -> Labels -> Necessity -> Type -> Type -> Type

27+type IField :: Bool -> K.Context -> Labels -> Necessity -> Type -> Type -> Type

2928type family IField isSpecialContext labels context necessity db a where

30− IField 'False context labels necessity db a = context ('Spec labels necessity db a)

31− IField 'True Result _labels _necessity _db a = a

32− IField 'True DB _labels _necessity _db a = Expr a

29+ IField 'False context _labels _necessity _db a = context a

30+ IField 'True Identity _labels _necessity _db a = a

31+ IField 'True Expr _labels _necessity _db a = Expr a

3332 IField 'True Insertion _labels 'Required _db a = Expr a

3433 IField 'True Insertion _labels 'Optional _db a = Maybe (Expr a)

35− IField 'True Aggregation _labels _necessity _db a = Aggregate (Expr a)

34+ IField 'True Aggregate _labels _necessity _db a = Aggregate (Expr a)

3635 IField 'True Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)

3736

3837

39−type Field :: Context -> Labels -> Necessity -> Type -> Type -> Type

38+type Field :: K.Context -> Labels -> Necessity -> Type -> Type -> Type

4039type Field context labels necessity db a =

4140 IField (IsSpecialContext context) context labels necessity db a

src/Rel8/Schema/Generic.hs+159−160

@@ -23,6 +23,7 @@ where

2323

2424-- base

2525import Data.Bifunctor ( bimap )

26+import Data.Functor.Identity ( Identity )

2627import Data.Kind ( Constraint, Type )

2728import Data.List.NonEmpty ( NonEmpty )

2829import GHC.Generics

@@ -35,29 +36,27 @@ import GHC.TypeLits ( Symbol )

3536import Prelude

3637

3738-- rel8

39+import Rel8.Aggregate ( Aggregate )

40+import Rel8.Expr ( Expr )

3841import Rel8.Kind.Necessity

3942 ( SNecessity( SRequired, SOptional )

4043 , KnownNecessity, necessitySing

4144 )

4245import Rel8.Schema.Context

43− ( Aggregation( Aggregation )

44− , DB( DB )

45− , Insertion( RequiredInsert, OptionalInsert )

46− , Result( Result )

47− , IsSpecialContext

48− )

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

50−import Rel8.Schema.Context.Nullify ( Nullifiable )

51−import Rel8.Schema.Context.Result

46+import Rel8.Schema.Context.Identity

5247 ( fromHEitherTable, toHEitherTable

5348 , fromHListTable, toHListTable

5449 , fromHMaybeTable, toHMaybeTable

5550 , fromHNonEmptyTable, toHNonEmptyTable

5651 , fromHTheseTable, toHTheseTable

5752 )

53+import Rel8.Schema.Context.Label

54+ ( Labelable, labeler, unlabeler

55+ , hlabeler, hunlabeler

56+ )

57+import Rel8.Schema.Context.Nullify ( Nullifiable )

5858import Rel8.Schema.Field ( Field )

5959import Rel8.Schema.HTable ( HTable )

60−import Rel8.Schema.HTable.Context ( H, HKTable )

6160import Rel8.Schema.HTable.Either ( HEitherTable )

6261import Rel8.Schema.HTable.Identity ( HIdentity(..) )

6362import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

@@ -70,8 +69,8 @@ import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

7069import Rel8.Schema.HTable.These ( HTheseTable )

7170import Rel8.Schema.HTable.Trio ( HTrio(..) )

7271import Rel8.Schema.HTable.Vectorize ( hrelabel )

72+import qualified Rel8.Schema.Kind as K

7373import Rel8.Schema.Spec ( Spec( Spec ), KTable )

74−import qualified Rel8.Schema.Spec as Kind ( Context )

7574import Rel8.Schema.Structure

7675 ( IsStructure, Shape(..), Shape1, Shape2

7776 , Structure

@@ -102,22 +101,22 @@ instance (Rel8able t, TableHelper (IsSpecialContext context) context) =>

102101 toColumns = gtoColumns

103102

104103

105−type TableHelper :: Bool -> Kind.Context -> Constraint

104+type TableHelper :: Bool -> K.Context -> Constraint

106105class IsSpecialContext context ~ isSpecialContext =>

107106 TableHelper isSpecialContext context

108107 where

109− gfromColumns :: Rel8able t => GRep t (H context) -> t context

110− gtoColumns :: Rel8able t => t context -> GRep t (H context)

108+ gfromColumns :: Rel8able t => GRep t (Col context) -> t context

109+ gtoColumns :: Rel8able t => t context -> GRep t (Col context)

111110

112111

113−instance TableHelper 'True Aggregation where

114− gfromColumns = fromAggregationColumns

115− gtoColumns = toAggregationColumns

112+instance TableHelper 'True Aggregate where

113+ gfromColumns = fromAggregateColumns

114+ gtoColumns = toAggregateColumns

116115

117116

118−instance TableHelper 'True DB where

119− gfromColumns = fromDBColumns

120− gtoColumns = toDBColumns

117+instance TableHelper 'True Expr where

118+ gfromColumns = fromExprColumns

119+ gtoColumns = toExprColumns

121120

122121

123122instance TableHelper 'True Insertion where

@@ -125,9 +124,9 @@ instance TableHelper 'True Insertion where

125124 gtoColumns = toInsertionColumns

126125

127126

128−instance TableHelper 'True Result where

129− gfromColumns = fromResultColumns

130− gtoColumns = toResultColumns

127+instance TableHelper 'True Identity where

128+ gfromColumns = fromIdentityColumns

129+ gtoColumns = toIdentityColumns

131130

132131

133132instance (IsSpecialContext context ~ 'False, Labelable context, Nullifiable context) =>

@@ -139,105 +138,105 @@ instance (IsSpecialContext context ~ 'False, Labelable context, Nullifiable cont

139138

140139type Rel8able :: KTable -> Constraint

141140class HTable (GRep t) => Rel8able t where

142− type GRep t :: HKTable

141+ type GRep t :: K.HTable

143142

144− fromAggregationColumns :: GRep t (H Aggregation) -> t Aggregation

145− toAggregationColumns :: t Aggregation -> GRep t (H Aggregation)

143+ fromAggregateColumns :: GRep t (Col Aggregate) -> t Aggregate

144+ toAggregateColumns :: t Aggregate -> GRep t (Col Aggregate)

146145

147− fromDBColumns :: GRep t (H DB) -> t DB

148− toDBColumns :: t DB -> GRep t (H DB)

146+ fromExprColumns :: GRep t (Col Expr) -> t Expr

147+ toExprColumns :: t Expr -> GRep t (Col Expr)

149148

150− fromInsertionColumns :: GRep t (H Insertion) -> t Insertion

151− toInsertionColumns :: t Insertion -> GRep t (H Insertion)

149+ fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion

150+ toInsertionColumns :: t Insertion -> GRep t (Col Insertion)

152151

153− fromResultColumns :: GRep t (H Result) -> t Result

154− toResultColumns :: t Result -> GRep t (H Result)

152+ fromIdentityColumns :: GRep t (Col Identity) -> t Identity

153+ toIdentityColumns :: t Identity -> GRep t (Col Identity)

155154

156155 fromUnspecialColumns ::

157156 ( IsSpecialContext context ~ 'False

158157 , Labelable context, Nullifiable context

159158 )

160− => GRep t (H context) -> t context

159+ => GRep t (Col context) -> t context

161160 toUnspecialColumns ::

162161 ( IsSpecialContext context ~ 'False

163162 , Labelable context, Nullifiable context

164163 )

165− => t context -> GRep t (H context)

164+ => t context -> GRep t (Col context)

166165

167166 type GRep t = GColumns (Rep (t Structure))

168167

169− default fromAggregationColumns ::

170− ( Generic (t Aggregation)

168+ default fromAggregateColumns ::

169+ ( Generic (t Aggregate)

171170 , GColumns (Rep (t Structure)) ~ GRep t

172− , GRel8able Aggregation (Rep (t Structure)) (Rep (t Aggregation))

173− ) => GRep t (H Aggregation) -> t Aggregation

174− fromAggregationColumns = to . fromGColumns @_ @(Rep (t Structure))

171+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))

172+ ) => GRep t (Col Aggregate) -> t Aggregate

173+ fromAggregateColumns = to . fromGColumns @_ @(Rep (t Structure))

175174

176− default toAggregationColumns ::

177− ( Generic (t Aggregation)

175+ default toAggregateColumns ::

176+ ( Generic (t Aggregate)

178177 , GColumns (Rep (t Structure)) ~ GRep t

179− , GRel8able Aggregation (Rep (t Structure)) (Rep (t Aggregation))

180− ) => t Aggregation -> GRep t (H Aggregation)

181− toAggregationColumns = toGColumns @_ @(Rep (t Structure)) . from

178+ , GRel8able Aggregate (Rep (t Structure)) (Rep (t Aggregate))

179+ ) => t Aggregate -> GRep t (Col Aggregate)

180+ toAggregateColumns = toGColumns @_ @(Rep (t Structure)) . from

182181

183− default fromDBColumns ::

184− ( Generic (t DB)

182+ default fromExprColumns ::

183+ ( Generic (t Expr)

185184 , GColumns (Rep (t Structure)) ~ GRep t

186− , GRel8able DB (Rep (t Structure)) (Rep (t DB))

187− ) => GRep t (H DB) -> t DB

188− fromDBColumns = to . fromGColumns @_ @(Rep (t Structure))

185+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))

186+ ) => GRep t (Col Expr) -> t Expr

187+ fromExprColumns = to . fromGColumns @_ @(Rep (t Structure))

189188

190− default toDBColumns ::

191− ( Generic (t DB)

189+ default toExprColumns ::

190+ ( Generic (t Expr)

192191 , GColumns (Rep (t Structure)) ~ GRep t

193− , GRel8able DB (Rep (t Structure)) (Rep (t DB))

194− ) => t DB -> GRep t (H DB)

195− toDBColumns = toGColumns @_ @(Rep (t Structure)) . from

192+ , GRel8able Expr (Rep (t Structure)) (Rep (t Expr))

193+ ) => t Expr -> GRep t (Col Expr)

194+ toExprColumns = toGColumns @_ @(Rep (t Structure)) . from

196195

197196 default fromInsertionColumns ::

198197 ( Generic (t Insertion)

199198 , GColumns (Rep (t Structure)) ~ GRep t

200199 , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))

201− ) => GRep t (H Insertion) -> t Insertion

200+ ) => GRep t (Col Insertion) -> t Insertion

202201 fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))

203202

204203 default toInsertionColumns ::

205204 ( Generic (t Insertion)

206205 , GColumns (Rep (t Structure)) ~ GRep t

207206 , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))

208− ) => t Insertion -> GRep t (H Insertion)

207+ ) => t Insertion -> GRep t (Col Insertion)

209208 toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from

210209

211− default fromResultColumns ::

212− ( Generic (t Result)

210+ default fromIdentityColumns ::

211+ ( Generic (t Identity)

213212 , GColumns (Rep (t Structure)) ~ GRep t

214− , GRel8able Result (Rep (t Structure)) (Rep (t Result))

215− ) => GRep t (H Result) -> t Result

216− fromResultColumns = to . fromGColumns @_ @(Rep (t Structure))

213+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))

214+ ) => GRep t (Col Identity) -> t Identity

215+ fromIdentityColumns = to . fromGColumns @_ @(Rep (t Structure))

217216

218− default toResultColumns ::

219− ( Generic (t Result)

217+ default toIdentityColumns ::

218+ ( Generic (t Identity)

220219 , GColumns (Rep (t Structure)) ~ GRep t

221− , GRel8able Result (Rep (t Structure)) (Rep (t Result))

222− ) => t Result -> GRep t (H Result)

223− toResultColumns = toGColumns @_ @(Rep (t Structure)) . from

220+ , GRel8able Identity (Rep (t Structure)) (Rep (t Identity))

221+ ) => t Identity -> GRep t (Col Identity)

222+ toIdentityColumns = toGColumns @_ @(Rep (t Structure)) . from

224223

225224 default fromUnspecialColumns ::

226225 ( Generic (t context)

227226 , GColumns (Rep (t Structure)) ~ GRep t

228227 , GRel8able context (Rep (t Structure)) (Rep (t context))

229− ) => GRep t (H context) -> t context

228+ ) => GRep t (Col context) -> t context

230229 fromUnspecialColumns = to . fromGColumns @_ @(Rep (t Structure))

231230

232231 default toUnspecialColumns ::

233232 ( Generic (t context)

234233 , GColumns (Rep (t Structure)) ~ GRep t

235234 , GRel8able context (Rep (t Structure)) (Rep (t context))

236− ) => t context -> GRep t (H context)

235+ ) => t context -> GRep t (Col context)

237236 toUnspecialColumns = toGColumns @_ @(Rep (t Structure)) . from

238237

239238

240−type GColumns :: (Type -> Type) -> HKTable

239+type GColumns :: (Type -> Type) -> K.HTable

241240type family GColumns structure where

242241 GColumns (M1 D _ structure) = GColumns structure

243242 GColumns (M1 C _ structure) = GColumns structure

@@ -246,10 +245,10 @@ type family GColumns structure where

246245 K1Columns label structure

247246

248247

249−type GRel8able :: Kind.Context -> (Type -> Type) -> (Type -> Type) -> Constraint

248+type GRel8able :: K.Context -> (Type -> Type) -> (Type -> Type) -> Constraint

250249class GRel8able context structure rep where

251− fromGColumns :: GColumns structure (H context) -> rep x

252− toGColumns :: rep x -> GColumns structure (H context)

250+ fromGColumns :: GColumns structure (Col context) -> rep x

251+ toGColumns :: rep x -> GColumns structure (Col context)

253252

254253

255254instance GRel8able context structure rep => GRel8able context (M1 D c structure) (M1 D c rep) where

@@ -285,7 +284,7 @@ instance

285284 toGColumns (M1 (K1 a)) = toK1Columns @label @_ @_ @_ @structure a

286285

287286

288−type K1Columns :: Symbol -> Type -> HKTable

287+type K1Columns :: Symbol -> Type -> K.HTable

289288type family K1Columns label structure where

290289 K1Columns label (Shape1 'Column ('Spec '[] necessity nullability blueprint)) =

291290 HIdentity ('Spec '[label] necessity nullability blueprint)

@@ -327,19 +326,19 @@ type family K1Columns label structure where

327326 K1Columns label a = HLabel label (Columns a)

328327

329328

330−type K1Table :: Symbol -> Bool -> Kind.Context -> Bool -> Type -> Type -> Constraint

329+type K1Table :: Symbol -> Bool -> K.Context -> Bool -> Type -> Type -> Constraint

331330class

332331 ( isSpecialContext ~ IsSpecialContext context

333332 , isStructure ~ IsStructure structure

334333 ) => K1Table label isSpecialContext context isStructure structure a

335334 where

336− fromK1Columns :: K1Columns label structure (H context) -> a

337− toK1Columns :: a -> K1Columns label structure (H context)

335+ fromK1Columns :: K1Columns label structure (Col context) -> a

336+ toK1Columns :: a -> K1Columns label structure (Col context)

338337

339338

340339instance

341− ( x ~ Field Aggregation '[] necessity db a

342− ) => K1Table label 'True Aggregation 'True (Shape1 'Column ('Spec '[] necessity db a)) x

340+ ( x ~ Field Aggregate '[] necessity db a

341+ ) => K1Table label 'True Aggregate 'True (Shape1 'Column ('Spec '[] necessity db a)) x

343342 where

344343 fromK1Columns (HIdentity (Aggregation a)) = a

345344 toK1Columns = HIdentity . Aggregation

@@ -348,8 +347,8 @@ instance

348347

349348

350349instance

351− ( x ~ Field Aggregation (label ': labels) necessity db a

352− ) => K1Table _label 'True Aggregation 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

350+ ( x ~ Field Aggregate (label ': labels) necessity db a

351+ ) => K1Table _label 'True Aggregate 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

353352 where

354353 fromK1Columns (HIdentity (Aggregation a)) = a

355354 toK1Columns = HIdentity . Aggregation

@@ -358,8 +357,8 @@ instance

358357

359358

360359instance

361− ( x ~ Field DB '[] necessity db a

362− ) => K1Table label 'True DB 'True (Shape1 'Column ('Spec '[] necessity db a)) x

360+ ( x ~ Field Expr '[] necessity db a

361+ ) => K1Table label 'True Expr 'True (Shape1 'Column ('Spec '[] necessity db a)) x

363362 where

364363 fromK1Columns (HIdentity (DB a)) = a

365364 toK1Columns = HIdentity . DB

@@ -368,8 +367,8 @@ instance

368367

369368

370369instance

371− ( x ~ Field DB (label ': labels) necessity db a

372− ) => K1Table _label 'True DB 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

370+ ( x ~ Field Expr (label ': labels) necessity db a

371+ ) => K1Table _label 'True Expr 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

373372 where

374373 fromK1Columns (HIdentity (DB a)) = a

375374 toK1Columns = HIdentity . DB

@@ -408,8 +407,8 @@ instance

408407

409408

410409instance

411− ( x ~ Field Result '[] necessity db a

412− ) => K1Table label 'True Result 'True (Shape1 'Column ('Spec '[] necessity db a)) x

410+ ( x ~ Field Identity '[] necessity db a

411+ ) => K1Table label 'True Identity 'True (Shape1 'Column ('Spec '[] necessity db a)) x

413412 where

414413 fromK1Columns (HIdentity (Result a)) = a

415414 toK1Columns = HIdentity . Result

@@ -418,8 +417,8 @@ instance

418417

419418

420419instance

421− ( x ~ Field Result (label ': labels) necessity db a

422− ) => K1Table _label 'True Result 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

420+ ( x ~ Field Identity (label ': labels) necessity db a

421+ ) => K1Table _label 'True Identity 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

423422 where

424423 fromK1Columns (HIdentity (Result a)) = a

425424 toK1Columns = HIdentity . Result

@@ -429,23 +428,23 @@ instance

429428

430429instance

431430 ( IsSpecialContext context ~ 'False

432− , x ~ context ('Spec (label ': labels) necessity db a)

431+ , x ~ context a

433432 ) => K1Table _label 'False context 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

434433 where

435− fromK1Columns = unHIdentity

436− toK1Columns = HIdentity

434+ fromK1Columns (HIdentity (Col a)) = a

435+ toK1Columns = HIdentity . Col

437436 {-# INLINABLE fromK1Columns #-}

438437 {-# INLINABLE toK1Columns #-}

439438

440439

441440instance

442441 ( IsSpecialContext context ~ 'False

443− , x ~ context ('Spec '[] necessity db a)

442+ , x ~ context a

444443 , Labelable context

445444 ) => K1Table label 'False context 'True (Shape1 'Column ('Spec '[] necessity db a)) x

446445 where

447− fromK1Columns = unlabeler . unHIdentity

448− toK1Columns = HIdentity . labeler

446+ fromK1Columns = (\(Col a) -> a) . unlabeler . unHIdentity

447+ toK1Columns = HIdentity . labeler . Col

449448 {-# INLINABLE fromK1Columns #-}

450449 {-# INLINABLE toK1Columns #-}

451450

@@ -453,10 +452,10 @@ instance

453452instance

454453 ( HTable (K1Columns "Left" structure1)

455454 , HTable (K1Columns "Right" structure2)

456− , K1Table "Left" 'True Aggregation (IsStructure structure1) structure1 a

457− , K1Table "Right" 'True Aggregation (IsStructure structure2) structure2 b

455+ , K1Table "Left" 'True Aggregate (IsStructure structure1) structure1 a

456+ , K1Table "Right" 'True Aggregate (IsStructure structure2) structure2 b

458457 , e ~ EitherTable a b

459− ) => K1Table label 'True Aggregation 'True (Shape2 'Either structure1 structure2) e

458+ ) => K1Table label 'True Aggregate 'True (Shape2 'Either structure1 structure2) e

460459 where

461460 fromK1Columns =

462461 fromColumns2

@@ -475,10 +474,10 @@ instance

475474instance

476475 ( HTable (K1Columns "Left" structure1)

477476 , HTable (K1Columns "Right" structure2)

478− , K1Table "Left" 'True DB (IsStructure structure1) structure1 a

479− , K1Table "Right" 'True DB (IsStructure structure2) structure2 b

477+ , K1Table "Left" 'True Expr (IsStructure structure1) structure1 a

478+ , K1Table "Right" 'True Expr (IsStructure structure2) structure2 b

480479 , e ~ EitherTable a b

481− ) => K1Table label 'True DB 'True (Shape2 'Either structure1 structure2) e

480+ ) => K1Table label 'True Expr 'True (Shape2 'Either structure1 structure2) e

482481 where

483482 fromK1Columns =

484483 fromColumns2

@@ -519,10 +518,10 @@ instance

519518instance

520519 ( HTable (K1Columns "Left" structure1)

521520 , HTable (K1Columns "Right" structure2)

522− , K1Table "Left" 'True Result (IsStructure structure1) structure1 a

523− , K1Table "Right" 'True Result (IsStructure structure2) structure2 b

521+ , K1Table "Left" 'True Identity (IsStructure structure1) structure1 a

522+ , K1Table "Right" 'True Identity (IsStructure structure2) structure2 b

524523 , e ~ Either a b

525− ) => K1Table label 'True Result 'True (Shape2 'Either structure1 structure2) e

524+ ) => K1Table label 'True Identity 'True (Shape2 'Either structure1 structure2) e

526525 where

527526 fromK1Columns

528527 = bimap

@@ -566,27 +565,27 @@ instance

566565

567566

568567instance

569− ( K1Table label 'True Aggregation (IsStructure structure) structure a

570− , Table Aggregation a

568+ ( K1Table label 'True Aggregate (IsStructure structure) structure a

569+ , Table Aggregate a

571570 , K1Columns label structure ~ HLabel label (Columns a)

572571 , as ~ ListTable a

573− ) => K1Table label 'True Aggregation 'True (Shape1 'List structure) as

572+ ) => K1Table label 'True Aggregate 'True (Shape1 'List structure) as

574573 where

575− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

576− toK1Columns = hrelabel (hlabel labeler) . toColumns

574+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

575+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

577576 {-# INLINABLE fromK1Columns #-}

578577 {-# INLINABLE toK1Columns #-}

579578

580579

581580instance

582− ( K1Table label 'True DB (IsStructure structure) structure a

583− , Table DB a

581+ ( K1Table label 'True Expr (IsStructure structure) structure a

582+ , Table Expr a

584583 , K1Columns label structure ~ HLabel label (Columns a)

585584 , as ~ ListTable a

586− ) => K1Table label 'True DB 'True (Shape1 'List structure) as

585+ ) => K1Table label 'True Expr 'True (Shape1 'List structure) as

587586 where

588− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

589− toK1Columns = hrelabel (hlabel labeler) . toColumns

587+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

588+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

590589 {-# INLINABLE fromK1Columns #-}

591590 {-# INLINABLE toK1Columns #-}

592591

@@ -598,20 +597,20 @@ instance

598597 , as ~ ListTable a

599598 ) => K1Table label 'True Insertion 'True (Shape1 'List structure) as

600599 where

601− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

602− toK1Columns = hrelabel (hlabel labeler) . toColumns

600+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

601+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

603602 {-# INLINABLE fromK1Columns #-}

604603 {-# INLINABLE toK1Columns #-}

605604

606605

607606instance

608− ( K1Table label 'True Result (IsStructure structure) structure a

607+ ( K1Table label 'True Identity (IsStructure structure) structure a

609608 , HTable (K1Columns label structure)

610609 , as ~ [a]

611− ) => K1Table label 'True Result 'True (Shape1 'List structure) as

610+ ) => K1Table label 'True Identity 'True (Shape1 'List structure) as

612611 where

613− fromK1Columns = fmap (fromK1Columns @label @'True @Result @_ @structure) . fromHListTable

614− toK1Columns = toHListTable . fmap (toK1Columns @label @'True @Result @_ @structure)

612+ fromK1Columns = fmap (fromK1Columns @label @'True @Identity @_ @structure) . fromHListTable

613+ toK1Columns = toHListTable . fmap (toK1Columns @label @'True @Identity @_ @structure)

615614 {-# INLINABLE fromK1Columns #-}

616615 {-# INLINABLE toK1Columns #-}

617616

@@ -625,23 +624,23 @@ instance

625624 , as ~ ListTable a

626625 ) => K1Table label 'False context 'True (Shape1 'List structure) as

627626 where

628− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

629− toK1Columns = hrelabel (hlabel labeler) . toColumns

627+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

628+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

630629 {-# INLINABLE fromK1Columns #-}

631630 {-# INLINABLE toK1Columns #-}

632631

633632

634633instance

635634 ( HTable (K1Columns "Just" structure)

636− , K1Table "Just" 'True Aggregation (IsStructure structure) structure a

635+ , K1Table "Just" 'True Aggregate (IsStructure structure) structure a

637636 , ma ~ MaybeTable a

638− ) => K1Table label 'True Aggregation 'True (Shape1 'Maybe structure) ma

637+ ) => K1Table label 'True Aggregate 'True (Shape1 'Maybe structure) ma

639638 where

640639 fromK1Columns =

641640 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .

642− hunlabel unlabeler

641+ hunlabel hunlabeler

643642 toK1Columns =

644− hlabel labeler .

643+ hlabel hlabeler .

645644 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)

646645 {-# INLINABLE fromK1Columns #-}

647646 {-# INLINABLE toK1Columns #-}

@@ -649,15 +648,15 @@ instance

649648

650649instance

651650 ( HTable (K1Columns "Just" structure)

652− , K1Table "Just" 'True DB (IsStructure structure) structure a

651+ , K1Table "Just" 'True Expr (IsStructure structure) structure a

653652 , ma ~ MaybeTable a

654− ) => K1Table label 'True DB 'True (Shape1 'Maybe structure) ma

653+ ) => K1Table label 'True Expr 'True (Shape1 'Maybe structure) ma

655654 where

656655 fromK1Columns =

657656 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .

658− hunlabel unlabeler

657+ hunlabel hunlabeler

659658 toK1Columns =

660− hlabel labeler .

659+ hlabel hlabeler .

661660 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)

662661 {-# INLINABLE fromK1Columns #-}

663662 {-# INLINABLE toK1Columns #-}

@@ -671,9 +670,9 @@ instance

671670 where

672671 fromK1Columns =

673672 fromColumns1 (fromK1Columns @"Just" @_ @_ @_ @structure) .

674− hunlabel unlabeler

673+ hunlabel hunlabeler

675674 toK1Columns =

676− hlabel labeler .

675+ hlabel hlabeler .

677676 toColumns1 (toK1Columns @"Just" @_ @_ @_ @structure)

678677 {-# INLINABLE fromK1Columns #-}

679678 {-# INLINABLE toK1Columns #-}

@@ -681,9 +680,9 @@ instance

681680

682681instance

683682 ( HTable (K1Columns "Just" structure)

684− , K1Table "Just" 'True Result (IsStructure structure) structure a

683+ , K1Table "Just" 'True Identity (IsStructure structure) structure a

685684 , ma ~ Maybe a

686− ) => K1Table label 'True Result 'True (Shape1 'Maybe structure) ma

685+ ) => K1Table label 'True Identity 'True (Shape1 'Maybe structure) ma

687686 where

688687 fromK1Columns

689688 = fmap (fromK1Columns @"Just" @_ @_ @_ @structure)

@@ -717,27 +716,27 @@ instance

717716

718717

719718instance

720− ( K1Table label 'True Aggregation (IsStructure structure) structure a

721− , Table Aggregation a

719+ ( K1Table label 'True Aggregate (IsStructure structure) structure a

720+ , Table Aggregate a

722721 , K1Columns label structure ~ HLabel label (Columns a)

723722 , as ~ NonEmptyTable a

724− ) => K1Table label 'True Aggregation 'True (Shape1 'NonEmpty structure) as

723+ ) => K1Table label 'True Aggregate 'True (Shape1 'NonEmpty structure) as

725724 where

726− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

727− toK1Columns = hrelabel (hlabel labeler) . toColumns

725+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

726+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

728727 {-# INLINABLE fromK1Columns #-}

729728 {-# INLINABLE toK1Columns #-}

730729

731730

732731instance

733− ( K1Table label 'True DB (IsStructure structure) structure a

734− , Table DB a

732+ ( K1Table label 'True Expr (IsStructure structure) structure a

733+ , Table Expr a

735734 , K1Columns label structure ~ HLabel label (Columns a)

736735 , as ~ NonEmptyTable a

737− ) => K1Table label 'True DB 'True (Shape1 'NonEmpty structure) as

736+ ) => K1Table label 'True Expr 'True (Shape1 'NonEmpty structure) as

738737 where

739− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

740− toK1Columns = hrelabel (hlabel labeler) . toColumns

738+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

739+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

741740 {-# INLINABLE fromK1Columns #-}

742741 {-# INLINABLE toK1Columns #-}

743742

@@ -749,20 +748,20 @@ instance

749748 , as ~ NonEmptyTable a

750749 ) => K1Table label 'True Insertion 'True (Shape1 'NonEmpty structure) as

751750 where

752− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

753− toK1Columns = hrelabel (hlabel labeler) . toColumns

751+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

752+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

754753 {-# INLINABLE fromK1Columns #-}

755754 {-# INLINABLE toK1Columns #-}

756755

757756

758757instance

759− ( K1Table label 'True Result (IsStructure structure) structure a

758+ ( K1Table label 'True Identity (IsStructure structure) structure a

760759 , HTable (K1Columns label structure)

761760 , as ~ NonEmpty a

762− ) => K1Table label 'True Result 'True (Shape1 'NonEmpty structure) as

761+ ) => K1Table label 'True Identity 'True (Shape1 'NonEmpty structure) as

763762 where

764− fromK1Columns = fmap (fromK1Columns @label @'True @Result @_ @structure) . fromHNonEmptyTable

765− toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @'True @Result @_ @structure)

763+ fromK1Columns = fmap (fromK1Columns @label @'True @Identity @_ @structure) . fromHNonEmptyTable

764+ toK1Columns = toHNonEmptyTable . fmap (toK1Columns @label @'True @Identity @_ @structure)

766765 {-# INLINABLE fromK1Columns #-}

767766 {-# INLINABLE toK1Columns #-}

768767

@@ -776,8 +775,8 @@ instance

776775 , as ~ NonEmptyTable a

777776 ) => K1Table label 'False context 'True (Shape1 'NonEmpty structure) as

778777 where

779− fromK1Columns = fromColumns . hrelabel (hunlabel unlabeler)

780− toK1Columns = hrelabel (hlabel labeler) . toColumns

778+ fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

779+ toK1Columns = hrelabel (hlabel hlabeler) . toColumns

781780 {-# INLINABLE fromK1Columns #-}

782781 {-# INLINABLE toK1Columns #-}

783782

@@ -785,10 +784,10 @@ instance

785784instance

786785 ( HTable (K1Columns "Here" structure1)

787786 , HTable (K1Columns "There" structure2)

788− , K1Table "Here" 'True Aggregation (IsStructure structure1) structure1 a

789− , K1Table "There" 'True Aggregation (IsStructure structure2) structure2 b

787+ , K1Table "Here" 'True Aggregate (IsStructure structure1) structure1 a

788+ , K1Table "There" 'True Aggregate (IsStructure structure2) structure2 b

790789 , e ~ TheseTable a b

791− ) => K1Table label 'True Aggregation 'True (Shape2 'These structure1 structure2) e

790+ ) => K1Table label 'True Aggregate 'True (Shape2 'These structure1 structure2) e

792791 where

793792 fromK1Columns =

794793 fromColumns2

@@ -807,10 +806,10 @@ instance

807806instance

808807 ( HTable (K1Columns "Here" structure1)

809808 , HTable (K1Columns "There" structure2)

810− , K1Table "Here" 'True DB (IsStructure structure1) structure1 a

811− , K1Table "There" 'True DB (IsStructure structure2) structure2 b

809+ , K1Table "Here" 'True Expr (IsStructure structure1) structure1 a

810+ , K1Table "There" 'True Expr (IsStructure structure2) structure2 b

812811 , e ~ TheseTable a b

813− ) => K1Table label 'True DB 'True (Shape2 'These structure1 structure2) e

812+ ) => K1Table label 'True Expr 'True (Shape2 'These structure1 structure2) e

814813 where

815814 fromK1Columns =

816815 fromColumns2

@@ -851,10 +850,10 @@ instance

851850instance

852851 ( HTable (K1Columns "Here" structure1)

853852 , HTable (K1Columns "There" structure2)

854− , K1Table "Here" 'True Result (IsStructure structure1) structure1 a

855− , K1Table "There" 'True Result (IsStructure structure2) structure2 b

853+ , K1Table "Here" 'True Identity (IsStructure structure1) structure1 a

854+ , K1Table "There" 'True Identity (IsStructure structure2) structure2 b

856855 , e ~ These a b

857− ) => K1Table label 'True Result 'True (Shape2 'These structure1 structure2) e

856+ ) => K1Table label 'True Identity 'True (Shape2 'These structure1 structure2) e

858857 where

859858 fromK1Columns

860859 = bimap

src/Rel8/Schema/HTable.hs+41−42

@@ -36,71 +36,71 @@ import Prelude

3636

3737-- rel8

3838import Rel8.Schema.Dict ( Dict )

39−import Rel8.Schema.Spec ( Spec, SSpec, Context )

40−import Rel8.Schema.HTable.Context ( HKTable, H )

39+import Rel8.Schema.Spec ( Spec, SSpec )

4140import Rel8.Schema.HTable.Pair ( HPair( HPair ) )

41+import qualified Rel8.Schema.Kind as K

4242

4343-- semigroupoids

4444import Data.Functor.Apply ( Apply, (<.>) )

4545

4646

47−type HTable :: HKTable -> Constraint

47+type HTable :: K.HTable -> Constraint

4848class HTable t where

49− type HField t = (field :: Context) | field -> t

49+ type HField t = (field :: Spec -> Type) | field -> t

5050 type HConstrainTable t (c :: Spec -> Constraint) :: Constraint

5151

52− hfield :: t (H context) -> HField t spec -> context spec

53− htabulate :: (forall spec. HField t spec -> context spec) -> t (H context)

54− htraverse :: Apply m => (forall spec. f spec -> m (g spec)) -> t (H f) -> m (t (H g))

55− hdicts :: HConstrainTable t c => t (H (Dict c))

56− hspecs :: t (H SSpec)

52+ hfield :: t context -> HField t spec -> context spec

53+ htabulate :: (forall spec. HField t spec -> context spec) -> t context

54+ htraverse :: Apply m => (forall spec. f spec -> m (g spec)) -> t f -> m (t g)

55+ hdicts :: HConstrainTable t c => t (Dict c)

56+ hspecs :: t SSpec

5757

5858 type HField t = GHField t

59− type HConstrainTable t c = HConstrainTable (GHColumns (Rep (t (H Proxy)))) c

59+ type HConstrainTable t c = HConstrainTable (GHColumns (Rep (t Proxy))) c

6060

6161 default hfield ::

62− ( Generic (t (H context))

62+ ( Generic (t context)

6363 , HField t ~ GHField t

64− , HField (GHColumns (Rep (t (H Proxy)))) ~ HField (GHColumns (Rep (t (H context))))

65− , GHTable context (Rep (t (H context)))

64+ , HField (GHColumns (Rep (t Proxy))) ~ HField (GHColumns (Rep (t context)))

65+ , GHTable context (Rep (t context))

6666 )

67− => t (H context) -> HField t spec -> context spec

67+ => t context -> HField t spec -> context spec

6868 hfield table (GHField field) = hfield (toGHColumns (from table)) field

6969

7070 default htabulate ::

71− ( Generic (t (H context))

71+ ( Generic (t context)

7272 , HField t ~ GHField t

73− , HField (GHColumns (Rep (t (H Proxy)))) ~ HField (GHColumns (Rep (t (H context))))

74− , GHTable context (Rep (t (H context)))

73+ , HField (GHColumns (Rep (t Proxy))) ~ HField (GHColumns (Rep (t context)))

74+ , GHTable context (Rep (t context))

7575 )

76− => (forall spec. HField t spec -> context spec) -> t (H context)

76+ => (forall spec. HField t spec -> context spec) -> t context

7777 htabulate f = to $ fromGHColumns $ htabulate (f . GHField)

7878

7979 default htraverse

8080 :: forall f g m

8181 . ( Apply m

82− , Generic (t (H f)), GHTable f (Rep (t (H f)))

83− , Generic (t (H g)), GHTable g (Rep (t (H g)))

84− , GHColumns (Rep (t (H f))) ~ GHColumns (Rep (t (H g)))

82+ , Generic (t f), GHTable f (Rep (t f))

83+ , Generic (t g), GHTable g (Rep (t g))

84+ , GHColumns (Rep (t f)) ~ GHColumns (Rep (t g))

8585 )

86− => (forall spec. f spec -> m (g spec)) -> t (H f) -> m (t (H g))

86+ => (forall spec. f spec -> m (g spec)) -> t f -> m (t g)

8787 htraverse f = fmap (to . fromGHColumns) . htraverse f . toGHColumns . from

8888

8989 default hdicts

9090 :: forall c

91− . ( Generic (t (H (Dict c)))

92− , GHTable (Dict c) (Rep (t (H (Dict c))))

93− , GHColumns (Rep (t (H Proxy))) ~ GHColumns (Rep (t (H (Dict c))))

94− , HConstrainTable (GHColumns (Rep (t (H Proxy)))) c

91+ . ( Generic (t (Dict c))

92+ , GHTable (Dict c) (Rep (t (Dict c)))

93+ , GHColumns (Rep (t Proxy)) ~ GHColumns (Rep (t (Dict c)))

94+ , HConstrainTable (GHColumns (Rep (t Proxy))) c

9595 )

96− => t (H (Dict c))

97− hdicts = to $ fromGHColumns (hdicts @(GHColumns (Rep (t (H Proxy)))) @c)

96+ => t (Dict c)

97+ hdicts = to $ fromGHColumns (hdicts @(GHColumns (Rep (t Proxy))) @c)

9898

9999 default hspecs ::

100− ( Generic (t (H SSpec))

101− , GHTable SSpec (Rep (t (H SSpec)))

100+ ( Generic (t SSpec)

101+ , GHTable SSpec (Rep (t SSpec))

102102 )

103− => t (H SSpec)

103+ => t SSpec

104104 hspecs = to $ fromGHColumns hspecs

105105

106106 {-# INLINABLE hfield #-}

@@ -111,21 +111,20 @@ class HTable t where

111111

112112

113113htabulateA :: (HTable t, Apply m)

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

115− -> m (t (H context))

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

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

117116{-# INLINABLE htabulateA #-}

118117

119118

120−type GHField :: HKTable -> Context

121−newtype GHField t spec = GHField (HField (GHColumns (Rep (t (H Proxy)))) spec)

119+type GHField :: K.HTable -> Spec -> Type

120+newtype GHField t spec = GHField (HField (GHColumns (Rep (t Proxy))) spec)

122121

123122

124−type GHTable :: Context -> (Type -> Type) -> Constraint

123+type GHTable :: K.HContext -> (Type -> Type) -> Constraint

125124class HTable (GHColumns rep) => GHTable context rep | rep -> context where

126− type GHColumns rep :: HKTable

127− toGHColumns :: rep x -> GHColumns rep (H context)

128− fromGHColumns :: GHColumns rep (H context) -> rep x

125+ type GHColumns rep :: K.HTable

126+ toGHColumns :: rep x -> GHColumns rep context

127+ fromGHColumns :: GHColumns rep context -> rep x

129128

130129

131130instance GHTable context rep => GHTable context (M1 i c rep) where

@@ -134,8 +133,8 @@ instance GHTable context rep => GHTable context (M1 i c rep) where

134133 fromGHColumns = M1 . fromGHColumns

135134

136135

137−instance HTable table => GHTable context (K1 i (table (H context))) where

138− type GHColumns (K1 i (table (H context))) = table

136+instance HTable table => GHTable context (K1 i (table context)) where

137+ type GHColumns (K1 i (table context)) = table

139138 toGHColumns (K1 a) = a

140139 fromGHColumns = K1

141140

@@ -147,7 +146,7 @@ instance (GHTable context a, GHTable context b) => GHTable context (a :*: b) whe

147146

148147

149148-- | A HField type for indexing into HPair.

150−type HPairField :: HKTable -> HKTable -> Context

149+type HPairField :: K.HTable -> K.HTable -> Spec -> Type

151150data HPairField x y spec

152151 = HFst (HField x spec)

153152 | HSnd (HField y spec)

src/Rel8/Schema/HTable/Context.hsdeleted−26

@@ -1,26 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language StandaloneKindSignatures #-}

3−

4−module Rel8.Schema.HTable.Context

5− ( HContext, H, HKTable

6− )

7−where

8−

9−-- base

10−import Data.Kind ( Type )

11−import Prelude ()

12−

13−-- rel8

14−import Rel8.Schema.Spec ( Context )

15−

16−

17−type HContext :: Type

18−newtype HContext = H Context

19−

20−

21−type H :: Context -> HContext

22−type H = 'H

23−

24−

25−type HKTable :: Type

26−type HKTable = HContext -> Type

src/Rel8/Schema/HTable/Either.hs+2−2

@@ -16,14 +16,14 @@ import Prelude ()

1616-- rel8

1717import Rel8.Kind.Necessity ( Necessity( Required ) )

1818import Rel8.Schema.HTable ( HTable )

19−import Rel8.Schema.HTable.Context ( HKTable )

2019import Rel8.Schema.HTable.Identity ( HIdentity(..) )

2120import Rel8.Schema.HTable.Nullify ( HNullify )

21+import qualified Rel8.Schema.Kind as K

2222import Rel8.Schema.Spec ( Spec( Spec ) )

2323import Rel8.Type.Tag ( EitherTag )

2424

2525

26−type HEitherTable :: HKTable -> HKTable -> HKTable

26+type HEitherTable :: K.HTable -> K.HTable -> K.HTable

2727data HEitherTable left right context = HEitherTable

2828 { htag :: HIdentity ('Spec '["isRight"] 'Required EitherTag EitherTag) context

2929 , hleft :: HNullify left context

src/Rel8/Schema/HTable/Identity.hs+8−8

@@ -9,6 +9,7 @@ module Rel8.Schema.HTable.Identity

99where

1010

1111-- base

12+import Data.Kind ( Type )

1213import Prelude

1314

1415-- rel8

@@ -17,18 +18,17 @@ import Rel8.Schema.HTable

1718 ( HTable, HConstrainTable, HField

1819 , hfield, htabulate, htraverse, hdicts, hspecs

1920 )

20−import Rel8.Schema.HTable.Context ( H, HKTable )

21−import Rel8.Schema.Spec ( Context, Spec, KnownSpec, specSing )

21+import qualified Rel8.Schema.Kind as K

22+import Rel8.Schema.Spec ( Spec, KnownSpec, specSing )

2223

2324

24−type HIdentity :: Spec -> HKTable

25−data HIdentity spec context where

26− HIdentity ::

27− { unHIdentity :: context spec

28− } -> HIdentity spec (H context)

25+type HIdentity :: Spec -> K.HTable

26+newtype HIdentity spec context = HIdentity

27+ { unHIdentity :: context spec

28+ }

2929

3030

31−type HIdentityField :: Spec -> Context

31+type HIdentityField :: Spec -> Spec -> Type

3232data HIdentityField _spec spec where

3333 HIdentityField :: HIdentityField spec spec

3434

src/Rel8/Schema/HTable/Label.hs+10−10

@@ -33,16 +33,16 @@ import Rel8.Schema.HTable

3333 ( HTable, HConstrainTable, HField

3434 , hfield, htabulate, htraverse, hdicts, hspecs

3535 )

36−import Rel8.Schema.HTable.Context ( H, HKTable )

37−import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )

36+import qualified Rel8.Schema.Kind as K

37+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

3838

3939

40−type HLabel :: Symbol -> HKTable -> HKTable

40+type HLabel :: Symbol -> K.HTable -> K.HTable

4141data HLabel label table context where

42− HLabel :: table (H (LabelSpec label context)) -> HLabel label table (H context)

42+ HLabel :: table (LabelSpec label context) -> HLabel label table context

4343

4444

45−type HLabelField :: Symbol -> HKTable -> Context

45+type HLabelField :: Symbol -> K.HTable -> Spec -> Type

4646data HLabelField label table spec where

4747 HLabelField

4848 :: HField table ('Spec labels necessity db a)

@@ -62,7 +62,7 @@ instance (HTable table, KnownSymbol label) => HTable (HLabel label table) where

6262 htraverse f (HLabel t) = HLabel <$> htraverse (traverseLabelSpec f) t

6363

6464 hdicts :: forall c. HConstrainTable table (LabelSpecC label c)

65− => HLabel label table (H (Dict c))

65+ => HLabel label table (Dict c)

6666 hdicts = HLabel $ htabulate $ \field -> case hfield hspecs field of

6767 SSpec {} -> case hfield (hdicts @_ @(LabelSpecC label c)) field of

6868 Dict -> LabelSpec Dict

@@ -111,8 +111,8 @@ hlabel :: HTable t

111111 => (forall labels necessity db a. ()

112112 => context ('Spec labels necessity db a)

113113 -> context ('Spec (label ': labels) necessity db a))

114− -> t (H context)

115− -> HLabel label t (H context)

114+ -> t context

115+ -> HLabel label t context

116116hlabel labeler a = HLabel $ htabulate $ \field ->

117117 case hfield hspecs field of

118118 SSpec {} -> LabelSpec (labeler (hfield a field))

@@ -123,8 +123,8 @@ hunlabel :: HTable t

123123 => (forall labels necessity db a. ()

124124 => context ('Spec (label ': labels) necessity db a)

125125 -> context ('Spec labels necessity db a))

126− -> HLabel label t (H context)

127− -> t (H context)

126+ -> HLabel label t context

127+ -> t context

128128hunlabel unlabler (HLabel as) =

129129 htabulate $ \field -> case hfield as field of

130130 LabelSpec a -> unlabler a

src/Rel8/Schema/HTable/List.hs+2−2

@@ -10,9 +10,9 @@ where

1010import Prelude ()

1111

1212-- rel8

13−import Rel8.Schema.HTable.Context ( HKTable )

13+import qualified Rel8.Schema.Kind as K

1414import Rel8.Schema.HTable.Vectorize ( HVectorize )

1515

1616

17−type HListTable :: HKTable -> HKTable

17+type HListTable :: K.HTable -> K.HTable

1818type HListTable = HVectorize []

src/Rel8/Schema/HTable/Maybe.hs+2−2

@@ -16,14 +16,14 @@ import Prelude

1616-- rel8

1717import Rel8.Kind.Necessity ( Necessity( Required ) )

1818import Rel8.Schema.HTable ( HTable )

19−import Rel8.Schema.HTable.Context ( HKTable )

2019import Rel8.Schema.HTable.Identity ( HIdentity(..) )

2120import Rel8.Schema.HTable.Nullify ( HNullify )

21+import qualified Rel8.Schema.Kind as K

2222import Rel8.Schema.Spec ( Spec( Spec ) )

2323import Rel8.Type.Tag ( MaybeTag )

2424

2525

26−type HMaybeTable :: HKTable -> HKTable

26+type HMaybeTable :: K.HTable -> K.HTable

2727data HMaybeTable table context = HMaybeTable

2828 { htag :: HIdentity ('Spec '["isJust"] 'Required MaybeTag (Maybe MaybeTag)) context

2929 , hjust :: HNullify table context

src/Rel8/Schema/HTable/NonEmpty.hs+2−2

@@ -11,9 +11,9 @@ import Data.List.NonEmpty ( NonEmpty )

1111import Prelude ()

1212

1313-- rel8

14−import Rel8.Schema.HTable.Context ( HKTable )

1514import Rel8.Schema.HTable.Vectorize ( HVectorize )

15+import qualified Rel8.Schema.Kind as K

1616

1717

18−type HNonEmptyTable :: HKTable -> HKTable

18+type HNonEmptyTable :: K.HTable -> K.HTable

1919type HNonEmptyTable = HVectorize NonEmpty

src/Rel8/Schema/HTable/Nullify.hs+11−12

@@ -29,20 +29,19 @@ import Rel8.Schema.HTable

2929 ( HTable, HConstrainTable, HField

3030 , hfield, htabulate, htabulateA, htraverse, hdicts, hspecs

3131 )

32−import Rel8.Schema.HTable.Context ( H, HKTable )

32+import qualified Rel8.Schema.Kind as K

3333import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

34−import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )

34+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

3535

3636-- semigroupoids

3737import Data.Functor.Apply ( Apply )

3838

3939

40−type HNullify :: HKTable -> HKTable

41−data HNullify table context where

42− HNullify :: table (H (NullifySpec context)) -> HNullify table (H context)

40+type HNullify :: K.HTable -> K.HTable

41+newtype HNullify table context = HNullify (table (NullifySpec context))

4342

4443

45−type HNullifyField :: HKTable -> Context

44+type HNullifyField :: K.HTable -> Spec -> Type

4645data HNullifyField table spec where

4746 HNullifyField

4847 :: HField table ('Spec labels necessity dbType a)

@@ -63,7 +62,7 @@ instance HTable table => HTable (HNullify table) where

6362 htraverse f (HNullify t) = HNullify <$> htraverse (traverseNullifySpec f) t

6463

6564 hdicts :: forall c. HConstrainTable table (NullifySpecC c)

66− => HNullify table (H (Dict c))

65+ => HNullify table (Dict c)

6766 hdicts = HNullify $ htabulate $ \field -> case hfield hspecs field of

6867 SSpec {} -> case hfield (hdicts @_ @(NullifySpecC c)) field of

6968 Dict -> NullifySpec Dict

@@ -113,7 +112,7 @@ traverseNullifySpec f (NullifySpec a) = NullifySpec <$> f a

113112hnulls :: HTable t

114113 => (forall labels necessity dbType. ()

115114 => context ('Spec labels necessity dbType (Maybe dbType)))

116− -> HNullify t (H context)

115+ -> HNullify t context

117116hnulls null = HNullify $ htabulate $ \field -> case hfield hspecs field of

118117 SSpec {} -> NullifySpec null

119118{-# INLINABLE hnulls #-}

@@ -124,8 +123,8 @@ hnullify :: HTable t

124123 => SSpec ('Spec labels necessity dbType a)

125124 -> context ('Spec labels necessity dbType a)

126125 -> context ('Spec labels necessity dbType (Maybe dbType)))

127− -> t (H context)

128− -> HNullify t (H context)

126+ -> t context

127+ -> HNullify t context

129128hnullify nullifier a = HNullify $ htabulate $ \field ->

130129 case hfield hspecs field of

131130 spec@SSpec {} -> NullifySpec (nullifier spec (hfield a field))

@@ -137,8 +136,8 @@ hunnullify :: (HTable t, Apply m)

137136 => SSpec ('Spec labels necessity dbType a)

138137 -> context ('Spec labels necessity dbType (Maybe dbType))

139138 -> m (context ('Spec labels necessity dbType a)))

140− -> HNullify t (H context)

141− -> m (t (H context))

139+ -> HNullify t context

140+ -> m (t context)

142141hunnullify unnullifier (HNullify as) =

143142 htabulateA $ \field -> case hfield hspecs field of

144143 spec@SSpec {} -> case hfield as field of

src/Rel8/Schema/HTable/Pair.hs+2−2

@@ -10,10 +10,10 @@ where

1010import Prelude ()

1111

1212-- rel8

13−import Rel8.Schema.HTable.Context ( HKTable )

13+import qualified Rel8.Schema.Kind as K

1414

1515

16−type HPair :: HKTable -> HKTable -> HKTable

16+type HPair :: K.HTable -> K.HTable -> K.HTable

1717data HPair fst snd context = HPair

1818 { hfst :: fst context

1919 , hsnd :: snd context

src/Rel8/Schema/HTable/Quartet.hs+2−2

@@ -15,10 +15,10 @@ import Prelude ()

1515

1616-- rel8

1717import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Context ( HKTable )

18+import qualified Rel8.Schema.Kind as K

1919

2020

21−type HQuartet :: HKTable -> HKTable -> HKTable -> HKTable -> HKTable

21+type HQuartet :: K.HTable -> K.HTable -> K.HTable -> K.HTable -> K.HTable

2222data HQuartet w x y z context = HQuartet

2323 { hfst :: w context

2424 , hsnd :: x context

src/Rel8/Schema/HTable/Quintet.hs+2−2

@@ -15,10 +15,10 @@ import Prelude ()

1515

1616-- rel8

1717import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Context ( HKTable )

18+import qualified Rel8.Schema.Kind as K

1919

2020

21−type HQuintet :: HKTable -> HKTable -> HKTable -> HKTable -> HKTable -> HKTable

21+type HQuintet :: K.HTable -> K.HTable -> K.HTable -> K.HTable -> K.HTable -> K.HTable

2222data HQuintet v w x y z context = HQuintet

2323 { hfst :: v context

2424 , hsnd :: w context

src/Rel8/Schema/HTable/These.hs+2−2

@@ -16,14 +16,14 @@ import Prelude

1616-- rel8

1717import Rel8.Kind.Necessity ( Necessity( Required ) )

1818import Rel8.Schema.HTable ( HTable )

19−import Rel8.Schema.HTable.Context ( HKTable )

2019import Rel8.Schema.HTable.Identity ( HIdentity )

2120import Rel8.Schema.HTable.Nullify ( HNullify )

21+import qualified Rel8.Schema.Kind as K

2222import Rel8.Schema.Spec ( Spec( Spec ) )

2323import Rel8.Type.Tag ( MaybeTag )

2424

2525

26−type HTheseTable :: HKTable -> HKTable -> HKTable

26+type HTheseTable :: K.HTable -> K.HTable -> K.HTable

2727data HTheseTable here there context = HTheseTable

2828 { hhereTag :: HIdentity ('Spec '["hasHere"] 'Required MaybeTag (Maybe MaybeTag)) context

2929 , hhere :: HNullify here context

src/Rel8/Schema/HTable/Trio.hs+2−2

@@ -15,10 +15,10 @@ import Prelude ()

1515

1616-- rel8

1717import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Context ( HKTable )

18+import qualified Rel8.Schema.Kind as K

1919

2020

21−type HTrio :: HKTable -> HKTable -> HKTable -> HKTable

21+type HTrio :: K.HTable -> K.HTable -> K.HTable -> K.HTable

2222data HTrio x y z context = HTrio

2323 { hfst :: x context

2424 , hsnd :: y context

src/Rel8/Schema/HTable/Type.hs+7−8

@@ -22,20 +22,19 @@ import Rel8.Schema.HTable

2222 ( HTable, HConstrainTable, HField

2323 , hfield, htabulate, htraverse, hdicts, hspecs

2424 )

25−import Rel8.Schema.HTable.Context ( H, HKTable )

25+import qualified Rel8.Schema.Kind as K

2626import Rel8.Schema.Nullability ( Unnullify, Sql, nullabilization )

27−import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )

27+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

2828import Rel8.Type ( DBType, typeInformation )

2929

3030

31−type HType :: Type -> HKTable

32−data HType a context where

33− HType ::

34− { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)

35− } -> HType a (H context)

31+type HType :: Type -> K.HTable

32+newtype HType a context = HType

33+ { unHType :: context ('Spec '[""] 'Required (Unnullify a) a)

34+ }

3635

3736

38−type HTypeField :: Type -> Context

37+type HTypeField :: Type -> Spec -> Type

3938data HTypeField a spec where

4039 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)

4140

src/Rel8/Schema/HTable/Vectorize.hs+23−24

@@ -32,15 +32,15 @@ import Data.Type.Equality ( (:~:)( Refl ) )

3232import Prelude

3333

3434-- rel8

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

35+import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

3636import Rel8.Schema.Dict ( Dict( Dict ) )

37+import qualified Rel8.Schema.Kind as K

3738import Rel8.Schema.HTable

3839 ( HTable, HConstrainTable, HField

3940 , hfield, htabulate, htabulateA, htraverse, hdicts, hspecs

4041 )

41−import Rel8.Schema.HTable.Context ( H, HKTable )

4242import Rel8.Schema.Nullability ( IsMaybe, Nullability( NonNullable ) )

43−import Rel8.Schema.Spec ( Context, Spec( Spec ), SSpec(..) )

43+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

4444import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )

4545import Rel8.Type.Information ( TypeInformation )

4646

@@ -66,12 +66,12 @@ instance Vector NonEmpty where

6666 vectorTypeInformation = nonEmptyTypeInformation

6767

6868

69−type HVectorize :: (Type -> Type) -> HKTable -> HKTable

70−data HVectorize list table context where

71− HVectorize :: table (H (VectorizeSpec list context)) -> HVectorize list table (H context)

69+type HVectorize :: (Type -> Type) -> K.HTable -> K.HTable

70+newtype HVectorize list table context =

71+ HVectorize (table (VectorizeSpec list context))

7272

7373

74−type HVectorizeField :: (Type -> Type) -> HKTable -> Context

74+type HVectorizeField :: (Type -> Type) -> K.HTable -> Spec -> Type

7575data HVectorizeField list table spec where

7676 HVectorizeField

7777 :: HField table ('Spec labels necessity db a)

@@ -81,7 +81,6 @@ data HVectorizeField list table spec where

8181

8282

8383instance (HTable table, Vector list) => HTable (HVectorize list table) where

84−

8584 type HField (HVectorize list table) = HVectorizeField list table

8685 type HConstrainTable (HVectorize list table) c =

8786 HConstrainTable table (VectorizeSpecC list c)

@@ -94,7 +93,7 @@ instance (HTable table, Vector list) => HTable (HVectorize list table) where

9493 htraverse f (HVectorize t) = HVectorize <$> htraverse (traverseVectorizeSpec f) t

9594

9695 hdicts :: forall c. HConstrainTable table (VectorizeSpecC list c) =>

97− HVectorize list table (H (Dict c))

96+ HVectorize list table (Dict c)

9897 hdicts = HVectorize $ htabulate $ \field -> case hfield hspecs field of

9998 SSpec {} -> case hfield (hdicts @_ @(VectorizeSpecC list c)) field of

10099 Dict -> VectorizeSpec Dict

@@ -125,9 +124,9 @@ data VectorizeSpec list context spec where

125124 } -> VectorizeSpec list context ('Spec labels necessity db a)

126125

127126

128−instance Labelable context => Labelable (VectorizeSpec list context) where

129− labeler (VectorizeSpec a) = VectorizeSpec (labeler a)

130− unlabeler (VectorizeSpec a) = VectorizeSpec (unlabeler a)

127+instance HLabelable context => HLabelable (VectorizeSpec list context) where

128+ hlabeler (VectorizeSpec a) = VectorizeSpec (hlabeler a)

129+ hunlabeler (VectorizeSpec a) = VectorizeSpec (hunlabeler a)

131130

132131

133132type VectorizeSpecC :: VectorizingSpec Constraint

@@ -157,8 +156,8 @@ hvectorize :: (HTable t, Unzip f)

157156 => SSpec ('Spec labels necessity db a)

158157 -> f (context ('Spec labels necessity db a))

159158 -> context' ('Spec labels necessity (list a) (list a)))

160− -> f (t (H context))

161− -> HVectorize list t (H context')

159+ -> f (t context)

160+ -> HVectorize list t context'

162161hvectorize vectorizer as = HVectorize $ htabulate $ \field ->

163162 case hfield hspecs field of

164163 spec@SSpec {} -> VectorizeSpec (vectorizer spec (fmap (`hfield` field) as))

@@ -170,8 +169,8 @@ hunvectorize :: (HTable t, Repeat f)

170169 => SSpec ('Spec labels necessity db a)

171170 -> context ('Spec labels necessity (list a) (list a))

172171 -> f (context' ('Spec labels necessity db a)))

173− -> HVectorize list t (H context)

174− -> f (t (H context'))

172+ -> HVectorize list t context

173+ -> f (t context')

175174hunvectorize unvectorizer (HVectorize table) =

176175 getZippy $ htabulateA $ \field -> case hfield hspecs field of

177176 spec -> case hfield table field of

@@ -187,9 +186,9 @@ happend :: HTable t =>

187186 -> context ('Spec labels necessity (list a) (list a))

188187 -> context ('Spec labels necessity (list a) (list a))

189188 )

190− -> HVectorize list t (H context)

191− -> HVectorize list t (H context)

192− -> HVectorize list t (H context)

189+ -> HVectorize list t context

190+ -> HVectorize list t context

191+ -> HVectorize list t context

193192happend append (HVectorize as) (HVectorize bs) = HVectorize $

194193 htabulate $ \field -> case (hfield as field, hfield bs field) of

195194 (VectorizeSpec a, VectorizeSpec b) -> case hfield hspecs field of

@@ -202,13 +201,13 @@ hempty :: HTable t =>

202201 -> TypeInformation db

203202 -> context ('Spec labels necessity [a] [a])

204203 )

205− -> HVectorize [] t (H context)

204+ -> HVectorize [] t context

206205hempty empty = HVectorize $ htabulate $ \field -> case hfield hspecs field of

207206 SSpec {nullability, info} -> VectorizeSpec (empty nullability info)

208207

209208

210−hrelabel :: Labelable context

211− => (forall ctx. Labelable ctx => t (H ctx) -> u (H ctx))

212− -> HVectorize list t (H context)

213− -> HVectorize list u (H context)

209+hrelabel :: HLabelable context

210+ => (forall ctx. HLabelable ctx => t ctx -> u ctx)

211+ -> HVectorize list t context

212+ -> HVectorize list u context

214213hrelabel f (HVectorize table) = HVectorize (f table)

src/Rel8/Schema/Kind.hsnew file+30

@@ -0,0 +1,30 @@

1+{-# language StandaloneKindSignatures #-}

3+module Rel8.Schema.Kind

4+ ( Context, Table

5+ , HContext, HTable

6+ )

7+where

9+-- base

10+import Data.Kind ( Type )

11+import Prelude ()

12+

13+-- rel8

14+import Rel8.Schema.Spec ( Spec )

15+

16+

17+type HContext :: Type

18+type HContext = Spec -> Type

19+

20+

21+type HTable :: Type

22+type HTable = HContext -> Type

23+

24+

25+type Context :: Type

26+type Context = Type -> Type

27+

28+

29+type Table :: Type

30+type Table = Context -> Type

src/Rel8/Schema/Spec.hs+9−4

@@ -8,7 +8,8 @@ module Rel8.Schema.Spec

88 ( Spec( Spec )

99 , SSpec( SSpec, labels, necessity, info, nullability )

1010 , KnownSpec( specSing )

11− , Context, KTable

11+ , KContext, HKTable

12+ , KTable

1213 )

1314where

1415

@@ -64,9 +65,13 @@ instance

6465 }

6566

6667

67−type Context :: Type

68−type Context = Spec -> Type

68+type KContext :: Type

69+type KContext = Spec -> Type

70+

71+

72+type HKTable :: Type

73+type HKTable = KContext -> Type

6974

7075

7176type KTable :: Type

72−type KTable = Context -> Type

77+type KTable = (Type -> Type) -> Type

src/Rel8/Schema/Spec/ConstrainContext.hsdeleted−23

@@ -1,23 +0,0 @@

1−{-# language ConstraintKinds #-}

2−{-# language DataKinds #-}

3−{-# language FlexibleInstances #-}

4−{-# language MultiParamTypeClasses #-}

5−{-# language StandaloneKindSignatures #-}

6−{-# language UndecidableSuperClasses #-}

7−

8−module Rel8.Schema.Spec.ConstrainContext

9− ( ConstrainContext

10− )

11−where

12−

13−-- base

14−import Data.Kind ( Constraint, Type )

15−import Prelude ()

16−

17−-- rel8

18−import Rel8.Schema.Spec ( Context, Spec )

19−

20−

21−type ConstrainContext :: (Type -> Constraint) -> Context -> Spec -> Constraint

22−class constraint (context spec) => ConstrainContext constraint context spec

23−instance constraint (context spec) => ConstrainContext constraint context spec

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

@@ -17,11 +17,12 @@ import Data.Kind ( Type )

1717import Prelude

1818

1919-- rel8

20−import Rel8.Schema.Spec ( Context, Spec )

20+import qualified Rel8.Schema.Kind as K

21+import Rel8.Schema.Spec ( Spec )

2122

2223

23−type Structure :: Context

24−data Structure spec

24+type Structure :: K.Context

25+data Structure a

2526

2627

2728type Shape :: Type

src/Rel8/Table.hs+41−24

@@ -24,13 +24,10 @@ import Rel8.Aggregate ( Aggregate )

2424import Rel8.Expr ( Expr )

2525import Rel8.Opaque ( Opaque, Opaque1 )

2626import Rel8.Schema.Context

27− ( Aggregation( Aggregation )

28− , DB( DB ), unDB

29− , Result( Result )

27+ ( Col, Col'(..), Insertion(..), Name, IsSpecialContext

3028 )

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

3230import Rel8.Schema.HTable ( HTable, hfield, hspecs, htabulate, htabulateA )

33−import Rel8.Schema.HTable.Context ( H, HKTable )

3431import Rel8.Schema.HTable.Identity ( HIdentity(..) )

3532import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

3633import Rel8.Schema.HTable.Pair ( HPair(..) )

@@ -38,42 +35,46 @@ import Rel8.Schema.HTable.Quartet ( HQuartet(..) )

3835import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

3936import Rel8.Schema.HTable.Trio ( HTrio(..) )

4037import Rel8.Schema.HTable.Type ( HType( HType ) )

38+import qualified Rel8.Schema.Kind as K

4139import Rel8.Schema.Nullability ( Sql )

4240import Rel8.Schema.Spec ( SSpec( SSpec ), KnownSpec )

43−import qualified Rel8.Schema.Spec as Kind ( Context )

4441import Rel8.Type ( DBType )

4542

4643

47−type Table :: Kind.Context -> Type -> Constraint

44+type Table :: K.Context -> Type -> Constraint

4845class (HTable (Columns a), context ~ Context a) => Table context a | a -> context where

49− type Columns a :: HKTable

50− type Context a :: Kind.Context

46+ type Columns a :: K.HTable

47+ type Context a :: K.Context

5148

52− toColumns :: a -> Columns a (H (Context a))

53− fromColumns :: Columns a (H (Context a)) -> a

49+ toColumns :: a -> Columns a (Col (Context a))

50+ fromColumns :: Columns a (Col (Context a)) -> a

5451

5552

5653-- | Any 'HTable' is also a 'Table'.

57−instance HTable t => Table context (t (H context)) where

58− type Columns (t (H context)) = t

59− type Context (t (H context)) = context

54+instance (HTable t, x ~ IsSpecialContext context) =>

55+ Table context (t (Col' x context))

56+ where

57+ type Columns (t (Col' x context)) = t

58+ type Context (t (Col' x context)) = context

6059

6160 toColumns = id

6261 fromColumns = id

6362

6463

6564-- | Any context is trivially a table.

66−instance KnownSpec spec => Table context (context spec) where

67− type Columns (context spec) = HIdentity spec

68− type Context (context spec) = context

65+instance (KnownSpec spec, x ~ IsSpecialContext context) =>

66+ Table context (Col' x context spec)

67+ where

68+ type Columns (Col' x context spec) = HIdentity spec

69+ type Context (Col' x context spec) = context

6970

7071 toColumns = HIdentity

7172 fromColumns = unHIdentity

7273

7374

74−instance Table DB a => Table Aggregation (Aggregate a) where

75+instance Table Expr a => Table Aggregate (Aggregate a) where

7576 type Columns (Aggregate a) = Columns a

76− type Context (Aggregate a) = Aggregation

77+ type Context (Aggregate a) = Aggregate

7778

7879 toColumns a = htabulate $ \field -> case hfield hspecs field of

7980 SSpec {} -> Aggregation $ unDB . (`hfield` field) . toColumns <$> a

@@ -82,22 +83,38 @@ instance Table DB a => Table Aggregation (Aggregate a) where

8283 Aggregation a -> DB <$> a

8384

8485

85−instance Sql DBType a => Table DB (Expr a) where

86+instance Sql DBType a => Table Expr (Expr a) where

8687 type Columns (Expr a) = HType a

87− type Context (Expr a) = DB

88+ type Context (Expr a) = Expr

8889

8990 toColumns a = HType (DB a)

9091 fromColumns (HType (DB a)) = a

9192

9293

93−instance Sql DBType a => Table Result (Identity a) where

94+instance Sql DBType a => Table Identity (Identity a) where

9495 type Columns (Identity a) = HType a

95− type Context (Identity a) = Result

96+ type Context (Identity a) = Identity

9697

9798 toColumns (Identity a) = HType (Result a)

9899 fromColumns (HType (Result a)) = Identity a

99100

100101

102+instance Sql DBType a => Table Insertion (Insertion a) where

103+ type Columns (Insertion a) = HType a

104+ type Context (Insertion a) = Insertion

105+

106+ toColumns (Insertion a) = HType (RequiredInsert a)

107+ fromColumns (HType (RequiredInsert a)) = Insertion a

108+

109+

110+instance Sql DBType a => Table Name (Name a) where

111+ type Columns (Name a) = HType a

112+ type Context (Name a) = Name

113+

114+ toColumns a = HType (Col a)

115+ fromColumns (HType (Col a)) = a

116+

117+

101118instance

102119 ( Table context a, Table context b

103120 , Labelable context

@@ -202,9 +219,9 @@ instance

202219 )

203220

204221

205−instance Table DB Opaque where

222+instance Table Expr Opaque where

206223 type Columns Opaque = HType Opaque

207− type Context Opaque = DB

224+ type Context Opaque = Expr

208225

209226 fromColumns = error "opaque"

210227 toColumns = error "opaque"

src/Rel8/Table/Aggregate.hs+4−3

@@ -19,8 +19,9 @@ import Prelude

1919

2020-- rel8

2121import Rel8.Aggregate ( Aggregate )

22+import Rel8.Expr ( Expr )

2223import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr, sgroupByExpr )

23−import Rel8.Schema.Context ( Aggregation( Aggregation ), DB( DB ) )

24+import Rel8.Schema.Context ( Col'(..) )

2425import Rel8.Schema.Dict ( Dict( Dict ) )

2526import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )

2627import Rel8.Schema.HTable.Vectorize ( hvectorize )

@@ -60,7 +61,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

6061-- items <- aggregate $ listAgg <$> itemsFromOrder order

6162-- return (order, items)

6263-- @

63−listAgg :: Table DB exprs => exprs -> Aggregate (ListTable exprs)

64+listAgg :: Table Expr exprs => exprs -> Aggregate (ListTable exprs)

6465listAgg (toColumns -> exprs) = fromColumns $

6566 hvectorize

6667 (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)

@@ -68,7 +69,7 @@ listAgg (toColumns -> exprs) = fromColumns $

6869

6970

7071-- | Like 'listAgg', but the result is guaranteed to be a non-empty list.

71−nonEmptyAgg :: Table DB exprs => exprs -> Aggregate (NonEmptyTable exprs)

72+nonEmptyAgg :: Table Expr exprs => exprs -> Aggregate (NonEmptyTable exprs)

7273nonEmptyAgg (toColumns -> exprs) = fromColumns $

7374 hvectorize

7475 (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)

src/Rel8/Table/Alternative.hs+3−3

@@ -13,16 +13,16 @@ import Data.Kind ( Constraint, Type )

1313import Prelude ()

1414

1515-- rel8

16−import Rel8.Schema.Context ( DB )

16+import Rel8.Expr ( Expr )

1717import Rel8.Table ( Table )

1818

1919

2020type AltTable :: (Type -> Type) -> Constraint

2121class AltTable f where

22− (<|>:) :: Table DB a => f a -> f a -> f a

22+ (<|>:) :: Table Expr a => f a -> f a -> f a

2323 infixl 3 <|>:

2424

2525

2626type AlternativeTable :: (Type -> Type) -> Constraint

2727class AltTable f => AlternativeTable f where

28− emptyTable :: Table DB a => f a

28+ emptyTable :: Table Expr a => f a

src/Rel8/Table/Bool.hs+3−3

@@ -14,12 +14,12 @@ import Prelude

1414-- rel8

1515import Rel8.Expr ( Expr )

1616import Rel8.Expr.Bool ( boolExpr, caseExpr )

17−import Rel8.Schema.Context ( DB( DB ), unDB )

17+import Rel8.Schema.Context ( Col'(..) )

1818import Rel8.Schema.HTable ( htabulate, hfield )

1919import Rel8.Table ( Table, fromColumns, toColumns )

2020

2121

22−bool :: Table DB a => a -> a -> Expr Bool -> a

22+bool :: Table Expr a => a -> a -> Expr Bool -> a

2323bool (toColumns -> false) (toColumns -> true) condition =

2424 fromColumns $ htabulate $ \field ->

2525 case (hfield false field, hfield true field) of

@@ -27,7 +27,7 @@ bool (toColumns -> false) (toColumns -> true) condition =

2727 DB (boolExpr falseExpr trueExpr condition)

2828

2929

30−case_ :: Table DB a => [(Expr Bool, a)] -> a -> a

30+case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a

3131case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =

3232 fromColumns $ htabulate $ \field -> case hfield fallback field of

3333 DB fallbackExpr ->

src/Rel8/Table/Either.hs+8−9

@@ -25,7 +25,6 @@ import Prelude hiding ( undefined )

2525-- rel8

2626import Rel8.Expr ( Expr )

2727import Rel8.Expr.Serialize ( litExpr )

28−import Rel8.Schema.Context ( DB )

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

3029import Rel8.Schema.Context.Nullify

3130 ( Nullifiable, NullifiableEq

@@ -64,27 +63,27 @@ instance Bifunctor EitherTable where

6463 bimap f g (EitherTable tag a b) = EitherTable tag (f a) (g b)

6564

6665

67−instance Table DB a => Apply (EitherTable a) where

66+instance Table Expr a => Apply (EitherTable a) where

6867 EitherTable tag l1 f <.> EitherTable tag' l2 a =

6968 EitherTable (tag <> tag') (bool l1 l2 (isLeft tag)) (f a)

7069

7170

72−instance Table DB a => Applicative (EitherTable a) where

71+instance Table Expr a => Applicative (EitherTable a) where

7372 pure = rightTable

7473 (<*>) = (<.>)

7574

7675

77−instance Table DB a => Bind (EitherTable a) where

76+instance Table Expr a => Bind (EitherTable a) where

7877 EitherTable tag l1 a >>- f = case f a of

7978 EitherTable tag' l2 b ->

8079 EitherTable (tag <> tag') (bool l1 l2 (isRight tag)) b

8180

8281

83−instance Table DB a => Monad (EitherTable a) where

82+instance Table Expr a => Monad (EitherTable a) where

8483 (>>=) = (>>-)

8584

8685

87−instance (Table DB a, Table DB b) => Semigroup (EitherTable a b) where

86+instance (Table Expr a, Table Expr b) => Semigroup (EitherTable a b) where

8887 a <> b = bool a b (isRightTable a)

8988

9089

@@ -160,15 +159,15 @@ isRightTable :: EitherTable a b -> Expr Bool

160159isRightTable = isRight . tag

161160

162161

163−eitherTable :: Table DB c

162+eitherTable :: Table Expr c

164163 => (a -> c) -> (b -> c) -> EitherTable a b -> c

165164eitherTable f g EitherTable {tag, left, right} =

166165 bool (f left) (g right) (isRight tag)

167166

168167

169−leftTable :: Table DB b => a -> EitherTable a b

168+leftTable :: Table Expr b => a -> EitherTable a b

170169leftTable a = EitherTable (litExpr IsLeft) a undefined

171170

172171

173−rightTable :: Table DB a => b -> EitherTable a b

172+rightTable :: Table Expr a => b -> EitherTable a b

174173rightTable = EitherTable (litExpr IsRight) undefined

src/Rel8/Table/Eq.hs+3−3

@@ -27,7 +27,7 @@ import Rel8.Expr ( Expr )

2727import Rel8.Expr.Bool ( (||.), (&&.) )

2828import Rel8.Expr.Eq ( seq, sne )

2929import Rel8.Opaque ( Opaque )

30−import Rel8.Schema.Context ( DB( DB ) )

30+import Rel8.Schema.Context ( Col'(..) )

3131import Rel8.Schema.Dict ( Dict( Dict ) )

3232import Rel8.Schema.HTable

3333 ( HConstrainTable

@@ -42,11 +42,11 @@ import Rel8.Type.Eq ( DBEq )

4242

4343type EqTable :: Type -> Constraint

4444class

45− ( Table DB a

45+ ( Table Expr a

4646 , HConstrainTable (Columns a) (ConstrainDBType DBEq)

4747 ) => EqTable a

4848instance

49− ( Table DB a

49+ ( Table Expr a

5050 , HConstrainTable (Columns a) (ConstrainDBType DBEq)

5151 ) => EqTable a

5252instance {-# OVERLAPPING #-} EqTable Opaque

src/Rel8/Table/Insert.hs+1−1

@@ -14,7 +14,7 @@ import Prelude

1414

1515-- rel8

1616import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )

17−import Rel8.Schema.Context ( DB(..), Insertion(..) )

17+import Rel8.Schema.Context ( Col'(..) )

1818import Rel8.Schema.HTable ( hfield, htabulate, hspecs )

1919import Rel8.Schema.Spec ( SSpec(..) )

2020import Rel8.Table ( fromColumns, toColumns )

src/Rel8/Table/Lifted.hs+18−23

@@ -16,47 +16,42 @@ import Data.Kind ( Constraint, Type )

1616import Prelude ()

1717

1818-- rel8

19+import Rel8.Schema.Context ( Interpretation, Col )

1920import Rel8.Schema.HTable ( HTable )

20−import Rel8.Schema.HTable.Context ( H, HKTable )

21−import Rel8.Schema.Spec ( Context )

21+import qualified Rel8.Schema.Kind as K

2222

2323

2424type Table1 :: (Type -> Type) -> Constraint

2525class Table1 f where

26− type Columns1 f :: HKTable -> HKTable

27− type ConstrainContext1 f :: Context -> Constraint

28− type ConstrainContext1 _ = DefaultConstrainContext

26+ type Columns1 f :: K.HTable -> K.HTable

27+ type ConstrainContext1 f :: K.Context -> Constraint

28+ type ConstrainContext1 _ = Interpretation

2929

3030 toColumns1 :: (ConstrainContext1 f context, HTable t)

31− => (a -> t (H context))

31+ => (a -> t (Col context))

3232 -> f a

33− -> Columns1 f t (H context)

33+ -> Columns1 f t (Col context)

3434

3535 fromColumns1 :: (ConstrainContext1 f context, HTable t)

36− => (t (H context) -> a)

37− -> Columns1 f t (H context)

36+ => (t (Col context) -> a)

37+ -> Columns1 f t (Col context)

3838 -> f a

3939

4040

4141type Table2 :: (Type -> Type -> Type) -> Constraint

4242class Table2 p where

43− type Columns2 p :: HKTable -> HKTable -> HKTable

44− type ConstrainContext2 p :: Context -> Constraint

45− type ConstrainContext2 _ = DefaultConstrainContext

43+ type Columns2 p :: K.HTable -> K.HTable -> K.HTable

44+ type ConstrainContext2 p :: K.Context -> Constraint

45+ type ConstrainContext2 _ = Interpretation

4646

4747 toColumns2 :: (ConstrainContext2 p context, HTable t, HTable u)

48− => (a -> t (H context))

49− -> (b -> u (H context))

48+ => (a -> t (Col context))

49+ -> (b -> u (Col context))

5050 -> p a b

51− -> Columns2 p t u (H context)

51+ -> Columns2 p t u (Col context)

5252

5353 fromColumns2 :: (ConstrainContext2 p context, HTable t, HTable u)

54− => (t (H context) -> a)

55− -> (u (H context) -> b)

56− -> Columns2 p t u (H context)

54+ => (t (Col context) -> a)

55+ -> (u (Col context) -> b)

56+ -> Columns2 p t u (Col context)

5757 -> p a b

58−

59−

60−type DefaultConstrainContext :: Context -> Constraint

61−class DefaultConstrainContext context

62−instance DefaultConstrainContext context

src/Rel8/Table/List.hs+5−5

@@ -15,9 +15,9 @@ import Data.Kind ( Type )

1515import Prelude

1616

1717-- rel8

18+import Rel8.Expr ( Expr )

1819import Rel8.Expr.Array ( sappend, sempty )

19−import Rel8.Schema.Context ( DB( DB ) )

20−import Rel8.Schema.HTable.Context ( H )

20+import Rel8.Schema.Context ( Col, Col'(..) )

2121import Rel8.Schema.HTable.List ( HListTable )

2222import Rel8.Schema.HTable.Vectorize ( happend, hempty )

2323import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

@@ -31,7 +31,7 @@ import Rel8.Table.Recontextualize ( Recontextualize )

3131-- | A @ListTable@ value contains zero or more instances of @a@. You construct

3232-- @ListTable@s with 'many' or 'listAgg'.

3333type ListTable :: Type -> Type

34−newtype ListTable a = ListTable (HListTable (Columns a) (H (Context a)))

34+newtype ListTable a = ListTable (HListTable (Columns a) (Col (Context a)))

3535

3636

3737instance Table context a => Table context (ListTable a) where

@@ -54,11 +54,11 @@ instance AlternativeTable ListTable where

5454 emptyTable = mempty

5555

5656

57−instance Table DB a => Semigroup (ListTable a) where

57+instance Table Expr a => Semigroup (ListTable a) where

5858 ListTable as <> ListTable bs = ListTable $

5959 happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs

6060

6161

62−instance Table DB a => Monoid (ListTable a) where

62+instance Table Expr a => Monoid (ListTable a) where

6363 mempty = ListTable $ hempty $ \nullability info ->

6464 DB (sempty nullability info)

src/Rel8/Table/Maybe.hs+4−5

@@ -29,7 +29,6 @@ import Rel8.Expr ( Expr )

2929import Rel8.Expr.Bool ( boolExpr )

3030import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )

3131import Rel8.Expr.Serialize ( litExpr )

32−import Rel8.Schema.Context ( DB )

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

3433import Rel8.Schema.Context.Nullify

3534 ( Nullifiable

@@ -115,11 +114,11 @@ instance AlternativeTable MaybeTable where

115114 emptyTable = nothingTable

116115

117116

118−instance (Table DB a, Semigroup a) => Semigroup (MaybeTable a) where

117+instance (Table Expr a, Semigroup a) => Semigroup (MaybeTable a) where

119118 ma <> mb = maybeTable mb (\a -> maybeTable ma (justTable . (a <>)) mb) ma

120119

121120

122−instance (Table DB a, Semigroup a) => Monoid (MaybeTable a) where

121+instance (Table Expr a, Semigroup a) => Monoid (MaybeTable a) where

123122 mempty = nothingTable

124123

125124

@@ -176,12 +175,12 @@ isJustTable (MaybeTable tag _) = isNonNull tag

176175

177176

178177-- | Perform case analysis on a 'MaybeTable'. Like 'maybe'.

179−maybeTable :: Table DB b => b -> (a -> b) -> MaybeTable a -> b

178+maybeTable :: Table Expr b => b -> (a -> b) -> MaybeTable a -> b

180179maybeTable b f ma@(MaybeTable _ a) = bool (f a) b (isNothingTable ma)

181180

182181

183182-- | The null table. Like 'Nothing'.

184−nothingTable :: Table DB a => MaybeTable a

183+nothingTable :: Table Expr a => MaybeTable a

185184nothingTable = MaybeTable null undefined

186185

187186

src/Rel8/Table/Name.hs+3−3

@@ -24,7 +24,7 @@ import Text.Casing ( quietSnake )

2424

2525-- rel8

2626import Rel8.Kind.Labels ( renderLabels )

27−import Rel8.Schema.Context ( Name( Name ) )

27+import Rel8.Schema.Context ( Col'(..), Name( Name ) )

2828import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )

2929import Rel8.Schema.Spec ( SSpec(..) )

3030import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

@@ -40,7 +40,7 @@ namesFromLabelsWith :: Table Name a

4040 => (NonEmpty String -> String) -> a

4141namesFromLabelsWith f = fromColumns $ htabulate $ \field ->

4242 case hfield hspecs field of

43− SSpec {labels} -> Name (f (renderLabels labels))

43+ SSpec {labels} -> Col (Name (f (renderLabels labels)))

4444

4545

4646showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]

@@ -52,4 +52,4 @@ showLabels _ = getConst $

5252showNames :: forall a. Table Name a => a -> [String]

5353showNames (toColumns -> names) = getConst $

5454 htabulateA @(Columns a) $ \field -> case hfield names field of

55− Name name -> Const [name]

55+ Col (Name name) -> Const [name]

src/Rel8/Table/NonEmpty.hs+4−4

@@ -15,9 +15,9 @@ import Data.Kind ( Type )

1515import Prelude

1616

1717-- rel8

18+import Rel8.Expr ( Expr )

1819import Rel8.Expr.Array ( sappend1 )

19−import Rel8.Schema.Context ( DB( DB ) )

20−import Rel8.Schema.HTable.Context ( H )

20+import Rel8.Schema.Context ( Col, Col'(..) )

2121import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )

2222import Rel8.Schema.HTable.Vectorize ( happend )

2323import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

@@ -29,7 +29,7 @@ import Rel8.Table.Recontextualize ( Recontextualize )

2929-- construct @NonEmptyTable@s with 'some' or 'nonEmptyAgg'.

3030type NonEmptyTable :: Type -> Type

3131newtype NonEmptyTable a =

32− NonEmptyTable (HNonEmptyTable (Columns a) (H (Context a)))

32+ NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))

3333

3434

3535instance Table context a => Table context (NonEmptyTable a) where

@@ -48,6 +48,6 @@ instance AltTable NonEmptyTable where

4848 (<|>:) = (<>)

4949

5050

51−instance Table DB a => Semigroup (NonEmptyTable a) where

51+instance Table Expr a => Semigroup (NonEmptyTable a) where

5252 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $

5353 happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs

src/Rel8/Table/Opaleye.hs+9−8

@@ -33,6 +33,7 @@ import Data.Profunctor ( dimap, lmap )

3333

3434-- rel8

3535import Rel8.Aggregate ( Aggregate( Aggregate ) )

36+import Rel8.Expr ( Expr )

3637import Rel8.Expr.Opaleye

3738 ( scastExpr

3839 , fromPrimExpr, toPrimExpr

@@ -40,7 +41,7 @@ import Rel8.Expr.Opaleye

4041 , fromColumn, toColumn

4142 )

4243import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

43−import Rel8.Schema.Context ( DB(..), Insertion(..), Name(..) )

44+import Rel8.Schema.Context ( Col, Col'(..), Insertion, Name(..) )

4445import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs )

4546import Rel8.Schema.Spec ( SSpec(..) )

4647import Rel8.Schema.Table ( TableSchema(..) )

@@ -57,7 +58,7 @@ aggregator = Opaleye.Aggregator $ Opaleye.PackMap $

5758 \f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap inner))) -> inner f ()

5859

5960

60−binaryspec :: Table DB a => Opaleye.Binaryspec a a

61+binaryspec :: Table Expr a => Opaleye.Binaryspec a a

6162binaryspec = Opaleye.Binaryspec $ Opaleye.PackMap $ \f (as, bs) ->

6263 fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->

6364 WrapApplicative $

@@ -65,7 +66,7 @@ binaryspec = Opaleye.Binaryspec $ Opaleye.PackMap $ \f (as, bs) ->

6566 (DB a, DB b) -> DB . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)

6667

6768

68−distinctspec :: Table DB a => Opaleye.Distinctspec a a

69+distinctspec :: Table Expr a => Opaleye.Distinctspec a a

6970distinctspec =

7071 Opaleye.Distinctspec $ Opaleye.Aggregator $ Opaleye.PackMap $ \f ->

7172 fmap fromColumns .

@@ -94,8 +95,8 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $

9495 specs -> case hfield names field of

9596 name -> lmap (`hfield` field) (go specs name)

9697 where

97− go :: SSpec spec -> Name spec -> Opaleye.TableFields (Insertion spec) (DB spec)

98− go SSpec {necessity, info, nullability} (Name name) =

98+ go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insertion spec) (Col Expr spec)

99+ go SSpec {necessity, info, nullability} (Col (Name name)) =

99100 case necessity of

100101 SRequired ->

101102 lmap (\(RequiredInsert a) -> toColumn $ toPrimExpr a) $

@@ -107,7 +108,7 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $

107108 Opaleye.optionalTableField name

108109

109110

110−unpackspec :: Table DB a => Opaleye.Unpackspec a a

111+unpackspec :: Table Expr a => Opaleye.Unpackspec a a

111112unpackspec = Opaleye.Unpackspec $ Opaleye.PackMap $ \f ->

112113 fmap fromColumns .

113114 unwrapApplicative .

@@ -116,11 +117,11 @@ unpackspec = Opaleye.Unpackspec $ Opaleye.PackMap $ \f ->

116117{-# INLINABLE unpackspec #-}

117118

118119

119−valuesspec :: Table DB a => Opaleye.ValuesspecSafe a a

120+valuesspec :: Table Expr a => Opaleye.ValuesspecSafe a a

120121valuesspec = Opaleye.ValuesspecSafe (toPackMap undefined) unpackspec

121122

122123

123−toPackMap :: Table DB a

124+toPackMap :: Table Expr a

124125 => a -> Opaleye.PackMap Opaleye.PrimExpr Opaleye.PrimExpr () a

125126toPackMap as = Opaleye.PackMap $ \f () ->

126127 fmap fromColumns $

src/Rel8/Table/Ord.hs+1−1

@@ -25,7 +25,7 @@ import Rel8.Expr.Bool ( (||.), (&&.), false, true )

2525import Rel8.Expr.Eq ( seq )

2626import Rel8.Expr.Ord ( slt, sgt)

2727import Rel8.Opaque ( Opaque )

28−import Rel8.Schema.Context ( DB( DB ) )

28+import Rel8.Schema.Context ( Col'(..) )

2929import Rel8.Schema.Dict ( Dict( Dict ) )

3030import Rel8.Schema.HTable

3131 ( HConstrainTable

src/Rel8/Table/Recontextualize.hs+78−27

@@ -25,18 +25,17 @@ import Prelude ()

2525import Rel8.Aggregate ( Aggregate )

2626import Rel8.Expr ( Expr )

2727import Rel8.Opaque ( Opaque, Opaque1 )

28−import Rel8.Schema.Context ( Aggregation, DB, Insertion, Name, Result )

28+import Rel8.Schema.Context ( Col', Insertion, Name, IsSpecialContext )

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

3030import Rel8.Schema.HTable ( HTable )

31−import Rel8.Schema.HTable.Context ( H )

31+import qualified Rel8.Schema.Kind as K

3232import Rel8.Schema.Nullability ( Sql )

3333import Rel8.Schema.Spec ( KnownSpec )

34−import qualified Rel8.Schema.Spec as Kind ( Context )

3534import Rel8.Table ( Table, Congruent )

3635import Rel8.Type ( DBType )

3736

3837

39−type Recontextualize :: Kind.Context -> Kind.Context -> Type -> Type -> Constraint

38+type Recontextualize :: K.Context -> K.Context -> Type -> Type -> Constraint

4039class

4140 ( Table from a

4241 , Table to b

@@ -51,49 +50,101 @@ class

5150 , b from -> a

5251

5352

53+instance (KnownSpec spec, x ~ IsSpecialContext from, y ~ IsSpecialContext to) =>

54+ Recontextualize from to (Col' x from spec) (Col' y to spec)

55+

56+

57+instance Sql DBType a =>

58+ Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))

59+

60+

5461instance Sql DBType a =>

55− Recontextualize Aggregation Aggregation (Aggregate (Expr a)) (Aggregate (Expr a))

62+ Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)

5663

5764

5865instance Sql DBType a =>

59− Recontextualize Aggregation DB (Aggregate (Expr a)) (Expr a)

66+ Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)

6067

6168

6269instance Sql DBType a =>

63− Recontextualize Aggregation Result (Aggregate (Expr a)) (Identity a)

70+ Recontextualize Aggregate Insertion (Aggregate (Expr a)) (Insertion a)

6471

6572

6673instance Sql DBType a =>

67− Recontextualize DB Aggregation (Expr a) (Aggregate (Expr a))

74+ Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)

6875

6976

7077instance Sql DBType a =>

71− Recontextualize DB DB (Expr a) (Expr a)

78+ Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))

79+

80+

81+instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)

82+

83+

84+instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)

85+

86+

87+instance Sql DBType a => Recontextualize Expr Insertion (Expr a) (Insertion a)

88+

89+

90+instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)

91+

92+

93+instance Sql DBType a =>

94+ Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))

95+

96+

97+instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)

98+

99+

100+instance Sql DBType a => Recontextualize Identity Identity (Identity a) (Identity a)

72101

73102

74103instance Sql DBType a =>

75− Recontextualize DB Result (Expr a) (Identity a)

104+ Recontextualize Identity Insertion (Identity a) (Insertion a)

105+

106+

107+instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)

76108

77109

78110instance Sql DBType a =>

79− Recontextualize Result Aggregation (Identity a) (Aggregate (Expr a))

111+ Recontextualize Insertion Aggregate (Insertion a) (Aggregate (Expr a))

112+

113+

114+instance Sql DBType a => Recontextualize Insertion Expr (Insertion a) (Expr a)

80115

81116

82117instance Sql DBType a =>

83− Recontextualize Result DB (Identity a) (Expr a)

118+ Recontextualize Insertion Identity (Insertion a) (Identity a)

119+

120+

121+instance Sql DBType a => Recontextualize Insertion Insertion (Insertion a) (Insertion a)

122+

123+

124+instance Sql DBType a => Recontextualize Insertion Name (Insertion a) (Name a)

84125

85126

86127instance Sql DBType a =>

87− Recontextualize Result Result (Identity a) (Identity a)

128+ Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))

129+

130+

131+instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)

132+

133+

134+instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)

135+

136+

137+instance Sql DBType a => Recontextualize Name Insertion (Name a) (Insertion a)

88138

89139

90−instance KnownSpec spec => Recontextualize from to (from spec) (to spec)

140+instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

91141

92142

93143instance Recontextualize from to (Opaque1 from a) (Opaque1 to a)

94144

95145

96−instance HTable t => Recontextualize from to (t (H from)) (t (H to))

146+instance (HTable t, x ~ IsSpecialContext from, y ~ IsSpecialContext to) =>

147+ Recontextualize from to (t (Col' x from)) (t (Col' y to))

97148

98149

99150instance

@@ -139,24 +190,24 @@ instance

139190

140191

141192type Aggregates :: Type -> Type -> Constraint

142−class Recontextualize Aggregation DB aggregates exprs => Aggregates aggregates exprs

143−instance Recontextualize Aggregation DB aggregates exprs => Aggregates aggregates exprs

144−instance {-# OVERLAPPING #-} Aggregates (Opaque1 Aggregation Opaque) (Opaque1 DB Opaque)

193+class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

194+instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

195+instance {-# OVERLAPPING #-} Aggregates (Opaque1 Aggregate Opaque) (Opaque1 Expr Opaque)

145196

146197

147198type Encodes :: Type -> Type -> Constraint

148−class Recontextualize Result DB a exprs => Encodes a exprs

149−instance Recontextualize Result DB a exprs => Encodes a exprs

150−instance {-# OVERLAPPING #-} Encodes (Opaque1 Result Opaque) (Opaque1 DB Opaque)

199+class Recontextualize Identity Expr a exprs => Encodes a exprs

200+instance Recontextualize Identity Expr a exprs => Encodes a exprs

201+instance {-# OVERLAPPING #-} Encodes (Opaque1 Identity Opaque) (Opaque1 Expr Opaque)

151202

152203

153204type Inserts :: Type -> Type -> Constraint

154−class Recontextualize DB Insertion exprs inserts => Inserts exprs inserts

155−instance Recontextualize DB Insertion exprs inserts => Inserts exprs inserts

156−instance {-# OVERLAPPING #-} Inserts (Opaque1 DB Opaque) (Opaque1 Insertion Opaque)

205+class Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

206+instance Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

207+instance {-# OVERLAPPING #-} Inserts (Opaque1 Expr Opaque) (Opaque1 Insertion Opaque)

157208

158209

159210type Selects :: Type -> Type -> Constraint

160−class Recontextualize Name DB names exprs => Selects names exprs

161−instance Recontextualize Name DB names exprs => Selects names exprs

162−instance {-# OVERLAPPING #-} Selects (Opaque1 Name Opaque) (Opaque1 DB Opaque)

211+class Recontextualize Name Expr names exprs => Selects names exprs

212+instance Recontextualize Name Expr names exprs => Selects names exprs

213+instance {-# OVERLAPPING #-} Selects (Opaque1 Name Opaque) (Opaque1 Expr Opaque)

src/Rel8/Table/Serialize.hs+109−108

@@ -19,6 +19,7 @@ where

1919

2020-- base

2121import Data.Bifunctor ( bimap )

22+import Data.Functor.Identity ( Identity )

2223import Data.Kind ( Constraint, Type )

2324import Data.List.NonEmpty ( NonEmpty )

2425import Prelude

@@ -30,15 +31,15 @@ import qualified Hasql.Decoders as Hasql

3031import Rel8.Expr ( Expr )

3132import Rel8.Expr.Serialize ( slitExpr, sparseValue )

3233import Rel8.Opaque ( Opaque )

33−import Rel8.Schema.Context ( DB(..), Result(..) )

34−import Rel8.Schema.Context.Label ( labeler, unlabeler )

35−import Rel8.Schema.Context.Result

34+import Rel8.Schema.Context ( Col, Col'(..) )

35+import Rel8.Schema.Context.Identity

3636 ( fromHEitherTable, toHEitherTable

3737 , fromHListTable, toHListTable

3838 , fromHMaybeTable, toHMaybeTable

3939 , fromHNonEmptyTable, toHNonEmptyTable

4040 , fromHTheseTable, toHTheseTable

4141 )

42+import Rel8.Schema.Context.Label ( labeler, unlabeler )

4243import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )

4344import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

4445import Rel8.Schema.HTable.Quartet ( HQuartet(..) )

@@ -46,7 +47,6 @@ import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

4647import Rel8.Schema.HTable.Pair ( HPair(..) )

4748import Rel8.Schema.HTable.Trio ( HTrio(..) )

4849import Rel8.Schema.HTable.Type ( HType(..) )

49−import Rel8.Schema.HTable.Context ( H )

5050import Rel8.Schema.Nullability ( IsMaybe, Sql )

5151import Rel8.Schema.Spec ( SSpec(..), KnownSpec )

5252import Rel8.Table ( Table, Columns, fromColumns, toColumns )

@@ -76,9 +76,9 @@ type family IsPlainColumn a where

7676 IsPlainColumn (_, _, _) = 'False

7777 IsPlainColumn (_, _, _, _) = 'False

7878 IsPlainColumn (_, _, _, _, _) = 'False

79− IsPlainColumn (_ (H Result)) = 'False

80− IsPlainColumn (_ Result) = 'False

81− IsPlainColumn (Result _) = 'False

79+ IsPlainColumn (_ Identity) = 'False

80+ IsPlainColumn (_ (Col' _ Identity _)) = 'False

81+ IsPlainColumn (Identity _) = 'False

8282 IsPlainColumn _ = 'True

8383

8484

@@ -93,9 +93,9 @@ type family IsTabular a where

9393 IsTabular (_, _, _) = 'True

9494 IsTabular (_, _, _, _) = 'True

9595 IsTabular (_, _, _, _, _) = 'True

96− IsTabular (_ (H Result)) = 'True

97− IsTabular (_ Result) = 'True

98− IsTabular (Result _) = 'True

96+ IsTabular (_ Identity) = 'True

97+ IsTabular (_ (Col' _ Identity)) = 'True

98+ IsTabular (Col' _ Identity _) = 'True

9999 IsTabular _ = 'False

100100

101101

@@ -123,19 +123,19 @@ class ExprsFor (IsPlainColumn a) (IsTabular' (IsTabular a) exprs) a exprs => ToE

123123instance ExprsFor (IsPlainColumn a) (IsTabular' (IsTabular a) exprs) a exprs => ToExprs a exprs

124124

125125

126−fromResults' :: forall exprs a. ToExprs a exprs => Columns exprs (H Result) -> a

127−fromResults' = fromResults @(IsPlainColumn a) @_ @_ @exprs

126+fromIdentity' :: forall exprs a. ToExprs a exprs => Columns exprs (Col Identity) -> a

127+fromIdentity' = fromIdentity @(IsPlainColumn a) @_ @_ @exprs

128128

129129

130−toResults' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (H Result)

131−toResults' = toResults @(IsPlainColumn a) @_ @_ @exprs

130+toIdentity' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (Col Identity)

131+toIdentity' = toIdentity @(IsPlainColumn a) @_ @_ @exprs

132132

133133

134134type ExprsFor :: Bool -> Bool -> Type -> Type -> Constraint

135−class (Table DB exprs, isTabular ~ IsTabular a) =>

135+class (Table Expr exprs, isTabular ~ IsTabular a) =>

136136 ExprsFor isPlainColumn isTabular a exprs where

137− fromResults :: Columns exprs (H Result) -> a

138− toResults :: a -> Columns exprs (H Result)

137+ fromIdentity :: Columns exprs (Col Identity) -> a

138+ toIdentity :: a -> Columns exprs (Col Identity)

139139

140140

141141instance

@@ -146,8 +146,8 @@ instance

146146 )

147147 => ExprsFor 'True 'False a x

148148 where

149− fromResults (HType (Result a)) = a

150− toResults = HType . Result

149+ fromIdentity (HType (Result a)) = a

150+ toIdentity = HType . Result

151151

152152

153153instance

@@ -156,8 +156,8 @@ instance

156156 , x ~ [a]

157157 ) => ExprsFor 'False 'False [a] (Expr x)

158158 where

159− fromResults (HType (Result a)) = a

160− toResults = HType . Result

159+ fromIdentity (HType (Result a)) = a

160+ toIdentity = HType . Result

161161

162162

163163instance

@@ -168,8 +168,8 @@ instance

168168 , x ~ Maybe a

169169 ) => ExprsFor 'False 'False (Maybe a) (Expr x)

170170 where

171− fromResults (HType (Result a)) = a

172− toResults = HType . Result

171+ fromIdentity (HType (Result a)) = a

172+ toIdentity = HType . Result

173173

174174

175175instance

@@ -178,8 +178,8 @@ instance

178178 , x ~ NonEmpty a

179179 ) => ExprsFor 'False 'False (NonEmpty a) (Expr x)

180180 where

181− fromResults (HType (Result a)) = a

182− toResults = HType . Result

181+ fromIdentity (HType (Result a)) = a

182+ toIdentity = HType . Result

183183

184184

185185instance

@@ -187,8 +187,8 @@ instance

187187 , IsListTabular a ~ 'False

188188 ) => ExprsFor 'False 'False [a] (ListTable exprs)

189189 where

190− fromResults = fmap (fromResults' @exprs) . fromHListTable

191− toResults = toHListTable . fmap (toResults' @exprs)

190+ fromIdentity = fmap (fromIdentity' @exprs) . fromHListTable

191+ toIdentity = toHListTable . fmap (toIdentity' @exprs)

192192

193193

194194instance

@@ -196,12 +196,12 @@ instance

196196 , IsMaybeTabular a ~ 'False

197197 ) => ExprsFor 'False 'False (Maybe a) (MaybeTable exprs)

198198 where

199− fromResults =

200− fmap (fromResults' @exprs . hunlabel unlabeler) .

199+ fromIdentity =

200+ fmap (fromIdentity' @exprs . hunlabel unlabeler) .

201201 fromHMaybeTable

202− toResults =

202+ toIdentity =

203203 toHMaybeTable .

204− fmap (hlabel labeler . toResults' @exprs)

204+ fmap (hlabel labeler . toIdentity' @exprs)

205205

206206

207207instance

@@ -209,8 +209,8 @@ instance

209209 , IsListTabular a ~ 'False

210210 ) => ExprsFor 'False 'False (NonEmpty a) (NonEmptyTable exprs)

211211 where

212− fromResults = fmap (fromResults' @exprs) . fromHNonEmptyTable

213− toResults = toHNonEmptyTable . fmap (toResults' @exprs)

212+ fromIdentity = fmap (fromIdentity' @exprs) . fromHNonEmptyTable

213+ toIdentity = toHNonEmptyTable . fmap (toIdentity' @exprs)

214214

215215

216216instance

@@ -220,16 +220,16 @@ instance

220220 , x ~ EitherTable exprs1 exprs2

221221 ) => ExprsFor 'False isTabular (Either a b) x

222222 where

223− fromResults =

223+ fromIdentity =

224224 bimap

225− (fromResults' @exprs1 . hunlabel unlabeler)

226− (fromResults' @exprs2 . hunlabel unlabeler) .

225+ (fromIdentity' @exprs1 . hunlabel unlabeler)

226+ (fromIdentity' @exprs2 . hunlabel unlabeler) .

227227 fromHEitherTable

228− toResults =

228+ toIdentity =

229229 toHEitherTable .

230230 bimap

231− (hlabel labeler . toResults' @exprs1)

232− (hlabel labeler . toResults' @exprs2)

231+ (hlabel labeler . toIdentity' @exprs1)

232+ (hlabel labeler . toIdentity' @exprs2)

233233

234234

235235instance

@@ -238,8 +238,8 @@ instance

238238 , x ~ ListTable exprs

239239 ) => ExprsFor 'False 'True [a] x

240240 where

241− fromResults = fmap (fromResults' @exprs) . fromHListTable

242− toResults = toHListTable . fmap (toResults' @exprs)

241+ fromIdentity = fmap (fromIdentity' @exprs) . fromHListTable

242+ toIdentity = toHListTable . fmap (toIdentity' @exprs)

243243

244244

245245instance

@@ -248,12 +248,12 @@ instance

248248 , x ~ MaybeTable exprs

249249 ) => ExprsFor 'False 'True (Maybe a) x

250250 where

251− fromResults =

252− fmap (fromResults' @exprs . hunlabel unlabeler) .

251+ fromIdentity =

252+ fmap (fromIdentity' @exprs . hunlabel unlabeler) .

253253 fromHMaybeTable

254− toResults =

254+ toIdentity =

255255 toHMaybeTable .

256− fmap (hlabel labeler . toResults' @exprs)

256+ fmap (hlabel labeler . toIdentity' @exprs)

257257

258258

259259instance

@@ -262,8 +262,8 @@ instance

262262 , x ~ NonEmptyTable exprs

263263 ) => ExprsFor 'False 'True (NonEmpty a) x

264264 where

265− fromResults = fmap (fromResults' @exprs) . fromHNonEmptyTable

266− toResults = toHNonEmptyTable . fmap (toResults' @exprs)

265+ fromIdentity = fmap (fromIdentity' @exprs) . fromHNonEmptyTable

266+ toIdentity = toHNonEmptyTable . fmap (toIdentity' @exprs)

267267

268268

269269instance

@@ -273,16 +273,16 @@ instance

273273 , x ~ TheseTable exprs1 exprs2

274274 ) => ExprsFor 'False isTabular (These a b) x

275275 where

276− fromResults =

276+ fromIdentity =

277277 bimap

278− (fromResults' @exprs1 . hunlabel unlabeler)

279− (fromResults' @exprs2 . hunlabel unlabeler) .

278+ (fromIdentity' @exprs1 . hunlabel unlabeler)

279+ (fromIdentity' @exprs2 . hunlabel unlabeler) .

280280 fromHTheseTable

281− toResults =

281+ toIdentity =

282282 toHTheseTable .

283283 bimap

284− (hlabel labeler . toResults' @exprs1)

285− (hlabel labeler . toResults' @exprs2)

284+ (hlabel labeler . toIdentity' @exprs1)

285+ (hlabel labeler . toIdentity' @exprs2)

286286

287287

288288instance

@@ -292,13 +292,13 @@ instance

292292 , x ~ (exprs1, exprs2)

293293 ) => ExprsFor 'False isTabular (a, b) x

294294 where

295− fromResults (HPair a b) =

296− ( fromResults' @exprs1 $ hunlabel unlabeler a

297− , fromResults' @exprs2 $ hunlabel unlabeler b

295+ fromIdentity (HPair a b) =

296+ ( fromIdentity' @exprs1 $ hunlabel unlabeler a

297+ , fromIdentity' @exprs2 $ hunlabel unlabeler b

298298 )

299− toResults (a, b) = HPair

300− { hfst = hlabel labeler $ toResults' @exprs1 a

301− , hsnd = hlabel labeler $ toResults' @exprs2 b

299+ toIdentity (a, b) = HPair

300+ { hfst = hlabel labeler $ toIdentity' @exprs1 a

301+ , hsnd = hlabel labeler $ toIdentity' @exprs2 b

302302 }

303303

304304

@@ -310,15 +310,15 @@ instance

310310 , x ~ (exprs1, exprs2, exprs3)

311311 ) => ExprsFor 'False isTabular (a, b, c) x

312312 where

313− fromResults (HTrio a b c) =

314− ( fromResults' @exprs1 $ hunlabel unlabeler a

315− , fromResults' @exprs2 $ hunlabel unlabeler b

316− , fromResults' @exprs3 $ hunlabel unlabeler c

313+ fromIdentity (HTrio a b c) =

314+ ( fromIdentity' @exprs1 $ hunlabel unlabeler a

315+ , fromIdentity' @exprs2 $ hunlabel unlabeler b

316+ , fromIdentity' @exprs3 $ hunlabel unlabeler c

317317 )

318− toResults (a, b, c) = HTrio

319− { hfst = hlabel labeler $ toResults' @exprs1 a

320− , hsnd = hlabel labeler $ toResults' @exprs2 b

321− , htrd = hlabel labeler $ toResults' @exprs3 c

318+ toIdentity (a, b, c) = HTrio

319+ { hfst = hlabel labeler $ toIdentity' @exprs1 a

320+ , hsnd = hlabel labeler $ toIdentity' @exprs2 b

321+ , htrd = hlabel labeler $ toIdentity' @exprs3 c

322322 }

323323

324324

@@ -331,17 +331,17 @@ instance

331331 , x ~ (exprs1, exprs2, exprs3, exprs4)

332332 ) => ExprsFor 'False isTabular (a, b, c, d) x

333333 where

334− fromResults (HQuartet a b c d) =

335− ( fromResults' @exprs1 $ hunlabel unlabeler a

336− , fromResults' @exprs2 $ hunlabel unlabeler b

337− , fromResults' @exprs3 $ hunlabel unlabeler c

338− , fromResults' @exprs4 $ hunlabel unlabeler d

334+ fromIdentity (HQuartet a b c d) =

335+ ( fromIdentity' @exprs1 $ hunlabel unlabeler a

336+ , fromIdentity' @exprs2 $ hunlabel unlabeler b

337+ , fromIdentity' @exprs3 $ hunlabel unlabeler c

338+ , fromIdentity' @exprs4 $ hunlabel unlabeler d

339339 )

340− toResults (a, b, c, d) = HQuartet

341− { hfst = hlabel labeler $ toResults' @exprs1 a

342− , hsnd = hlabel labeler $ toResults' @exprs2 b

343− , htrd = hlabel labeler $ toResults' @exprs3 c

344− , hfrt = hlabel labeler $ toResults' @exprs4 d

340+ toIdentity (a, b, c, d) = HQuartet

341+ { hfst = hlabel labeler $ toIdentity' @exprs1 a

342+ , hsnd = hlabel labeler $ toIdentity' @exprs2 b

343+ , htrd = hlabel labeler $ toIdentity' @exprs3 c

344+ , hfrt = hlabel labeler $ toIdentity' @exprs4 d

345345 }

346346

347347

@@ -355,58 +355,59 @@ instance

355355 , x ~ (exprs1, exprs2, exprs3, exprs4, exprs5)

356356 ) => ExprsFor 'False isTabular (a, b, c, d, e) x

357357 where

358− fromResults (HQuintet a b c d e) =

359− ( fromResults' @exprs1 $ hunlabel unlabeler a

360− , fromResults' @exprs2 $ hunlabel unlabeler b

361− , fromResults' @exprs3 $ hunlabel unlabeler c

362− , fromResults' @exprs4 $ hunlabel unlabeler d

363− , fromResults' @exprs5 $ hunlabel unlabeler e

358+ fromIdentity (HQuintet a b c d e) =

359+ ( fromIdentity' @exprs1 $ hunlabel unlabeler a

360+ , fromIdentity' @exprs2 $ hunlabel unlabeler b

361+ , fromIdentity' @exprs3 $ hunlabel unlabeler c

362+ , fromIdentity' @exprs4 $ hunlabel unlabeler d

363+ , fromIdentity' @exprs5 $ hunlabel unlabeler e

364364 )

365− toResults (a, b, c, d, e) = HQuintet

366− { hfst = hlabel labeler $ toResults' @exprs1 a

367− , hsnd = hlabel labeler $ toResults' @exprs2 b

368− , htrd = hlabel labeler $ toResults' @exprs3 c

369− , hfrt = hlabel labeler $ toResults' @exprs4 d

370− , hfft = hlabel labeler $ toResults' @exprs5 e

365+ toIdentity (a, b, c, d, e) = HQuintet

366+ { hfst = hlabel labeler $ toIdentity' @exprs1 a

367+ , hsnd = hlabel labeler $ toIdentity' @exprs2 b

368+ , htrd = hlabel labeler $ toIdentity' @exprs3 c

369+ , hfrt = hlabel labeler $ toIdentity' @exprs4 d

370+ , hfft = hlabel labeler $ toIdentity' @exprs5 e

371371 }

372372

373373

374374instance

375375 ( HTable t

376376 , isTabular ~ 'True

377− , result ~ H Result

378− , x ~ t (H DB)

377+ , result ~ Col Identity

378+ , x ~ t (Col Expr)

379379 ) => ExprsFor 'False isTabular (t result) x

380380 where

381− fromResults = id

382− toResults = id

381+ fromIdentity = id

382+ toIdentity = id

383383

384384

385385instance

386− ( Encodes (t Result) (t DB)

386+ ( Encodes (t Identity) (t Expr)

387387 , isTabular ~ 'True

388− , result ~ Result

389− , x ~ t DB

388+ , result ~ Identity

389+ , x ~ t Expr

390390 ) => ExprsFor 'False isTabular (t result) x

391391 where

392− fromResults = fromColumns

393− toResults = toColumns

392+ fromIdentity = fromColumns

393+ toIdentity = toColumns

394394

395395

396396instance

397397 ( KnownSpec spec

398398 , isTabular ~ 'True

399− , x ~ DB spec

400− ) => ExprsFor 'False isTabular (Result spec) x

399+ , isSpecial ~ 'True

400+ , x ~ Col Expr spec

401+ ) => ExprsFor 'False isTabular (Col' isSpecial Identity spec) x

401402 where

402− fromResults = fromColumns

403− toResults = toColumns

403+ fromIdentity = fromColumns

404+ toIdentity = toColumns

404405

405406

406407type FromExprs :: Type -> Type

407408type family FromExprs a where

408409 FromExprs (Expr a) = a

409− FromExprs (DB spec) = Result spec

410+ FromExprs (Col' _ Expr spec) = Col Identity spec

410411 FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)

411412 FromExprs (ListTable a) = [FromExprs a]

412413 FromExprs (MaybeTable a) = Maybe (FromExprs a)

@@ -418,8 +419,8 @@ type family FromExprs a where

418419 (FromExprs a, FromExprs b, FromExprs c, FromExprs d)

419420 FromExprs (a, b, c, d, e) =

420421 (FromExprs a, FromExprs b, FromExprs c, FromExprs d, FromExprs e)

421− FromExprs (t DB) = t Result

422− FromExprs (t (H DB)) = t (H Result)

422+ FromExprs (t Expr) = t Identity

423+ FromExprs (t (Col' _ Expr)) = t (Col Identity)

423424

424425

425426-- | @Serializable@ witnesses the one-to-one correspondence between the type

@@ -431,11 +432,11 @@ instance Serializable (Expr Opaque) Opaque

431432

432433

433434lit :: forall exprs a. Serializable exprs a => a -> exprs

434−lit = fromColumns . litTable . toResults' @exprs

435+lit = fromColumns . litTable . toIdentity' @exprs

435436

436437

437438parse :: forall exprs a. Serializable exprs a => Hasql.Row a

438−parse = fromResults' @exprs <$> parseTable

439+parse = fromIdentity' @exprs <$> parseTable

439440

440441

441442litTable :: Encodes a b => a -> b

@@ -445,7 +446,7 @@ litTable (toColumns -> as) = fromColumns $ htabulate $ \field ->

445446 Result value -> DB (slitExpr nullability info value)

446447

447448

448−parseTable :: Table Result a => Hasql.Row a

449+parseTable :: Table Identity a => Hasql.Row a

449450parseTable = fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->

450451 WrapApplicative $ case hfield hspecs field of

451452 SSpec {nullability, info} -> Result <$> sparseValue nullability info

src/Rel8/Table/These.hs+8−9

@@ -29,7 +29,6 @@ import Prelude hiding ( undefined )

2929import Rel8.Expr ( Expr )

3030import Rel8.Expr.Bool ( (&&.), not_ )

3131import Rel8.Expr.Null ( isNonNull )

32−import Rel8.Schema.Context ( DB )

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

3433import Rel8.Schema.Context.Nullify

3534 ( Nullifiable, NullifiableEq

@@ -70,20 +69,20 @@ instance Bifunctor TheseTable where

7069 bimap f g (TheseTable a b) = TheseTable (fmap f a) (fmap g b)

7170

7271

73−instance (Table DB a, Semigroup a) => Apply (TheseTable a) where

72+instance (Table Expr a, Semigroup a) => Apply (TheseTable a) where

7473 fs <.> as = TheseTable

7574 { here = here fs <> here as

7675 , there = there fs <.> there as

7776 }

7877

7978

80−instance (Table DB a, Semigroup a) => Applicative (TheseTable a)

79+instance (Table Expr a, Semigroup a) => Applicative (TheseTable a)

8180 where

8281 pure = thatTable

8382 (<*>) = (<.>)

8483

8584

86−instance (Table DB a, Semigroup a) => Bind (TheseTable a) where

85+instance (Table Expr a, Semigroup a) => Bind (TheseTable a) where

8786 TheseTable here1 ma >>- f = case ma >>- f' of

8887 mtb -> TheseTable

8988 { here = maybeTable here1 ((here1 <>) . fst) mtb

@@ -94,11 +93,11 @@ instance (Table DB a, Semigroup a) => Bind (TheseTable a) where

9493 TheseTable here2 mb -> (here2,) <$> mb

9594

9695

97−instance (Table DB a, Semigroup a) => Monad (TheseTable a) where

96+instance (Table Expr a, Semigroup a) => Monad (TheseTable a) where

9897 (>>=) = (>>-)

9998

10099

101−instance (Table DB a, Table DB b, Semigroup a, Semigroup b) =>

100+instance (Table Expr a, Table Expr b, Semigroup a, Semigroup b) =>

102101 Semigroup (TheseTable a b)

103102 where

104103 a <> b = TheseTable

@@ -212,11 +211,11 @@ justThereTable :: TheseTable a b -> MaybeTable b

212211justThereTable = there

213212

214213

215−thisTable :: Table DB b => a -> TheseTable a b

214+thisTable :: Table Expr b => a -> TheseTable a b

216215thisTable a = TheseTable (justTable a) nothingTable

217216

218217

219−thatTable :: Table DB a => b -> TheseTable a b

218+thatTable :: Table Expr a => b -> TheseTable a b

220219thatTable b = TheseTable nothingTable (justTable b)

221220

222221

@@ -224,7 +223,7 @@ thoseTable :: a -> b -> TheseTable a b

224223thoseTable a b = TheseTable (justTable a) (justTable b)

225224

226225

227−theseTable :: Table DB c

226+theseTable :: Table Expr c

228227 => (a -> c) -> (b -> c) -> (a -> b -> c) -> TheseTable a b -> c

229228theseTable f g h TheseTable {here, there} =

230229 maybeTable

src/Rel8/Table/Undefined.hs+5−4

@@ -11,16 +11,17 @@ where

1111import Prelude hiding ( undefined )

1212

1313-- rel8

14+import Rel8.Expr ( Expr )

1415import Rel8.Expr.Null ( snull, unsafeUnnullify )

15−import Rel8.Schema.Context ( DB( DB ) )

16+import Rel8.Schema.Context ( Col'(..) )

1617import Rel8.Schema.HTable ( htabulate, hfield, hspecs )

1718import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

1819import Rel8.Schema.Spec ( SSpec(..) )

1920import Rel8.Table ( Table, fromColumns )

2021

2122

22−undefined :: Table DB a => a

23+undefined :: Table Expr a => a

2324undefined = fromColumns $ htabulate $ \field -> case hfield hspecs field of

2425 SSpec {nullability, info} -> case nullability of

25− Nullable -> DB (snull Nullable info)

26− NonNullable -> DB (unsafeUnnullify (snull Nullable info))

26+ Nullable -> DB (snull Nullable info)

27+ NonNullable -> DB (unsafeUnnullify (snull Nullable info))

src/Rel8/Tabulate.hs+2−3

@@ -46,7 +46,6 @@ import Rel8.Query.Exists ( withBy, withoutBy )

4646import Rel8.Query.Filter ( filter, where_ )

4747import Rel8.Query.Maybe ( optional )

4848import Rel8.Query.These ( alignBy )

49−import Rel8.Schema.Context ( DB )

5049import Rel8.Table ( Table )

5150import Rel8.Table.Aggregate ( groupBy )

5251import Rel8.Table.Eq ( EqTable, (==:) )

@@ -159,12 +158,12 @@ lookup key (Tabulation query) = do

159158 pure a

160159

161160

162−align :: (EqTable k, Table DB a, Table DB b)

161+align :: (EqTable k, Table Expr a, Table Expr b)

163162 => Tabulation k a -> Tabulation k b -> Tabulation k (TheseTable a b)

164163align = alignWith id

165164

166165

167−alignWith :: (EqTable k, Table DB a, Table DB b)

166+alignWith :: (EqTable k, Table Expr a, Table Expr b)

168167 => (TheseTable a b -> c)

169168 -> Tabulation k a -> Tabulation k b -> Tabulation k c

170169alignWith f kas kbs = do

tests/Main.hs+15−15

@@ -1,5 +1,4 @@

11{-# language BlockArguments #-}

2−{-# language BlockArguments #-}

32{-# language DataKinds #-}

43{-# language DeriveAnyClass #-}

54{-# language DeriveGeneric #-}

@@ -28,6 +27,7 @@ import Control.Monad (void)

2827import Control.Monad.IO.Class ( MonadIO, liftIO )

2928import Data.Bifunctor ( bimap )

3029import Data.Foldable ( for_ )

30+import Data.Functor.Identity ( Identity )

3131import Data.Int ( Int32, Int64 )

3232import Data.List ( nub, sort )

3333import Data.Maybe ( catMaybes )

@@ -191,9 +191,9 @@ data TestTable f = TestTable

191191 deriving anyclass Rel8.Rel8able

192192

193193

194−deriving stock instance Eq (TestTable Rel8.Result)

195−deriving stock instance Ord (TestTable Rel8.Result)

196−deriving stock instance Show (TestTable Rel8.Result)

194+deriving stock instance Eq (TestTable Identity)

195+deriving stock instance Ord (TestTable Identity)

196+deriving stock instance Show (TestTable Identity)

197197

198198

199199testTableSchema :: Rel8.TableSchema (TestTable Rel8.Name)

@@ -589,9 +589,9 @@ data TwoTestTables f =

589589 deriving anyclass Rel8.Rel8able

590590

591591

592−deriving stock instance Eq (TwoTestTables Rel8.Result)

593−deriving stock instance Ord (TwoTestTables Rel8.Result)

594−deriving stock instance Show (TwoTestTables Rel8.Result)

592+deriving stock instance Eq (TwoTestTables Identity)

593+deriving stock instance Ord (TwoTestTables Identity)

594+deriving stock instance Show (TwoTestTables Identity)

595595

596596

597597testNestedTables :: IO TmpPostgres.DB -> TestTree

@@ -624,7 +624,7 @@ testMaybeTableApplicative = databasePropertyTest "MaybeTable (<*>)" \transaction

624624 (as, []) -> selected === (Nothing <$ as)

625625 (as, bs) -> sort selected === sort (Just <$> liftA2 (,) as bs)

626626 where

627− genRows :: PropertyT IO [TestTable Rel8.Result]

627+ genRows :: PropertyT IO [TestTable Identity]

628628 genRows = forAll do

629629 Gen.list (Range.linear 0 10) $ liftA2 TestTable (Gen.text (Range.linear 0 10) Gen.unicode) (pure True)

630630

@@ -637,7 +637,7 @@ rollingBack connection =

637637 (liftIO (run (sql "ROLLBACK") connection))

638638

639639

640−genTestTable :: Gen (TestTable Rel8.Result)

640+genTestTable :: Gen (TestTable Identity)

641641genTestTable = do

642642 testTableColumn1 <- Gen.text (Range.linear 0 5) Gen.alphaNum

643643 testTableColumn2 <- Gen.bool

@@ -719,9 +719,9 @@ newtype HKNestedPair f = HKNestedPair { pairOne :: (TestTable f, TestTable f) }

719719 deriving stock Generic

720720 deriving anyclass Rel8.Rel8able

721721

722−deriving stock instance Eq (HKNestedPair Rel8.Result)

723−deriving stock instance Ord (HKNestedPair Rel8.Result)

724−deriving stock instance Show (HKNestedPair Rel8.Result)

722+deriving stock instance Eq (HKNestedPair Identity)

723+deriving stock instance Ord (HKNestedPair Identity)

724+deriving stock instance Show (HKNestedPair Identity)

725725

726726

727727testSelectNestedPairs :: IO TmpPostgres.DB -> TestTree

@@ -754,9 +754,9 @@ data NestedMaybeTable f = NestedMaybeTable

754754 deriving anyclass Rel8.Rel8able

755755

756756

757−deriving stock instance Eq (NestedMaybeTable Rel8.Result)

758−deriving stock instance Ord (NestedMaybeTable Rel8.Result)

759−deriving stock instance Show (NestedMaybeTable Rel8.Result)

757+deriving stock instance Eq (NestedMaybeTable Identity)

758+deriving stock instance Ord (NestedMaybeTable Identity)

759+deriving stock instance Show (NestedMaybeTable Identity)

760760

761761

762762testNestedMaybeTable :: IO TmpPostgres.DB -> TestTree