24f0521 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Fill in missing EqTable and OrdTable instances

24f0521Shane O'Brien6 years ago

rel8.cabal+1

compare with master

unifiedsplit

@@ -117,6 +117,7 @@ library

117 Rel8.Schema.Kind

118 Rel8.Schema.Name

119 Rel8.Schema.Nullability

120+ Rel8.Schema.Nullability.Internal

120 Rel8.Schema.Spec

121 Rel8.Schema.Spec

121 Rel8.Schema.Spec.ConstrainDBType

122 Rel8.Schema.Spec.ConstrainDBType

122 Rel8.Schema.Spec.ConstrainType

123 Rel8.Schema.Spec.ConstrainType

src/Rel8/Schema/Context/Label.hs+8

@@ -1,4 +1,5 @@

1{-# language DataKinds #-}

2+{-# language FlexibleInstances #-}

2{-# language StandaloneKindSignatures #-}

3{-# language StandaloneKindSignatures #-}

3{-# language TypeFamilies #-}

4{-# language TypeFamilies #-}

4{-# language TypeOperators #-}

5{-# language TypeOperators #-}

@@ -16,8 +17,10 @@ import Prelude hiding ( null )

17-- rel8

18-- rel8

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

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

20+import Rel8.Schema.Dict ( Dict( Dict ) )

19import Rel8.Schema.Kind ( Context, HContext )

21import Rel8.Schema.Kind ( Context, HContext )

20import Rel8.Schema.Spec ( Spec( Spec ) )

22import Rel8.Schema.Spec ( Spec( Spec ) )

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

23type Labelable :: Context -> Constraint

26type Labelable :: Context -> Constraint

@@ -50,3 +53,8 @@ class HLabelable context where

50instance Labelable context => HLabelable (Col context) where

53instance Labelable context => HLabelable (Col context) where

51 hlabeler = labeler

54 hlabeler = labeler

52 hunlabeler = unlabeler

55 hunlabeler = unlabeler

56+

57+

58+instance HLabelable (Dict (ConstrainDBType constraint)) where

59+ hlabeler Dict = Dict

60+ hunlabeler Dict = Dict

src/Rel8/Schema/Context/Nullify.hs+84−13

@@ -1,19 +1,23 @@

1{-# language DataKinds #-}

2{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

4+{-# language InstanceSigs #-}

4{-# language MultiParamTypeClasses #-}

5{-# language MultiParamTypeClasses #-}

6+{-# language NamedFieldPuns #-}

7+{-# language ScopedTypeVariables #-}

5{-# language StandaloneKindSignatures #-}

8{-# language StandaloneKindSignatures #-}

9+{-# language TypeApplications #-}

6{-# language TypeFamilies #-}

10{-# language TypeFamilies #-}

8module Rel8.Schema.Context.Nullify

12module Rel8.Schema.Context.Nullify

9− ( Nullifiable( encodeTag, decodeTag, nullifier, unnullifier )

13+ ( Nullifiable( ConstrainTag, encodeTag, decodeTag, nullifier, unnullifier )

10− , NullifiableEq

14+ , HNullifiable( HConstrainTag, hencodeTag, hdecodeTag, hnullifier, hunnullifier )

11 , unnull, runTag

15 , unnull, runTag

12 )

16 )

13where

17where

15-- base

19-- base

16−import Data.Kind ( Constraint )

20+import Data.Kind ( Constraint, Type )

17import Prelude hiding ( null )

21import Prelude hiding ( null )

19-- opaleye

23-- opaleye

@@ -30,21 +34,29 @@ import Rel8.Schema.Context ( Interpretation, Col(..) )

30import qualified Rel8.Schema.Kind as K

34import qualified Rel8.Schema.Kind as K

31import Rel8.Schema.Nullability

35import Rel8.Schema.Nullability

32 ( Nullify

36 ( Nullify

33− , Nullability( Nullable, NonNullable )

37+ , Nullability( Nullable, NonNullable ), nullabilization

34 , Sql

38 , Sql

35 )

39 )

36−import Rel8.Schema.Spec ( Spec( Spec ), SSpec )

40+import Rel8.Schema.Dict ( Dict( Dict ) )

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

42+import Rel8.Schema.Spec.ConstrainDBType

43+ ( ConstrainDBType

44+ , dbTypeDict, dbTypeNullability, fromNullabilityDict

45+ )

37import Rel8.Type.Eq ( DBEq )

46import Rel8.Type.Eq ( DBEq )

38−import Rel8.Type.Monoid ( DBMonoid )

47+import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

41type Nullifiable :: K.Context -> Constraint

50type Nullifiable :: K.Context -> Constraint

42class Interpretation context => Nullifiable context where

51class Interpretation context => Nullifiable context where

52+ type ConstrainTag context :: Type -> Constraint

53+ type ConstrainTag _context = DefaultConstrainTag

54+

43− encodeTag :: (Sql DBEq a, KnownLabels labels)

55+ encodeTag :: (Sql (ConstrainTag context) a, Sql DBEq a, KnownLabels labels)

44 => Expr a

56 => Expr a

45 -> Col context ('Spec labels 'Required a)

57 -> Col context ('Spec labels 'Required a)

47− decodeTag :: Sql DBMonoid a

59+ decodeTag :: (Sql (ConstrainTag context) a, Sql DBMonoid a)

48 => Col context ('Spec labels 'Required a)

60 => Col context ('Spec labels 'Required a)

49 -> Expr a

61 -> Expr a

@@ -61,11 +73,6 @@ class Interpretation context => Nullifiable context where

61 -> Col context ('Spec labels necessity a)

73 -> Col context ('Spec labels necessity a)

64−type NullifiableEq :: K.Context -> K.Context -> Constraint

65−class (a ~ b, Nullifiable b) => NullifiableEq a b

66−instance (a ~ b, Nullifiable b) => NullifiableEq a b

67−

68−

69runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)

76runTag :: Nullability a -> Expr Bool -> Expr a -> Expr (Nullify a)

70runTag nullability tag a = case nullability of

77runTag nullability tag a = case nullability of

71 Nullable -> boolExpr null a tag

78 Nullable -> boolExpr null a tag

@@ -78,3 +85,67 @@ unnull :: Nullability a -> Expr (Nullify a) -> Expr a

78unnull nullability a = case nullability of

85unnull nullability a = case nullability of

79 Nullable -> a

86 Nullable -> a

80 NonNullable -> unsafeUnnullify a

87 NonNullable -> unsafeUnnullify a

88+

89+

90+type HNullifiable :: K.HContext -> Constraint

91+class HNullifiable context where

92+ type HConstrainTag context :: Type -> Constraint

93+ type HConstrainTag _context = DefaultConstrainTag

94+

95+ hencodeTag :: (Sql (HConstrainTag context) a, Sql DBEq a, KnownLabels labels)

96+ => Expr a

97+ -> context ('Spec labels 'Required a)

98+

99+ hdecodeTag :: (Sql (HConstrainTag context) a, Sql DBMonoid a)

100+ => context ('Spec labels 'Required a)

101+ -> Expr a

102+

103+ hnullifier :: ()

104+ => Expr Bool

105+ -> SSpec ('Spec labels necessity a)

106+ -> context ('Spec labels necessity a)

107+ -> context ('Spec labels necessity (Nullify a))

108+

109+ hunnullifier :: ()

110+ => Expr Bool

111+ -> SSpec ('Spec labels necessity a)

112+ -> context ('Spec labels necessity (Nullify a))

113+ -> context ('Spec labels necessity a)

114+

115+

116+instance Nullifiable context => HNullifiable (Col context) where

117+ type HConstrainTag (Col context) = ConstrainTag context

118+ hencodeTag = encodeTag

119+ hdecodeTag = decodeTag

120+ hnullifier = nullifier

121+ hunnullifier = unnullifier

122+

123+

124+instance HNullifiable (Dict (ConstrainDBType constraint)) where

125+ type HConstrainTag (Dict (ConstrainDBType constraint)) = constraint

126+

127+ hencodeTag _ = Dict

128+

129+ hdecodeTag :: forall a context labels. (Sql (HConstrainTag context) a, Sql DBMonoid a)

130+ => context ('Spec labels 'Required a)

131+ -> Expr a

132+ hdecodeTag _ = case nullabilization @a of

133+ Nullable -> nullify memptyExpr

134+ NonNullable -> memptyExpr

135+

136+

137+ hnullifier _ SSpec {} dict = case dbTypeDict dict of

138+ Dict -> case dbTypeNullability dict of

139+ Nullable -> Dict

140+ NonNullable -> Dict

141+

142+ hunnullifier _ SSpec {nullability} dict = case dbTypeDict dict of

143+ Dict -> case nullability of

144+ Nullable -> Dict

145+ NonNullable -> case dbTypeNullability dict of

146+ Nullable -> fromNullabilityDict nullability Dict

147+

148+

149+type DefaultConstrainTag :: Type -> Constraint

150+class DefaultConstrainTag a

151+instance DefaultConstrainTag a

src/Rel8/Schema/HTable.hs−4

@@ -17,10 +17,6 @@ module Rel8.Schema.HTable

17 ( HTable (HField, HConstrainTable)

18 , hfield, htabulate, htraverse, hdicts, hspecs

19 , htabulateA

20−

21− , HPair(..)

22− , HPairField(..)

23− , GHField(..)

24 )

20 )

25where

21where

src/Rel8/Schema/HTable/Either.hs+11

@@ -2,19 +2,25 @@

2{-# language DeriveAnyClass #-}

3{-# language DeriveGeneric #-}

4{-# language DerivingStrategies #-}

5+{-# language FlexibleInstances #-}

5{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

7+{-# language UndecidableInstances #-}

8+{-# language UndecidableSuperClasses #-}

7module Rel8.Schema.HTable.Either

10module Rel8.Schema.HTable.Either

8 ( HEitherTable(..)

11 ( HEitherTable(..)

12+ , HEitherNullifiable

9 )

13 )

10where

14where

12-- base

16-- base

17+import Data.Kind ( Constraint )

13import GHC.Generics ( Generic )

18import GHC.Generics ( Generic )

14import Prelude ()

19import Prelude ()

16-- rel8

21-- rel8

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

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

23+import Rel8.Schema.Context.Nullify ( HNullifiable, HConstrainTag )

18import Rel8.Schema.HTable ( HTable )

24import Rel8.Schema.HTable ( HTable )

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

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

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

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

@@ -31,3 +37,8 @@ data HEitherTable left right context = HEitherTable

31 }

37 }

32 deriving stock Generic

38 deriving stock Generic

33 deriving anyclass HTable

39 deriving anyclass HTable

40+

41+

42+type HEitherNullifiable :: K.HContext -> Constraint

43+class (HNullifiable context, HConstrainTag context EitherTag) => HEitherNullifiable context

44+instance (HNullifiable context, HConstrainTag context EitherTag) => HEitherNullifiable context

src/Rel8/Schema/HTable/MapTable.hs+7−1

@@ -14,7 +14,13 @@

14{-# language UndecidableInstances #-}

15{-# language UndecidableSuperClasses #-}

17−module Rel8.Schema.HTable.MapTable ( HMapTable(..), MapSpec(..), Precompose(..), HMapTableField(..) ) where

17+module Rel8.Schema.HTable.MapTable

18+ ( HMapTable(..)

19+ , MapSpec(..)

20+ , Precompose(..)

21+ , HMapTableField(..)

22+ )

23+where

19-- base

25-- base

20import Data.Kind ( Constraint, Type )

26import Data.Kind ( Constraint, Type )

src/Rel8/Schema/HTable/Maybe.hs+11−4

@@ -1,24 +1,26 @@

1−{-# LANGUAGE NamedFieldPuns #-}

2−{-# LANGUAGE LambdaCase #-}

3−{-# LANGUAGE TypeFamilies #-}

4−{-# LANGUAGE KindSignatures #-}

5{-# language DataKinds #-}

1{-# language DataKinds #-}

6{-# language DeriveAnyClass #-}

2{-# language DeriveAnyClass #-}

7{-# language DeriveGeneric #-}

3{-# language DeriveGeneric #-}

8{-# language DerivingStrategies #-}

4{-# language DerivingStrategies #-}

5+{-# language FlexibleInstances #-}

9{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

7+{-# language UndecidableInstances #-}

8+{-# language UndecidableSuperClasses #-}

11module Rel8.Schema.HTable.Maybe

10module Rel8.Schema.HTable.Maybe

12 ( HMaybeTable(..)

11 ( HMaybeTable(..)

12+ , HMaybeNullifiable

13 )

14where

16-- base

17+import Data.Kind ( Constraint )

17import GHC.Generics ( Generic )

18import GHC.Generics ( Generic )

18import Prelude

19import Prelude

20-- rel8

21-- rel8

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

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

23+import Rel8.Schema.Context.Nullify ( HConstrainTag, HNullifiable )

22import Rel8.Schema.HTable ( HTable )

24import Rel8.Schema.HTable ( HTable )

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

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

24import qualified Rel8.Schema.Kind as K

26import qualified Rel8.Schema.Kind as K

@@ -34,3 +36,8 @@ data HMaybeTable table context = HMaybeTable

34 }

36 }

35 deriving stock Generic

37 deriving stock Generic

36 deriving anyclass HTable

38 deriving anyclass HTable

39+

40+

41+type HMaybeNullifiable :: K.HContext -> Constraint

42+class (HNullifiable context, HConstrainTag context MaybeTag) => HMaybeNullifiable context

43+instance (HNullifiable context, HConstrainTag context MaybeTag) => HMaybeNullifiable context

src/Rel8/Schema/Nullability.hs+6−102

@@ -1,118 +1,22 @@

1{-# language ConstraintKinds #-}

2−{-# language DataKinds #-}

3−{-# language FlexibleContexts #-}

4{-# language FlexibleInstances #-}

2{-# language FlexibleInstances #-}

5−{-# language FunctionalDependencies #-}

3+{-# language MonoLocalBinds #-}

6−{-# language GADTs #-}

7{-# language MultiParamTypeClasses #-}

4{-# language MultiParamTypeClasses #-}

8−{-# language QuantifiedConstraints #-}

9−{-# language StandaloneKindSignatures #-}

10−{-# language TypeFamilies #-}

11{-# language UndecidableInstances #-}

5{-# language UndecidableInstances #-}

12−{-# language UndecidableSuperClasses #-}

7+{-# options_ghc -fno-warn-orphans #-}

14module Rel8.Schema.Nullability

9module Rel8.Schema.Nullability

15− ( Nullify, Unnullify

10+ ( module Rel8.Schema.Nullability.Internal

16− , NotNull

17− , Homonullable

18− , Nullability( Nullable, NonNullable )

19− , HasNullability, nullabilization

20− , Sql

21 )

11 )

22where

12where

24-- base

14-- base

25−import Data.Kind ( Constraint, Type )

15+import Prelude ()

26−import Prelude

28-- rel8

17-- rel8

29import Rel8.Opaque ( Opaque )

18import Rel8.Opaque ( Opaque )

19+import Rel8.Schema.Nullability.Internal

32−type IsMaybe :: Type -> Bool

33−type family IsMaybe a where

34− IsMaybe (Maybe _) = 'True

35− IsMaybe _ = 'False

36−

37−

38−type Unnullify' :: Bool -> Type -> Type

39−type family Unnullify' isMaybe ma where

40− Unnullify' 'False a = a

41− Unnullify' 'True (Maybe a) = a

42−

43−

44−type Unnullify :: Type -> Type

45−type Unnullify a = Unnullify' (IsMaybe a) a

46−

47−

48−type Nullify' :: Bool -> Type -> Type

49−type family Nullify' isMaybe a where

50− Nullify' 'False a = a

51− Nullify' 'True a = Maybe a

52−

53−

54−type Nullify :: Type -> Type

55−type Nullify a = Maybe (Unnullify a)

56−

57−

58−type NotNull :: Type -> Constraint

59−class (HasNullability a, IsMaybe a ~ 'False) => NotNull a

60−instance (HasNullability a, IsMaybe a ~ 'False) => NotNull a

61−instance {-# OVERLAPPING #-} NotNull Opaque

62−

63−

64−type Homonullable :: Type -> Type -> Constraint

65−class IsMaybe a ~ IsMaybe b => Homonullable a b

66−instance IsMaybe a ~ IsMaybe b => Homonullable a b

67−instance {-# OVERLAPPING #-} Homonullable Opaque Opaque

68−

69−

70−type Nullability :: Type -> Type

71−data Nullability a where

72− NonNullable :: NotNull a => Nullability a

73− Nullable :: NotNull a => Nullability (Maybe a)

74−

75−

76−type HasNullability' :: Bool -> Type -> Constraint

77−class

78− ( IsMaybe a ~ isMaybe

79− , IsMaybe (Unnullify a) ~ 'False

80− , Nullify' isMaybe (Unnullify a) ~ a

81− ) => HasNullability' isMaybe a

82− where

83− nullabilization' :: Nullability a

84−

85−

86−instance IsMaybe a ~ 'False => HasNullability' 'False a where

87− nullabilization' = NonNullable

88−

89−

90−instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where

91− nullabilization' = Nullable

92−

93−

94−type HasNullability :: Type -> Constraint

95−class HasNullability' (IsMaybe a) a => HasNullability a

96−instance HasNullability' (IsMaybe a) a => HasNullability a

97−instance {-# OVERLAPPING #-} HasNullability Opaque

98−

99−

100−nullabilization :: HasNullability a => Nullability a

101−nullabilization = nullabilization'

102−

103−

104−-- | The @Sql@ type class describes both null and not null database values,

105−-- constrained by a specific class.

106−--

107−-- For example, if you see @Sql DBEq a@, this means any database type that

108−-- supports equality, and @a@ can either be exactly an @a@, or it could also be

109−-- @Maybe a@.

110−type Sql :: (Type -> Constraint) -> Type -> Constraint

111−class

112− ( (forall c. (forall x. (constraint x => c x)) => Sql c a)

113− , HasNullability a

114− , constraint (Unnullify a)

115− )

116− => Sql constraint a

117−instance (constraint (Unnullify a), HasNullability a) => Sql constraint a

118instance {-# OVERLAPPING #-} (c Opaque, Sql c Opaque) => Sql c Opaque

22instance {-# OVERLAPPING #-} (c Opaque, Sql c Opaque) => Sql c Opaque

src/Rel8/Schema/Nullability/Internal.hsnew file+123

@@ -0,0 +1,123 @@

1+{-# language ConstraintKinds #-}

2+{-# language DataKinds #-}

3+{-# language FlexibleContexts #-}

4+{-# language FlexibleInstances #-}

5+{-# language FunctionalDependencies #-}

6+{-# language GADTs #-}

7+{-# language MultiParamTypeClasses #-}

8+{-# language QuantifiedConstraints #-}

9+{-# language StandaloneKindSignatures #-}

10+{-# language TypeFamilies #-}

11+{-# language UndecidableInstances #-}

12+{-# language UndecidableSuperClasses #-}

13+

14+module Rel8.Schema.Nullability.Internal

15+ ( Nullify, Unnullify

16+ , NotNull

17+ , Homonullable

18+ , Nullability( Nullable, NonNullable )

19+ , HasNullability, nullabilization

20+ , Sql, toSql

21+ )

22+where

23+

24+-- base

25+import Data.Kind ( Constraint, Type )

26+import Prelude

27+

28+-- rel8

29+import Rel8.Opaque ( Opaque )

30+import Rel8.Schema.Dict ( Dict( Dict ) )

31+

32+

33+type IsMaybe :: Type -> Bool

34+type family IsMaybe a where

35+ IsMaybe (Maybe _) = 'True

36+ IsMaybe _ = 'False

37+

38+

39+type Unnullify' :: Bool -> Type -> Type

40+type family Unnullify' isMaybe ma where

41+ Unnullify' 'False a = a

42+ Unnullify' 'True (Maybe a) = a

43+

44+

45+type Unnullify :: Type -> Type

46+type Unnullify a = Unnullify' (IsMaybe a) a

47+

48+

49+type Nullify' :: Bool -> Type -> Type

50+type family Nullify' isMaybe a where

51+ Nullify' 'False a = a

52+ Nullify' 'True a = Maybe a

53+

54+

55+type Nullify :: Type -> Type

56+type Nullify a = Maybe (Unnullify a)

57+

58+

59+type NotNull :: Type -> Constraint

60+class (HasNullability a, IsMaybe a ~ 'False) => NotNull a

61+instance (HasNullability a, IsMaybe a ~ 'False) => NotNull a

62+instance {-# OVERLAPPING #-} NotNull Opaque

63+

64+

65+type Homonullable :: Type -> Type -> Constraint

66+class IsMaybe a ~ IsMaybe b => Homonullable a b

67+instance IsMaybe a ~ IsMaybe b => Homonullable a b

68+instance {-# OVERLAPPING #-} Homonullable Opaque Opaque

69+

70+

71+type Nullability :: Type -> Type

72+data Nullability a where

73+ NonNullable :: NotNull a => Nullability a

74+ Nullable :: NotNull a => Nullability (Maybe a)

75+

76+

77+type HasNullability' :: Bool -> Type -> Constraint

78+class

79+ ( IsMaybe a ~ isMaybe

80+ , IsMaybe (Unnullify a) ~ 'False

81+ , Nullify' isMaybe (Unnullify a) ~ a

82+ ) => HasNullability' isMaybe a

83+ where

84+ nullabilization' :: Nullability a

85+

86+

87+instance IsMaybe a ~ 'False => HasNullability' 'False a where

88+ nullabilization' = NonNullable

89+

90+

91+instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where

92+ nullabilization' = Nullable

93+

94+

95+type HasNullability :: Type -> Constraint

96+class HasNullability' (IsMaybe a) a => HasNullability a

97+instance HasNullability' (IsMaybe a) a => HasNullability a

98+instance {-# OVERLAPPING #-} HasNullability Opaque

99+

100+

101+nullabilization :: HasNullability a => Nullability a

102+nullabilization = nullabilization'

103+

104+

105+-- | The @Sql@ type class describes both null and not null database values,

106+-- constrained by a specific class.

107+--

108+-- For example, if you see @Sql DBEq a@, this means any database type that

109+-- supports equality, and @a@ can either be exactly an @a@, or it could also be

110+-- @Maybe a@.

111+type Sql :: (Type -> Constraint) -> Type -> Constraint

112+class

113+ ( (forall c. (forall x. (constraint x => c x)) => Sql c a)

114+ , HasNullability a

115+ , constraint (Unnullify a)

116+ )

117+ => Sql constraint a

118+instance (constraint (Unnullify a), HasNullability a) => Sql constraint a

119+

120+

121+toSql :: Nullability a -> Dict constraint (Unnullify a) -> Dict (Sql constraint) a

122+toSql NonNullable Dict = Dict

123+toSql Nullable Dict = Dict

src/Rel8/Schema/Spec/ConstrainDBType.hs+37−2

@@ -9,15 +9,23 @@

10module Rel8.Schema.Spec.ConstrainDBType

11 ( ConstrainDBType

12+ , dbTypeNullability

13+ , dbTypeDict

14+ , fromNullabilityDict

12 )

15 )

13where

16where

15-- base

18-- base

16import Data.Kind ( Constraint, Type )

19import Data.Kind ( Constraint, Type )

17−import Prelude ()

20+import Prelude

19-- rel8

22-- rel8

20−import Rel8.Schema.Nullability ( Sql )

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

24+import Rel8.Schema.Nullability

25+ ( Unnullify

26+ , Nullability

27+ , Sql, nullabilization, toSql

28+ )

21import Rel8.Schema.Spec ( Spec( Spec ) )

29import Rel8.Schema.Spec ( Spec( Spec ) )

@@ -33,3 +41,30 @@ instance

33 , Sql constraint a

41 , Sql constraint a

34 )

42 )

35 => ConstrainDBType constraint spec

43 => ConstrainDBType constraint spec

44+

45+

46+dbTypeNullability :: Dict (ConstrainDBType c) ('Spec l n a) -> Nullability a

47+dbTypeNullability = step2 . step1

48+ where

49+ step1 :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict (Sql c) a

50+ step1 Dict = Dict

51+

52+ step2 :: Dict (Sql c) a -> Nullability a

53+ step2 Dict = nullabilization

54+

55+

56+dbTypeDict :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict c (Unnullify a)

57+dbTypeDict = step2 . step1

58+ where

59+ step1 :: Dict (ConstrainDBType c) ('Spec l n a) -> Dict (Sql c) a

60+ step1 Dict = Dict

61+

62+ step2 :: Dict (Sql c) a -> Dict c (Unnullify a)

63+ step2 Dict = Dict

64+

65+

66+fromNullabilityDict :: Nullability a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l n a)

67+fromNullabilityDict nullability = step2 . toSql nullability

68+ where

69+ step2 :: Dict (Sql c) a -> Dict (ConstrainDBType c) ('Spec l n a)

70+ step2 Dict = Dict

src/Rel8/Table/Either.hs+37−26

@@ -5,7 +5,9 @@

5{-# language FlexibleInstances #-}

6{-# language MultiParamTypeClasses #-}

7{-# language NamedFieldPuns #-}

8+{-# language ScopedTypeVariables #-}

8{-# language StandaloneKindSignatures #-}

9{-# language StandaloneKindSignatures #-}

10+{-# language TypeApplications #-}

9{-# language TypeFamilies #-}

11{-# language TypeFamilies #-}

10{-# language UndecidableInstances #-}

12{-# language UndecidableInstances #-}

@@ -25,22 +27,23 @@ import Prelude hiding ( undefined )

25-- rel8

27-- rel8

26import Rel8.Expr ( Expr )

28import Rel8.Expr ( Expr )

27import Rel8.Expr.Serialize ( litExpr )

29import Rel8.Expr.Serialize ( litExpr )

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

30+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )

29import Rel8.Schema.Context.Nullify

31import Rel8.Schema.Context.Nullify

30− ( Nullifiable, NullifiableEq

32+ ( Nullifiable, ConstrainTag

31− , encodeTag, decodeTag

33+ , hencodeTag, hdecodeTag

32− , nullifier, unnullifier

34+ , hnullifier, hunnullifier

33 )

35 )

34−import Rel8.Schema.HTable.Either ( HEitherTable(..) )

36+import Rel8.Schema.HTable.Either ( HEitherTable(..), HEitherNullifiable )

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

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

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

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

37import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

39import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

38import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

40import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

39import Rel8.Table.Bool ( bool )

41import Rel8.Table.Bool ( bool )

42+import Rel8.Table.Eq ( EqTable, eqTable )

40import Rel8.Table.Lifted

43import Rel8.Table.Lifted

41− ( Table1, Columns1, ConstrainContext1, fromColumns1, toColumns1

42− , Table2, Columns2, ConstrainContext2, fromColumns2, toColumns2

44+ ( Table2, Columns2, ConstrainHContext2, fromColumns2, toColumns2

43 )

45 )

46+import Rel8.Table.Ord ( OrdTable, ordTable )

44import Rel8.Table.Recontextualize ( Recontextualize )

47import Rel8.Table.Recontextualize ( Recontextualize )

45import Rel8.Table.Undefined ( undefined )

48import Rel8.Table.Undefined ( undefined )

46import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

49import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ), isLeft, isRight )

@@ -89,42 +92,34 @@ instance (Table Expr a, Table Expr b) => Semigroup (EitherTable a b) where

90instance Table2 EitherTable where

93instance Table2 EitherTable where

91 type Columns2 EitherTable = HEitherTable

94 type Columns2 EitherTable = HEitherTable

92− type ConstrainContext2 EitherTable = Nullifiable

95+ type ConstrainHContext2 EitherTable = HEitherNullifiable

94 toColumns2 f g EitherTable {tag, left, right} = HEitherTable

97 toColumns2 f g EitherTable {tag, left, right} = HEitherTable

95 { htag

98 { htag

96− , hleft = hnullify (nullifier (isLeft tag)) $ f left

99+ , hleft = hnullify (hnullifier (isLeft tag)) $ f left

97− , hright = hnullify (nullifier (isRight tag)) $ g right

100+ , hright = hnullify (hnullifier (isRight tag)) $ g right

98 }

101 }

99 where

102 where

100− htag = HIdentity (encodeTag tag)

103+ htag = HIdentity (hencodeTag tag)

101

104

102 fromColumns2 f g HEitherTable {htag = htag, hleft, hright} =

105 fromColumns2 f g HEitherTable {htag = htag, hleft, hright} =

103 EitherTable

106 EitherTable

104 { tag

107 { tag

105 , left = f $ runIdentity $

108 , left = f $ runIdentity $

106− hunnullify (\a -> pure . unnullifier (isLeft tag) a) hleft

109+ hunnullify (\a -> pure . hunnullifier (isLeft tag) a) hleft

107 , right = g $ runIdentity $

110 , right = g $ runIdentity $

108− hunnullify (\a -> pure . unnullifier (isRight tag) a) hright

111+ hunnullify (\a -> pure . hunnullifier (isRight tag) a) hright

109 }

112 }

110 where

113 where

111− tag = decodeTag $ unHIdentity htag

114+ tag = hdecodeTag $ unHIdentity htag

112

115

113 {-# INLINABLE fromColumns2 #-}

116 {-# INLINABLE fromColumns2 #-}

114 {-# INLINABLE toColumns2 #-}

117 {-# INLINABLE toColumns2 #-}

115

118

116

119

117−instance Table context a => Table1 (EitherTable a) where

118− type Columns1 (EitherTable a) = HEitherTable (Columns a)

119− type ConstrainContext1 (EitherTable a) = NullifiableEq (Context a)

120−

121− toColumns1 = toColumns2 toColumns

122− fromColumns1 = fromColumns2 fromColumns

123−

124−

125instance

120instance

126 ( Table context a, Table context b

121 ( Table context a, Table context b

127− , Labelable context, Nullifiable context

122+ , Labelable context, Nullifiable context, ConstrainTag context EitherTag

128 ) =>

123 ) =>

129 Table context (EitherTable a b)

124 Table context (EitherTable a b)

130 where

125 where

@@ -143,14 +138,26 @@ instance

143

138

144

139

145instance

140instance

146− ( Nullifiable from, Labelable from

141+ ( Nullifiable from, Labelable from, ConstrainTag from EitherTag

147− , Nullifiable to, Labelable to

142+ , Nullifiable to, Labelable to, ConstrainTag to EitherTag

148 , Recontextualize from to a1 b1

143 , Recontextualize from to a1 b1

149 , Recontextualize from to a2 b2

144 , Recontextualize from to a2 b2

150 ) =>

145 ) =>

151 Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)

146 Recontextualize from to (EitherTable a1 a2) (EitherTable b1 b2)

152

147

153

148

149+instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where

150+ eqTable =

151+ toColumns2 (hlabel hlabeler) (hlabel hlabeler)

152+ (rightTableWith (eqTable @a) (eqTable @b))

153+

154+

155+instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where

156+ ordTable =

157+ toColumns2 (hlabel hlabeler) (hlabel hlabeler)

158+ (rightTableWith (ordTable @a) (ordTable @b))

159+

160+

154isLeftTable :: EitherTable a b -> Expr Bool

161isLeftTable :: EitherTable a b -> Expr Bool

155isLeftTable = isLeft . tag

162isLeftTable = isLeft . tag

156

163

@@ -170,4 +177,8 @@ leftTable a = EitherTable (litExpr IsLeft) a undefined

170

177

171

178

172rightTable :: Table Expr a => b -> EitherTable a b

179rightTable :: Table Expr a => b -> EitherTable a b

180+rightTable = rightTableWith undefined

181+

182+

183+rightTableWith :: a -> b -> EitherTable a b

173−rightTable = EitherTable (litExpr IsRight) undefined

184+rightTableWith = EitherTable (litExpr IsRight)

src/Rel8/Table/Eq.hs+66−13

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

2{-# language BlockArguments #-}

3{-# language DataKinds #-}

4{-# language DefaultSignatures #-}

5+{-# language DisambiguateRecordFields #-}

5{-# language FlexibleContexts #-}

6{-# language FlexibleContexts #-}

6{-# language FlexibleInstances #-}

7{-# language FlexibleInstances #-}

7{-# language LambdaCase #-}

8{-# language LambdaCase #-}

@@ -30,13 +31,20 @@ import Prelude

30import Rel8.Expr ( Expr, Col(..) )

31import Rel8.Expr ( Expr, Col(..) )

31import Rel8.Expr.Bool ( (||.), (&&.) )

32import Rel8.Expr.Bool ( (||.), (&&.) )

32import Rel8.Expr.Eq ( (==.), (/=.) )

33import Rel8.Expr.Eq ( (==.), (/=.) )

34+import Rel8.Schema.Context.Label ( hlabeler )

33import Rel8.Schema.Dict ( Dict( Dict ) )

35import Rel8.Schema.Dict ( Dict( Dict ) )

34−import Rel8.Schema.HTable ( HConstrainTable, HPairField(..), GHField(..), htabulate, htabulateA, hfield, hdicts, hspecs )

36+import Rel8.Schema.HTable

37+ ( HTable, HConstrainTable

38+ , htabulateA, hfield, hdicts

39+ )

40+import Rel8.Schema.HTable.Label ( hlabel )

41+import Rel8.Schema.HTable.Pair ( HPair(..) )

42+import Rel8.Schema.HTable.Quartet ( HQuartet(..) )

43+import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

44+import Rel8.Schema.HTable.Trio ( HTrio(..) )

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

45import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

36import Rel8.Table ( Table, Columns, toColumns )

46import Rel8.Table ( Table, Columns, toColumns )

37import Rel8.Type.Eq ( DBEq )

47import Rel8.Type.Eq ( DBEq )

38−import Rel8.Schema.HTable.MapTable ( HMapTableField(..) )

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

40import Rel8.Schema.Nullability ( Sql )

48import Rel8.Schema.Nullability ( Sql )

@@ -44,25 +52,70 @@ type EqTable :: Type -> Constraint

44class Table Expr a => EqTable a where

52class Table Expr a => EqTable a where

45 eqTable :: Columns a (Dict (ConstrainDBType DBEq))

53 eqTable :: Columns a (Dict (ConstrainDBType DBEq))

55+ default eqTable :: ()

47− default eqTable :: HConstrainTable (Columns a) (ConstrainDBType DBEq) => Columns a (Dict (ConstrainDBType DBEq))

56+ => HConstrainTable (Columns a) (ConstrainDBType DBEq)

57+ => Columns a (Dict (ConstrainDBType DBEq))

48 eqTable = hdicts @(Columns a) @(ConstrainDBType DBEq)

58 eqTable = hdicts @(Columns a) @(ConstrainDBType DBEq)

61+instance

62+ ( Table Expr (t Expr)

63+ , f ~ Expr

51−instance (Table Expr (t Expr), f ~ Expr, HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)) => EqTable (t f)

64+ , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)

65+ )

66+ => EqTable (t f)

67+

68+

69+instance

70+ ( HTable t

71+ , f ~ Col Expr

72+ , HConstrainTable t (ConstrainDBType DBEq)

73+ )

74+ => EqTable (t f)

54instance Sql DBEq a => EqTable (Expr a)

77instance Sql DBEq a => EqTable (Expr a)

57instance (EqTable a, EqTable b) => EqTable (a, b) where

80instance (EqTable a, EqTable b) => EqTable (a, b) where

58− eqTable = htabulate \case

81+ eqTable =

59− HFst (GHField (HMapTableField i)) ->

82+ HPair

60− case hfield hspecs i of

83+ { hfst = hlabel hlabeler (eqTable @a)

61− SSpec{} -> case hfield (eqTable @a) i of Dict -> Dict

84+ , hsnd = hlabel hlabeler (eqTable @b)

62−

85+ }

63− HSnd (GHField (HMapTableField i)) ->

86+

64− case hfield hspecs i of

87+

65− SSpec{} -> case hfield (eqTable @b) i of Dict -> Dict

88+instance (EqTable a, EqTable b, EqTable c) => EqTable (a, b, c) where

89+ eqTable =

90+ HTrio

91+ { hfst = hlabel hlabeler (eqTable @a)

92+ , hsnd = hlabel hlabeler (eqTable @b)

93+ , htrd = hlabel hlabeler (eqTable @c)

94+ }

95+

96+

97+instance (EqTable a, EqTable b, EqTable c, EqTable d) => EqTable (a, b, c, d)

98+ where

99+ eqTable =

100+ HQuartet

101+ { hfst = hlabel hlabeler (eqTable @a)

102+ , hsnd = hlabel hlabeler (eqTable @b)

103+ , htrd = hlabel hlabeler (eqTable @c)

104+ , hfrt = hlabel hlabeler (eqTable @d)

105+ }

106+

107+

108+instance (EqTable a, EqTable b, EqTable c, EqTable d, EqTable e) =>

109+ EqTable (a, b, c, d, e)

110+ where

111+ eqTable =

112+ HQuintet

113+ { hfst = hlabel hlabeler (eqTable @a)

114+ , hsnd = hlabel hlabeler (eqTable @b)

115+ , htrd = hlabel hlabeler (eqTable @c)

116+ , hfrt = hlabel hlabeler (eqTable @d)

117+ , hfft = hlabel hlabeler (eqTable @e)

118+ }

119

120

68-- | Compare two 'Table's for equality. This corresponds to comparing all

121-- | Compare two 'Table's for equality. This corresponds to comparing all

src/Rel8/Table/Lifted.hs+46−21

@@ -1,13 +1,18 @@

1{-# language ConstrainedClassMethods #-}

2+{-# language ConstraintKinds #-}

2{-# language DataKinds #-}

3{-# language DataKinds #-}

3{-# language FlexibleContexts #-}

4{-# language FlexibleContexts #-}

4{-# language FlexibleInstances #-}

5{-# language FlexibleInstances #-}

6+{-# language MultiParamTypeClasses #-}

7+{-# language QuantifiedConstraints #-}

5{-# language StandaloneKindSignatures #-}

8{-# language StandaloneKindSignatures #-}

6{-# language TypeFamilies #-}

9{-# language TypeFamilies #-}

10+{-# language UndecidableInstances #-}

8module Rel8.Table.Lifted

12module Rel8.Table.Lifted

9− ( Table1( Columns1, ConstrainContext1, toColumns1, fromColumns1 )

13+ ( Table1( Columns1, ConstrainHContext1, toColumns1, fromColumns1 )

10− , Table2( Columns2, ConstrainContext2, toColumns2, fromColumns2 )

14+ , Table2( Columns2, ConstrainHContext2, toColumns2, fromColumns2 )

15+ , ConstrainContext

11 )

16 )

12where

17where

@@ -16,42 +21,62 @@ import Data.Kind ( Constraint, Type )

16import Prelude ()

21import Prelude ()

18-- rel8

23-- rel8

19−import Rel8.Schema.Context ( Interpretation, Col )

24+import Rel8.Schema.Context ( Col )

20import Rel8.Schema.HTable ( HTable )

25import Rel8.Schema.HTable ( HTable )

26+import Rel8.Schema.HTable.Pair

21import qualified Rel8.Schema.Kind as K

27import qualified Rel8.Schema.Kind as K

24type Table1 :: (Type -> Type) -> Constraint

30type Table1 :: (Type -> Type) -> Constraint

25class Table1 f where

31class Table1 f where

26 type Columns1 f :: K.HTable -> K.HTable

32 type Columns1 f :: K.HTable -> K.HTable

27− type ConstrainContext1 f :: K.Context -> Constraint

33+ type ConstrainHContext1 f :: K.HContext -> Constraint

28− type ConstrainContext1 _ = Interpretation

34+ type ConstrainHContext1 _ = DefaultConstrainContext

30− toColumns1 :: (ConstrainContext1 f context, HTable t)

36+ toColumns1 :: (ConstrainHContext1 f context, HTable t)

31− => (a -> t (Col context))

37+ => (a -> t context)

32 -> f a

38 -> f a

33− -> Columns1 f t (Col context)

39+ -> Columns1 f t context

35− fromColumns1 :: (ConstrainContext1 f context, HTable t)

41+ fromColumns1 :: (ConstrainHContext1 f context, HTable t)

36− => (t (Col context) -> a)

42+ => (t context -> a)

37− -> Columns1 f t (Col context)

43+ -> Columns1 f t context

38 -> f a

44 -> f a

41type Table2 :: (Type -> Type -> Type) -> Constraint

47type Table2 :: (Type -> Type -> Type) -> Constraint

42class Table2 p where

48class Table2 p where

43 type Columns2 p :: K.HTable -> K.HTable -> K.HTable

49 type Columns2 p :: K.HTable -> K.HTable -> K.HTable

44− type ConstrainContext2 p :: K.Context -> Constraint

50+ type ConstrainHContext2 p :: K.HContext -> Constraint

45− type ConstrainContext2 _ = Interpretation

51+ type ConstrainHContext2 _ = DefaultConstrainContext

47− toColumns2 :: (ConstrainContext2 p context, HTable t, HTable u)

53+ toColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)

48− => (a -> t (Col context))

54+ => (a -> t context)

49− -> (b -> u (Col context))

55+ -> (b -> u context)

50 -> p a b

56 -> p a b

51− -> Columns2 p t u (Col context)

57+ -> Columns2 p t u context

53− fromColumns2 :: (ConstrainContext2 p context, HTable t, HTable u)

59+ fromColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)

54− => (t (Col context) -> a)

60+ => (t context -> a)

55− -> (u (Col context) -> b)

61+ -> (u context -> b)

56− -> Columns2 p t u (Col context)

62+ -> Columns2 p t u context

57 -> p a b

63 -> p a b

64+

65+

66+instance Table2 (,) where

67+ type Columns2 (,) = HPair

68+

69+ toColumns2 f g (a, b) = HPair (f a) (g b)

70+ fromColumns2 f g (HPair a b) = (f a, g b)

71+

72+

73+type DefaultConstrainContext :: K.HContext -> Constraint

74+class DefaultConstrainContext context

75+instance DefaultConstrainContext context

76+

77+

78+type ConstrainContext :: (K.Context -> Constraint) -> K.HContext -> Constraint

79+class (forall context. hcontext ~ Col context => constraint context)

80+ => ConstrainContext constraint hcontext

81+instance (hcontext ~ Col context, constraint context) =>

82+ ConstrainContext constraint hcontext

src/Rel8/Table/List.hs+30−1

@@ -1,7 +1,9 @@

1{-# language FlexibleContexts #-}

2{-# language FlexibleInstances #-}

3{-# language MultiParamTypeClasses #-}

4+{-# language ScopedTypeVariables #-}

4{-# language StandaloneKindSignatures #-}

5{-# language StandaloneKindSignatures #-}

6+{-# language TypeApplications #-}

5{-# language TypeFamilies #-}

7{-# language TypeFamilies #-}

6{-# language UndecidableInstances #-}

8{-# language UndecidableInstances #-}

@@ -11,19 +13,26 @@ module Rel8.Table.List

11where

13where

13-- base

15-- base

16+import Data.Functor.Identity ( Identity( Identity ) )

14import Data.Kind ( Type )

17import Data.Kind ( Type )

15import Prelude

18import Prelude

17-- rel8

20-- rel8

18import Rel8.Expr ( Expr, Col(..) )

21import Rel8.Expr ( Expr, Col(..) )

19import Rel8.Expr.Array ( sappend, sempty )

22import Rel8.Expr.Array ( sappend, sempty )

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

20import Rel8.Schema.HTable.List ( HListTable )

24import Rel8.Schema.HTable.List ( HListTable )

21−import Rel8.Schema.HTable.Vectorize ( happend, hempty )

25+import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )

26+import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

27+import Rel8.Schema.Spec ( SSpec( SSpec ) )

28+import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )

22import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

29import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

23import Rel8.Table.Alternative

30import Rel8.Table.Alternative

24 ( AltTable, (<|>:)

31 ( AltTable, (<|>:)

25 , AlternativeTable, emptyTable

32 , AlternativeTable, emptyTable

26 )

33 )

34+import Rel8.Table.Eq ( EqTable, eqTable )

35+import Rel8.Table.Ord ( OrdTable, ordTable )

27import Rel8.Table.Recontextualize ( Recontextualize )

36import Rel8.Table.Recontextualize ( Recontextualize )

@@ -45,6 +54,26 @@ instance Recontextualize from to a b =>

45 Recontextualize from to (ListTable a) (ListTable b)

54 Recontextualize from to (ListTable a) (ListTable b)

57+instance EqTable a => EqTable (ListTable a) where

58+ eqTable =

59+ hvectorize

60+ (\SSpec {} (Identity dict) -> case dbTypeDict dict of

61+ Dict -> case dbTypeNullability dict of

62+ Nullable -> Dict

63+ NonNullable -> Dict)

64+ (Identity (eqTable @a))

65+

66+

67+instance OrdTable a => OrdTable (ListTable a) where

68+ ordTable =

69+ hvectorize

70+ (\SSpec {} (Identity dict) -> case dbTypeDict dict of

71+ Dict -> case dbTypeNullability dict of

72+ Nullable -> Dict

73+ NonNullable -> Dict)

74+ (Identity (ordTable @a))

75+

76+

48instance AltTable ListTable where

77instance AltTable ListTable where

49 (<|>:) = (<>)

78 (<|>:) = (<>)

src/Rel8/Table/Maybe.hs+24−13

@@ -29,15 +29,15 @@ import Rel8.Expr ( Expr )

29import Rel8.Expr.Bool ( boolExpr )

30import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )

31import Rel8.Expr.Serialize ( litExpr )

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

32+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )

33import Rel8.Schema.Context.Nullify

34− ( Nullifiable

34+ ( Nullifiable, ConstrainTag

35− , encodeTag, decodeTag

35+ , hencodeTag, hdecodeTag

36− , nullifier, unnullifier

36+ , hnullifier, hunnullifier

37 )

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

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

40−import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )

40+import Rel8.Schema.HTable.Maybe ( HMaybeTable(..), HMaybeNullifiable )

41import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

42import Rel8.Schema.Nullability

43 ( Nullify

@@ -50,9 +50,11 @@ import Rel8.Table.Alternative

50 , AlternativeTable, emptyTable

51 )

52import Rel8.Table.Bool ( bool )

53+import Rel8.Table.Eq ( EqTable, eqTable )

53import Rel8.Table.Lifted

54import Rel8.Table.Lifted

54− ( Table1, Columns1, ConstrainContext1, fromColumns1, toColumns1

55+ ( Table1, Columns1, ConstrainHContext1, fromColumns1, toColumns1

55 )

56 )

57+import Rel8.Table.Ord ( OrdTable, ordTable )

56import Rel8.Table.Recontextualize ( Recontextualize )

58import Rel8.Table.Recontextualize ( Recontextualize )

57import Rel8.Table.Undefined ( undefined )

59import Rel8.Table.Undefined ( undefined )

58import Rel8.Type ( DBType )

60import Rel8.Type ( DBType )

@@ -124,22 +126,22 @@ instance (Table Expr a, Semigroup a) => Monoid (MaybeTable a) where

124

126

125instance Table1 MaybeTable where

127instance Table1 MaybeTable where

126 type Columns1 MaybeTable = HMaybeTable

128 type Columns1 MaybeTable = HMaybeTable

127− type ConstrainContext1 MaybeTable = Nullifiable

129+ type ConstrainHContext1 MaybeTable = HMaybeNullifiable

128

130

129 toColumns1 f MaybeTable {tag, just} = HMaybeTable

131 toColumns1 f MaybeTable {tag, just} = HMaybeTable

130 { htag

132 { htag

131− , hjust = hnullify (nullifier (isNonNull tag)) $ f just

133+ , hjust = hnullify (hnullifier (isNonNull tag)) $ f just

132 }

134 }

133 where

135 where

134− htag = HIdentity (encodeTag tag)

136+ htag = HIdentity (hencodeTag tag)

135

137

136 fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable

138 fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable

137 { tag

139 { tag

138 , just = f $ runIdentity $

140 , just = f $ runIdentity $

139− hunnullify (\a -> pure . unnullifier (isNonNull tag) a) hjust

141+ hunnullify (\a -> pure . hunnullifier (isNonNull tag) a) hjust

140 }

142 }

141 where

143 where

142− tag = decodeTag htag

144+ tag = hdecodeTag htag

143

145

144 {-# INLINABLE fromColumns1 #-}

146 {-# INLINABLE fromColumns1 #-}

145 {-# INLINABLE toColumns1 #-}

147 {-# INLINABLE toColumns1 #-}

@@ -148,6 +150,7 @@ instance Table1 MaybeTable where

148instance

150instance

149 ( Table context a

151 ( Table context a

150 , Labelable context, Nullifiable context

152 , Labelable context, Nullifiable context

153+ , ConstrainTag context MaybeTag

151 ) => Table context (MaybeTable a)

154 ) => Table context (MaybeTable a)

152 where

155 where

153 type Columns (MaybeTable a) = HMaybeTable (HLabel "Just" (Columns a))

156 type Columns (MaybeTable a) = HMaybeTable (HLabel "Just" (Columns a))

@@ -158,12 +161,20 @@ instance

158

161

159

162

160instance

163instance

161− ( Labelable from, Nullifiable from

164+ ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag

162− , Labelable to, Nullifiable to

165+ , Labelable to, Nullifiable to, ConstrainTag to MaybeTag

163 , Recontextualize from to a b

166 , Recontextualize from to a b

164 ) => Recontextualize from to (MaybeTable a) (MaybeTable b)

167 ) => Recontextualize from to (MaybeTable a) (MaybeTable b)

165

168

166

169

170+instance EqTable a => EqTable (MaybeTable a) where

171+ eqTable = toColumns1 (hlabel hlabeler) (justTable (eqTable @a))

172+

173+

174+instance OrdTable a => OrdTable (MaybeTable a) where

175+ ordTable = toColumns1 (hlabel hlabeler) (justTable (ordTable @a))

176+

177+

167-- | Check if a @MaybeTable@ is absent of any row.. Like 'isNothing'.

178-- | Check if a @MaybeTable@ is absent of any row.. Like 'isNothing'.

168isNothingTable :: MaybeTable a -> Expr Bool

179isNothingTable :: MaybeTable a -> Expr Bool

169isNothingTable (MaybeTable tag _) = isNull tag

180isNothingTable (MaybeTable tag _) = isNull tag

src/Rel8/Table/NonEmpty.hs+30−1

@@ -1,6 +1,8 @@

1{-# language FlexibleInstances #-}

2{-# language MultiParamTypeClasses #-}

3+{-# language ScopedTypeVariables #-}

3{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

5+{-# language TypeApplications #-}

4{-# language TypeFamilies #-}

6{-# language TypeFamilies #-}

5{-# language UndecidableInstances #-}

7{-# language UndecidableInstances #-}

@@ -11,16 +13,23 @@ module Rel8.Table.NonEmpty

11where

13where

13-- base

15-- base

16+import Data.Functor.Identity ( Identity( Identity ) )

14import Data.Kind ( Type )

17import Data.Kind ( Type )

15import Prelude

18import Prelude

17-- rel8

20-- rel8

18import Rel8.Expr ( Expr, Col(..) )

21import Rel8.Expr ( Expr, Col(..) )

19import Rel8.Expr.Array ( sappend1 )

22import Rel8.Expr.Array ( sappend1 )

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

20import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )

24import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )

21−import Rel8.Schema.HTable.Vectorize ( happend )

25+import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )

26+import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

27+import Rel8.Schema.Spec ( SSpec( SSpec ) )

28+import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )

22import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

29import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )

23import Rel8.Table.Alternative ( AltTable, (<|>:) )

30import Rel8.Table.Alternative ( AltTable, (<|>:) )

31+import Rel8.Table.Eq ( EqTable, eqTable )

32+import Rel8.Table.Ord ( OrdTable, ordTable )

24import Rel8.Table.Recontextualize ( Recontextualize )

33import Rel8.Table.Recontextualize ( Recontextualize )

@@ -43,6 +52,26 @@ instance Recontextualize from to a b =>

43 Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)

52 Recontextualize from to (NonEmptyTable a) (NonEmptyTable b)

55+instance EqTable a => EqTable (NonEmptyTable a) where

56+ eqTable =

57+ hvectorize

58+ (\SSpec {} (Identity dict) -> case dbTypeDict dict of

59+ Dict -> case dbTypeNullability dict of

60+ Nullable -> Dict

61+ NonNullable -> Dict)

62+ (Identity (eqTable @a))

63+

64+

65+instance OrdTable a => OrdTable (NonEmptyTable a) where

66+ ordTable =

67+ hvectorize

68+ (\SSpec {} (Identity dict) -> case dbTypeDict dict of

69+ Dict -> case dbTypeNullability dict of

70+ Nullable -> Dict

71+ NonNullable -> Dict)

72+ (Identity (ordTable @a))

73+

74+

46instance AltTable NonEmptyTable where

75instance AltTable NonEmptyTable where

47 (<|>:) = (<>)

76 (<|>:) = (<>)

src/Rel8/Table/Ord.hs+70−3

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

1{-# language AllowAmbiguousTypes #-}

2{-# language DataKinds #-}

3{-# language DefaultSignatures #-}

4+{-# language DisambiguateRecordFields #-}

4{-# language FlexibleInstances #-}

5{-# language FlexibleInstances #-}

5{-# language NamedFieldPuns #-}

6{-# language NamedFieldPuns #-}

6{-# language ScopedTypeVariables #-}

7{-# language ScopedTypeVariables #-}

@@ -26,12 +27,22 @@ import Rel8.Expr ( Expr, Col(..) )

26import Rel8.Expr.Bool ( (||.), (&&.), false, true )

27import Rel8.Expr.Bool ( (||.), (&&.), false, true )

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

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

28import Rel8.Expr.Ord ( (<.), (>.) )

29import Rel8.Expr.Ord ( (<.), (>.) )

30+import Rel8.Schema.Context.Label ( hlabeler )

29import Rel8.Schema.Dict ( Dict( Dict ) )

31import Rel8.Schema.Dict ( Dict( Dict ) )

30−import Rel8.Schema.HTable ( HConstrainTable, htabulateA, hfield, hdicts )

32+import Rel8.Schema.HTable

33+ ( HTable, HConstrainTable

34+ , htabulateA, hfield, hdicts

35+ )

36+import Rel8.Schema.HTable.Label ( hlabel )

37+import Rel8.Schema.HTable.Pair ( HPair(..) )

38+import Rel8.Schema.HTable.Quartet ( HQuartet(..) )

39+import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

40+import Rel8.Schema.HTable.Trio ( HTrio(..) )

31import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

41import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

32−import Rel8.Table ( Columns, toColumns )

42+import Rel8.Table ( Table, Columns, toColumns )

33import Rel8.Table.Bool ( bool )

43import Rel8.Table.Bool ( bool )

34import Rel8.Table.Eq ( EqTable )

44import Rel8.Table.Eq ( EqTable )

45+import Rel8.Type.Eq ( DBEq )

35import Rel8.Type.Ord ( DBOrd )

46import Rel8.Type.Ord ( DBOrd )

36import Rel8.Schema.Nullability (Sql)

47import Rel8.Schema.Nullability (Sql)

@@ -47,12 +58,68 @@ class EqTable a => OrdTable a where

47 ordTable = hdicts @(Columns a) @(ConstrainDBType DBOrd)

58 ordTable = hdicts @(Columns a) @(ConstrainDBType DBOrd)

61+instance

62+ ( Table Expr (t Expr)

63+ , f ~ Expr

50−instance (EqTable (t Expr), f ~ Expr, HConstrainTable (Columns (t Expr)) (ConstrainDBType DBOrd)) => OrdTable (t f)

64+ , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)

65+ , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBOrd)

66+ )

67+ => OrdTable (t f)

68+

69+

70+instance

71+ ( HTable t

72+ , f ~ Col Expr

73+ , HConstrainTable t (ConstrainDBType DBEq)

74+ , HConstrainTable t (ConstrainDBType DBOrd)

75+ )

76+ => OrdTable (t f)

53instance Sql DBOrd a => OrdTable (Expr a)

79instance Sql DBOrd a => OrdTable (Expr a)

82+instance (OrdTable a, OrdTable b) => OrdTable (a, b) where

83+ ordTable =

84+ HPair

85+ { hfst = hlabel hlabeler (ordTable @a)

86+ , hsnd = hlabel hlabeler (ordTable @b)

87+ }

88+

89+

90+instance (OrdTable a, OrdTable b, OrdTable c) => OrdTable (a, b, c) where

91+ ordTable =

92+ HTrio

93+ { hfst = hlabel hlabeler (ordTable @a)

94+ , hsnd = hlabel hlabeler (ordTable @b)

95+ , htrd = hlabel hlabeler (ordTable @c)

96+ }

97+

98+

99+instance (OrdTable a, OrdTable b, OrdTable c, OrdTable d) => OrdTable (a, b, c, d)

100+ where

101+ ordTable =

102+ HQuartet

103+ { hfst = hlabel hlabeler (ordTable @a)

104+ , hsnd = hlabel hlabeler (ordTable @b)

105+ , htrd = hlabel hlabeler (ordTable @c)

106+ , hfrt = hlabel hlabeler (ordTable @d)

107+ }

108+

109+

110+instance (OrdTable a, OrdTable b, OrdTable c, OrdTable d, OrdTable e) =>

111+ OrdTable (a, b, c, d, e)

112+ where

113+ ordTable =

114+ HQuintet

115+ { hfst = hlabel hlabeler (ordTable @a)

116+ , hsnd = hlabel hlabeler (ordTable @b)

117+ , htrd = hlabel hlabeler (ordTable @c)

118+ , hfrt = hlabel hlabeler (ordTable @d)

119+ , hfft = hlabel hlabeler (ordTable @e)

120+ }

121+

122+

56-- | Test if one 'Table' sorts before another. Corresponds to comparing all

123-- | Test if one 'Table' sorts before another. Corresponds to comparing all

57-- columns with '<'.

124-- columns with '<'.

58(<:) :: forall a. OrdTable a => a -> a -> Expr Bool

125(<:) :: forall a. OrdTable a => a -> a -> Expr Bool

src/Rel8/Table/Order.hs+13−35

@@ -21,15 +21,11 @@ import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )

21import Rel8.Order ( Order )

22import Rel8.Schema.Dict ( Dict( Dict ) )

23import Rel8.Schema.HTable (htabulateA, hfield, hspecs)

24−import Rel8.Schema.Nullability

24+import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

25− ( Unnullify, Nullability( Nullable, NonNullable )

26− , Sql, nullabilization

27− )

28−import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec ) )

25+import Rel8.Schema.Spec ( SSpec( SSpec ) )

29−import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

26+import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullability )

30import Rel8.Table

27import Rel8.Table

31import Rel8.Table.Ord

28import Rel8.Table.Ord

32−import Rel8.Type.Ord

35-- | Construct an 'Order' for a 'Table' by sorting all columns into ascending

31-- | Construct an 'Order' for a 'Table' by sorting all columns into ascending

@@ -38,10 +34,11 @@ ascTable :: forall a. OrdTable a => Order a

38ascTable = contramap toColumns $ getConst $

34ascTable = contramap toColumns $ getConst $

39 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

35 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

40 SSpec {} -> case hfield (ordTable @a) field of

36 SSpec {} -> case hfield (ordTable @a) field of

41− dict@Dict -> case ord dict of

37+ dict@Dict -> case dbTypeDict dict of

42− Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of

38+ Dict -> Const $ unDB . (`hfield` field) >$<

39+ case dbTypeNullability dict of

43− Nullable -> nullsFirst asc

40+ Nullable -> nullsFirst asc

44− NonNullable -> asc

41+ NonNullable -> asc

47-- | Construct an 'Order' for a 'Table' by sorting all columns into descending

44-- | Construct an 'Order' for a 'Table' by sorting all columns into descending

@@ -50,27 +47,8 @@ descTable :: forall a. OrdTable a => Order a

50descTable = contramap toColumns $ getConst $

47descTable = contramap toColumns $ getConst $

51 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

48 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

52 SSpec {} -> case hfield (ordTable @a) field of

49 SSpec {} -> case hfield (ordTable @a) field of

53− dict@Dict -> case ord dict of

50+ dict@Dict -> case dbTypeDict dict of

54− Dict -> Const $ unDB . (`hfield` field) >$< case nullability dict of

51+ Dict -> Const $ unDB . (`hfield` field) >$<

52+ case dbTypeNullability dict of

55− Nullable -> nullsLast desc

53+ Nullable -> nullsLast desc

56− NonNullable -> desc

54+ NonNullable -> desc

57−

58−

59−nullability :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Nullability a

60−nullability = step2 . step1

61− where

62− step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a

63− step1 Dict = Dict

64−

65− step2 :: Dict (Sql DBOrd) a -> Nullability a

66− step2 Dict = nullabilization

67−

68−

69−ord :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict DBOrd (Unnullify a)

70−ord = step2 . step1

71− where

72− step1 :: Dict (ConstrainDBType DBOrd) ('Spec l n a) -> Dict (Sql DBOrd) a

73− step1 Dict = Dict

74−

75− step2 :: Dict (Sql DBOrd) a -> Dict DBOrd (Unnullify a)

76− step2 Dict = Dict

src/Rel8/Table/These.hs+35−26

@@ -5,8 +5,10 @@

5{-# language FlexibleInstances #-}

6{-# language MultiParamTypeClasses #-}

7{-# language NamedFieldPuns #-}

8+{-# language ScopedTypeVariables #-}

8{-# language StandaloneKindSignatures #-}

9{-# language StandaloneKindSignatures #-}

9{-# language TupleSections #-}

10{-# language TupleSections #-}

11+{-# language TypeApplications #-}

10{-# language TypeFamilies #-}

12{-# language TypeFamilies #-}

11{-# language UndecidableInstances #-}

13{-# language UndecidableInstances #-}

@@ -29,28 +31,31 @@ import Prelude hiding ( undefined )

29import Rel8.Expr ( Expr )

31import Rel8.Expr ( Expr )

30import Rel8.Expr.Bool ( (&&.), not_ )

32import Rel8.Expr.Bool ( (&&.), not_ )

31import Rel8.Expr.Null ( isNonNull )

33import Rel8.Expr.Null ( isNonNull )

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

34+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )

33import Rel8.Schema.Context.Nullify

35import Rel8.Schema.Context.Nullify

34− ( Nullifiable, NullifiableEq

36+ ( Nullifiable, ConstrainTag

35− , encodeTag, decodeTag

37+ , hencodeTag, hdecodeTag

36− , nullifier, unnullifier

38+ , hnullifier, hunnullifier

37 )

39 )

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

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

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

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

42+import Rel8.Schema.HTable.Maybe ( HMaybeNullifiable )

40import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

43import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

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

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

42import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

45import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

46+import Rel8.Table.Eq ( EqTable, eqTable )

43import Rel8.Table.Lifted

47import Rel8.Table.Lifted

44− ( Table1, Columns1, ConstrainContext1, fromColumns1, toColumns1

45− , Table2, Columns2, ConstrainContext2, fromColumns2, toColumns2

48+ ( Table2, Columns2, ConstrainHContext2, fromColumns2, toColumns2

46 )

49 )

47import Rel8.Table.Maybe

50import Rel8.Table.Maybe

48 ( MaybeTable(..)

51 ( MaybeTable(..)

49 , maybeTable, justTable, nothingTable

52 , maybeTable, justTable, nothingTable

50 , isJustTable

53 , isJustTable

51 )

54 )

55+import Rel8.Table.Ord ( OrdTable, ordTable )

52import Rel8.Table.Recontextualize ( Recontextualize )

56import Rel8.Table.Recontextualize ( Recontextualize )

53import Rel8.Table.Undefined ( undefined )

57import Rel8.Table.Undefined ( undefined )

58+import Rel8.Type.Tag ( MaybeTag )

55-- semigroupoids

60-- semigroupoids

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

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

@@ -108,37 +113,37 @@ instance (Table Expr a, Table Expr b, Semigroup a, Semigroup b) =>

108

113

109instance Table2 TheseTable where

114instance Table2 TheseTable where

110 type Columns2 TheseTable = HTheseTable

115 type Columns2 TheseTable = HTheseTable

111− type ConstrainContext2 TheseTable = Nullifiable

116+ type ConstrainHContext2 TheseTable = HMaybeNullifiable

112

117

113 toColumns2 f g TheseTable {here, there} = HTheseTable

118 toColumns2 f g TheseTable {here, there} = HTheseTable

114− { hhereTag = HIdentity $ encodeTag (tag here)

119+ { hhereTag = HIdentity $ hencodeTag (tag here)

115− , hhere = hnullify (nullifier (isNonNull (tag here))) $ f (just here)

120+ , hhere = hnullify (hnullifier (isNonNull (tag here))) $ f (just here)

116− , hthereTag = HIdentity $ encodeTag (tag there)

121+ , hthereTag = HIdentity $ hencodeTag (tag there)

117− , hthere = hnullify (nullifier (isNonNull (tag there))) $ g (just there)

122+ , hthere = hnullify (hnullifier (isNonNull (tag there))) $ g (just there)

118 }

123 }

119

124

120 fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =

125 fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =

121 TheseTable

126 TheseTable

122 { here =

127 { here =

123 let

128 let

124− tag = decodeTag $ unHIdentity hhereTag

129+ tag = hdecodeTag $ unHIdentity hhereTag

125 in

130 in

126 MaybeTable

131 MaybeTable

127 { tag

132 { tag

128 , just = f $

133 , just = f $

129 runIdentity $

134 runIdentity $

130− hunnullify (\a -> pure . unnullifier (isNonNull tag) a)

135+ hunnullify (\a -> pure . hunnullifier (isNonNull tag) a)

131 hhere

136 hhere

132 }

137 }

133 , there =

138 , there =

134 let

139 let

135− tag = decodeTag $ unHIdentity hthereTag

140+ tag = hdecodeTag $ unHIdentity hthereTag

136 in

141 in

137 MaybeTable

142 MaybeTable

138 { tag

143 { tag

139 , just = g $

144 , just = g $

140 runIdentity $

145 runIdentity $

141− hunnullify (\a -> pure . unnullifier (isNonNull tag) a)

146+ hunnullify (\a -> pure . hunnullifier (isNonNull tag) a)

142 hthere

147 hthere

143 }

148 }

144 }

149 }

@@ -147,17 +152,9 @@ instance Table2 TheseTable where

147 {-# INLINABLE toColumns2 #-}

152 {-# INLINABLE toColumns2 #-}

148

153

149

154

150−instance Table context a => Table1 (TheseTable a) where

151− type Columns1 (TheseTable a) = HTheseTable (Columns a)

152− type ConstrainContext1 (TheseTable a) = NullifiableEq (Context a)

153−

154− toColumns1 = toColumns2 toColumns

155− fromColumns1 = fromColumns2 fromColumns

156−

157−

158instance

155instance

159 ( Table context a, Table context b

156 ( Table context a, Table context b

160− , Labelable context, Nullifiable context

157+ , Labelable context, Nullifiable context, ConstrainTag context MaybeTag

161 ) => Table context (TheseTable a b)

158 ) => Table context (TheseTable a b)

162 where

159 where

163 type Columns (TheseTable a b) =

160 type Columns (TheseTable a b) =

@@ -175,14 +172,26 @@ instance

175

172

176

173

177instance

174instance

178− ( Labelable from, Nullifiable from

175+ ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag

179− , Labelable to, Nullifiable to

176+ , Labelable to, Nullifiable to, ConstrainTag to MaybeTag

180 , Recontextualize from to a1 b1

177 , Recontextualize from to a1 b1

181 , Recontextualize from to a2 b2

178 , Recontextualize from to a2 b2

182 ) =>

179 ) =>

183 Recontextualize from to (TheseTable a1 a2) (TheseTable b1 b2)

180 Recontextualize from to (TheseTable a1 a2) (TheseTable b1 b2)

184

181

185

182

183+instance (EqTable a, EqTable b) => EqTable (TheseTable a b) where

184+ eqTable =

185+ toColumns2 (hlabel hlabeler) (hlabel hlabeler)

186+ (thoseTable (eqTable @a) (eqTable @b))

187+

188+

189+instance (OrdTable a, OrdTable b) => OrdTable (TheseTable a b) where

190+ ordTable =

191+ toColumns2 (hlabel hlabeler) (hlabel hlabeler)

192+ (thoseTable (ordTable @a) (ordTable @b))

193+

194+

186isThisTable :: TheseTable a b -> Expr Bool

195isThisTable :: TheseTable a b -> Expr Bool

187isThisTable a = hasHereTable a &&. not_ (hasThereTable a)

196isThisTable a = hasHereTable a &&. not_ (hasThereTable a)

188

197