e0a1851 · rel8 · git.iko.soy

rel8.cabal+2−1

compare with master

unifiedsplit

@@ -114,6 +114,7 @@ library

114 Rel8.Query.These

115 Rel8.Query.Values

116

117+ Rel8.Schema.Context.Lower

117 Rel8.Schema.Context.Nullify

118 Rel8.Schema.Context.Nullify

118 Rel8.Schema.Context.Virtual

119 Rel8.Schema.Context.Virtual

119 Rel8.Schema.Dict

120 Rel8.Schema.Dict

@@ -161,10 +162,10 @@ library

161 Rel8.Table.Opaleye

162 Rel8.Table.Opaleye

162 Rel8.Table.Ord

163 Rel8.Table.Ord

163 Rel8.Table.Order

164 Rel8.Table.Order

164− Rel8.Table.Recontextualize

165 Rel8.Table.Rel8able

166 Rel8.Table.Serialize

167 Rel8.Table.These

168+ Rel8.Table.Transpose

168 Rel8.Table.Undefined

169 Rel8.Table.Undefined

169

170

170 Rel8.Type

171 Rel8.Type

src/Rel8.hs+2−2

@@ -43,7 +43,7 @@ module Rel8

43

44 , Table(..)

45 , HTable

46− , Recontextualize

46+ , Transposes

47 , AltTable((<|>:))

48 , AlternativeTable( emptyTable )

49 , EqTable, (==:), (/=:)

@@ -342,10 +342,10 @@ import Rel8.Table.Name

342import Rel8.Table.NonEmpty

343import Rel8.Table.Ord

344import Rel8.Table.Order

345−import Rel8.Table.Recontextualize

346import Rel8.Table.Rel8able ()

345import Rel8.Table.Rel8able ()

347import Rel8.Table.Serialize

346import Rel8.Table.Serialize

348import Rel8.Table.These

347import Rel8.Table.These

348+import Rel8.Table.Transpose

349import Rel8.Type

350import Rel8.Type.Composite

351import Rel8.Type.Eq

src/Rel8/Aggregate.hs+9−25

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

9{-# language StandaloneKindSignatures #-}

10{-# language TypeFamilies #-}

11{-# language UndecidableInstances #-}

12−{-# language UndecidableSuperClasses #-}

13

12

14module Rel8.Aggregate

13module Rel8.Aggregate

15 ( Aggregate(..), foldInputs, mapInputs

14 ( Aggregate(..), foldInputs, mapInputs

@@ -30,16 +29,17 @@ import qualified Opaleye.Internal.PackMap as Opaleye

30

29

31-- rel8

30-- rel8

32import Rel8.Expr ( Expr )

31import Rel8.Expr ( Expr )

32+import Rel8.Schema.Context.Lower ( Lower )

33import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )

34−import Rel8.Schema.Name ( Name )

35import Rel8.Schema.Null ( Sql )

34import Rel8.Schema.Null ( Sql )

36import Rel8.Schema.Result ( Result( R ) )

35import Rel8.Schema.Result ( Result( R ) )

37import Rel8.Schema.Spec ( Spec( Spec ) )

36import Rel8.Schema.Spec ( Spec( Spec ) )

38import Rel8.Table

37import Rel8.Table

39 ( Table, Columns, Context, fromColumns, toColumns

38 ( Table, Columns, Context, fromColumns, toColumns

40 , FromExprs, fromResult, toResult

39 , FromExprs, fromResult, toResult

40+ , Transpose

41 )

42−import Rel8.Table.Recontextualize ( Recontextualize )

42+import Rel8.Table.Transpose ( Transposes )

43import Rel8.Type ( DBType )

44

45

@@ -54,10 +54,14 @@ data Aggregate a where

54 A :: { unA :: !(Aggregate a) } -> Aggregate ('Spec a)

55

56

57+type instance Lower Aggregate = Aggregate

58+

59+

57instance Sql DBType a => Table Aggregate (Aggregate a) where

60instance Sql DBType a => Table Aggregate (Aggregate a) where

58 type Columns (Aggregate a) = HType a

61 type Columns (Aggregate a) = HType a

59 type Context (Aggregate a) = Aggregate

62 type Context (Aggregate a) = Aggregate

60 type FromExprs (Aggregate a) = a

63 type FromExprs (Aggregate a) = a

64+ type Transpose to (Aggregate a) = Lower to a

61

65

62 toColumns = HIdentity . A

66 toColumns = HIdentity . A

63 fromColumns (HIdentity (A a)) = a

67 fromColumns (HIdentity (A a)) = a

@@ -65,31 +69,11 @@ instance Sql DBType a => Table Aggregate (Aggregate a) where

65 fromResult (HIdentity (R a)) = a

69 fromResult (HIdentity (R a)) = a

66

70

67

71

68−instance Sql DBType a =>

69− Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)

70−

71−

72−instance Sql DBType a =>

73− Recontextualize Aggregate Expr (Aggregate a) (Expr a)

74−

75−

76−instance Sql DBType a =>

77− Recontextualize Aggregate Name (Aggregate a) (Name a)

78−

79−

80−instance Sql DBType a =>

81− Recontextualize Expr Aggregate (Expr a) (Aggregate a)

82−

83−

84−instance Sql DBType a =>

85− Recontextualize Name Aggregate (Name a) (Aggregate a)

86−

87−

88-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's

72-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's

89-- for the columns in @b@.

73-- for the columns in @b@.

90type Aggregates :: Type -> Type -> Constraint

74type Aggregates :: Type -> Type -> Constraint

91−class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

75+class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs

92−instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

76+instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs

93

77

94

78

95foldInputs :: forall (a :: Type) (b :: Type). Monoid b

79foldInputs :: forall (a :: Type) (b :: Type). Monoid b

src/Rel8/Column.hs+3−7

@@ -13,11 +13,9 @@ import Data.Kind ( Type )

13import Prelude ()

14

15-- rel8

16−import Rel8.Aggregate ( Aggregate )

17−import Rel8.Expr ( Expr )

18import Rel8.FCF ( Eval, Exp )

16import Rel8.FCF ( Eval, Exp )

19import qualified Rel8.Schema.Kind as K

17import qualified Rel8.Schema.Kind as K

20−import Rel8.Schema.Name ( Name(..) )

18+import Rel8.Schema.Context.Lower ( Lower )

21import Rel8.Schema.Result ( Result )

19import Rel8.Schema.Result ( Result )

22

20

23

21

@@ -26,10 +24,8 @@ import Rel8.Schema.Result ( Result )

26-- 'Rel8able' definitions), and @a@ is the type of the column.

24-- 'Rel8able' definitions), and @a@ is the type of the column.

27type Column :: K.Context -> Type -> Type

25type Column :: K.Context -> Type -> Type

28type family Column context a where

26type family Column context a where

29− Column Aggregate a = Aggregate a

30− Column Expr a = Expr a

31− Column Name a = Name a

32− Column Result a = a

27+ Column Result a = a

28+ Column context a = Lower context a

33

29

34

30

35data TColumn :: K.Context -> Type -> Exp Type

31data TColumn :: K.Context -> Type -> Exp Type

src/Rel8/Expr.hs+10−6

@@ -11,9 +11,11 @@

11{-# language TypeApplications #-}

12{-# language TypeFamilies #-}

13{-# language UndecidableInstances #-}

14−{-# language UndecidableSuperClasses #-}

15

14

16−module Rel8.Expr ( Expr(..) ) where

15+module Rel8.Expr

16+ ( Expr(..)

17+ )

18+where

17

19

18-- base

20-- base

19import Data.Kind ( Type )

21import Data.Kind ( Type )

@@ -33,6 +35,7 @@ import Rel8.Expr.Opaleye

33 , zipPrimExprsWith

35 , zipPrimExprsWith

34 )

36 )

35import Rel8.Expr.Serialize ( litExpr )

37import Rel8.Expr.Serialize ( litExpr )

38+import Rel8.Schema.Context.Lower ( Lower )

36import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )

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

37import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )

40import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )

38import Rel8.Schema.Result ( Result( R ) )

41import Rel8.Schema.Result ( Result( R ) )

@@ -40,8 +43,8 @@ import Rel8.Schema.Spec ( Spec( Spec ) )

40import Rel8.Table

43import Rel8.Table

41 ( Table, Columns, Context, fromColumns, toColumns

44 ( Table, Columns, Context, fromColumns, toColumns

42 , FromExprs, fromResult, toResult

45 , FromExprs, fromResult, toResult

46+ , Transpose

43 )

47 )

44−import Rel8.Table.Recontextualize ( Recontextualize )

45import Rel8.Type ( DBType )

48import Rel8.Type ( DBType )

46import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

49import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

47import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )

50import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )

@@ -58,6 +61,9 @@ data Expr a where

58deriving stock instance Show (Expr a)

61deriving stock instance Show (Expr a)

59

62

60

63

64+type instance Lower Expr = Expr

65+

66+

61instance Sql DBSemigroup a => Semigroup (Expr a) where

67instance Sql DBSemigroup a => Semigroup (Expr a) where

62 (<>) = case nullable @a of

68 (<>) = case nullable @a of

63 Null -> liftOpNull (<>.)

69 Null -> liftOpNull (<>.)

@@ -123,11 +129,9 @@ instance Sql DBType a => Table Expr (Expr a) where

123 type Columns (Expr a) = HType a

129 type Columns (Expr a) = HType a

124 type Context (Expr a) = Expr

130 type Context (Expr a) = Expr

125 type FromExprs (Expr a) = a

131 type FromExprs (Expr a) = a

132+ type Transpose to (Expr a) = Lower to a

126

133

127 toColumns a = HType (E a)

134 toColumns a = HType (E a)

128 fromColumns (HType (E a)) = a

135 fromColumns (HType (E a)) = a

129 toResult a = HType (R a)

136 toResult a = HType (R a)

130 fromResult (HType (R a)) = a

137 fromResult (HType (R a)) = a

131−

132−

133−instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)

src/Rel8/Generic/Map.hs+20

@@ -2,9 +2,11 @@

2{-# language StandaloneKindSignatures #-}

3{-# language TypeFamilies #-}

4{-# language TypeOperators #-}

5+{-# language UndecidableInstances #-}

5

6

6module Rel8.Generic.Map

7module Rel8.Generic.Map

7 ( GMap

8 ( GMap

9+ , Map

8 )

10 )

9where

11where

10

12

@@ -27,3 +29,21 @@ type family GMap f rep where

27 GMap _ U1 = U1

29 GMap _ U1 = U1

28 GMap f (rep1 :*: rep2) = GMap f rep1 :*: GMap f rep2

30 GMap f (rep1 :*: rep2) = GMap f rep1 :*: GMap f rep2

29 GMap f (K1 i a) = K1 i (Eval (f a))

31 GMap f (K1 i a) = K1 i (Eval (f a))

32+

33+

34+-- | Map a @Type -> Type@ function over the @Type@-kinded type variables in

35+-- of a type constructor.

36+type Map :: (Type -> Exp Type) -> Type -> Type

37+type family Map f a where

38+ Map p (t a b c d e f g) =

39+ t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))

40+ (Eval (p f)) (Eval (p g))

41+ Map p (t a b c d e f) =

42+ t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))

43+ (Eval (p f))

44+ Map p (t a b c d e) =

45+ t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))

46+ Map p (t a b c d) = t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d))

47+ Map p (t a b c) = t (Eval (p a)) (Eval (p b)) (Eval (p c))

48+ Map p (t a b) = t (Eval (p a)) (Eval (p b))

49+ Map p (t a) = t (Eval (p a))

src/Rel8/Schema/Context/Lower.hsnew file+19

@@ -0,0 +1,19 @@

1+{-# language DataKinds #-}

2+{-# language StandaloneKindSignatures #-}

3+{-# language TypeFamilyDependencies #-}

4+

5+module Rel8.Schema.Context.Lower

6+ ( Lower

7+ )

8+where

9+

10+-- base

11+import Data.Kind ( Type )

12+import Prelude ()

13+

14+-- rel8

15+import Rel8.Schema.Kind ( Context )

16+

17+

18+type Lower :: Context -> Type -> Type

19+type family Lower context = f | f -> context

src/Rel8/Schema/Name.hs+9−13

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

10{-# language StandaloneKindSignatures #-}

11{-# language TypeFamilies #-}

12{-# language UndecidableInstances #-}

13−{-# language UndecidableSuperClasses #-}

14

13

15module Rel8.Schema.Name

14module Rel8.Schema.Name

16 ( Name(..)

15 ( Name(..)

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

25

24

26-- rel8

25-- rel8

27import Rel8.Expr ( Expr )

26import Rel8.Expr ( Expr )

27+import Rel8.Schema.Context.Lower ( Lower )

28import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )

29import Rel8.Schema.Null ( Sql )

30import Rel8.Schema.Result ( Result( R ) )

@@ -32,8 +32,9 @@ import Rel8.Schema.Spec ( Spec( Spec ) )

32import Rel8.Table

33 ( Table, Columns, Context, fromColumns, toColumns

34 , FromExprs, fromResult, toResult

35+ , Transpose

35 )

36 )

36−import Rel8.Table.Recontextualize ( Recontextualize )

37+import Rel8.Table.Transpose ( Transposes )

37import Rel8.Type ( DBType )

38import Rel8.Type ( DBType )

38

39

40

@@ -47,6 +48,9 @@ data Name a where

47 N :: { unN :: !(Name a) } -> Name ('Spec a)

48 N :: { unN :: !(Name a) } -> Name ('Spec a)

48

49

50

51+type instance Lower Name = Name

52+

53+

50deriving stock instance Show (Name a)

54deriving stock instance Show (Name a)

51

55

52

56

@@ -58,6 +62,7 @@ instance Sql DBType a => Table Name (Name a) where

58 type Columns (Name a) = HType a

62 type Columns (Name a) = HType a

59 type Context (Name a) = Name

63 type Context (Name a) = Name

60 type FromExprs (Name a) = a

64 type FromExprs (Name a) = a

65+ type Transpose to (Name a) = Lower to a

61

66

62 toColumns a = HType (N a)

67 toColumns a = HType (N a)

63 fromColumns (HType (N a)) = a

68 fromColumns (HType (N a)) = a

@@ -65,17 +70,8 @@ instance Sql DBType a => Table Name (Name a) where

65 fromResult (HType (R a)) = a

70 fromResult (HType (R a)) = a

66

71

67

72

68−instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)

69−

70−

71−instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)

72−

73−

74−instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

75−

76−

77-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for

73-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for

78-- the 'Expr' columns in @b@.

74-- the 'Expr' columns in @b@.

79type Selects :: Type -> Type -> Constraint

75type Selects :: Type -> Type -> Constraint

80−class Recontextualize Name Expr names exprs => Selects names exprs

76+class Transposes Name Expr names exprs => Selects names exprs

81−instance Recontextualize Name Expr names exprs => Selects names exprs

77+instance Transposes Name Expr names exprs => Selects names exprs

src/Rel8/Schema/Result.hs+4−19

@@ -1,25 +1,22 @@

1{-# language DataKinds #-}

2−{-# language EmptyCase #-}

3{-# language GADTs #-}

2{-# language GADTs #-}

4−{-# language LambdaCase #-}

5{-# language NamedFieldPuns #-}

3{-# language NamedFieldPuns #-}

6−{-# language PolyKinds #-}

7{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

8{-# language TypeFamilies #-}

5{-# language TypeFamilies #-}

9

6

10module Rel8.Schema.Result

7module Rel8.Schema.Result

11 ( Result( R, unR )

8 ( Result( R, unR )

12− , NotResult( NotResult ), absurd

13 , null, nullifier, unnullifier

9 , null, nullifier, unnullifier

14 , vectorizer, unvectorizer

10 , vectorizer, unvectorizer

15 )

11 )

16where

12where

17

13

18-- base

14-- base

19−import Data.Kind ( Type )

15+import Data.Functor.Identity ( Identity )

20import Prelude hiding ( null )

16import Prelude hiding ( null )

21

17

22-- rel8

18-- rel8

19+import Rel8.Schema.Context.Lower ( Lower )

23import Rel8.Schema.Kind ( Context )

20import Rel8.Schema.Kind ( Context )

24import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )

21import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )

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

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

@@ -29,24 +26,12 @@ import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

29--

26--

30-- When a query is executed against a PostgreSQL database, Rel8 parses the

27-- When a query is executed against a PostgreSQL database, Rel8 parses the

31-- returned rows, decoding each row into the @Result@ context.

28-- returned rows, decoding each row into the @Result@ context.

32−type Result :: k -> Type

29+type Result :: Context

33data Result a where

30data Result a where

34 R :: { unR :: !a } -> Result ('Spec a)

31 R :: { unR :: !a } -> Result ('Spec a)

35

32

36

33

37−type IsResult :: Context -> Bool

34+type instance Lower Result = Identity

38−type family IsResult context where

39− IsResult Result = 'True

40− IsResult _ = 'False

41−

42−

43−type NotResult :: Context -> Type

44−data NotResult context where

45− NotResult :: IsResult context ~ 'False => NotResult context

46−

47−

48−absurd :: NotResult Result -> a

49−absurd = \case

50

35

51

36

52null :: Result ('Spec (Maybe a))

37null :: Result ('Spec (Maybe a))

src/Rel8/Table.hs+19−20

@@ -14,6 +14,7 @@ module Rel8.Table

14 ( Table

15 ( Columns, Context, fromColumns, toColumns

16 , FromExprs, fromResult, toResult

17+ , Transpose

17 )

18 )

18 , Congruent

19 , Congruent

19 , TTable, TColumns, TContext, TFromExprs

20 , TTable, TColumns, TContext, TFromExprs

@@ -27,7 +28,7 @@ import Prelude hiding ( null )

27

28

28-- rel8

29-- rel8

29import Rel8.FCF ( Eval, Exp )

30import Rel8.FCF ( Eval, Exp )

30−import Rel8.Generic.Map ( GMap )

31+import Rel8.Generic.Map ( GMap, Map )

31import Rel8.Generic.Table.Record

32import Rel8.Generic.Table.Record

32 ( GTable, GColumns, GContext

33 ( GTable, GColumns, GContext

33 , gfromColumns, gtoColumns, gfromResult, gtoResult

34 , gfromColumns, gtoColumns, gfromResult, gtoResult

@@ -52,7 +53,13 @@ import Rel8.Schema.Spec ( KnownSpec )

52-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a

53-- yourself, as anything that's an instance of 'Rel8.Rel8able' is always a

53-- 'Table'.

54-- 'Table'.

54type Table :: K.Context -> Type -> Constraint

55type Table :: K.Context -> Type -> Constraint

56+class

57+ ( HTable (Columns a)

58+ , context ~ Context a

59+ , a ~ Transpose context a

60+ )

55−class (HTable (Columns a), context ~ Context a) => Table context a | a -> context where

61+ => Table context a | a -> context

62+ where

56 -- | The 'HTable' functor that describes the schema of this table.

63 -- | The 'HTable' functor that describes the schema of this table.

57 type Columns a :: K.HTable

64 type Columns a :: K.HTable

58

65

@@ -63,6 +70,9 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

63 -- corresponding Haskell type.

70 -- corresponding Haskell type.

64 type FromExprs a :: Type

71 type FromExprs a :: Type

65

72

73+ type Transpose (context' :: K.Context) a :: Type

74+

75+

66 toColumns :: a -> Columns a context

76 toColumns :: a -> Columns a context

67 fromColumns :: Columns a context -> a

77 fromColumns :: Columns a context -> a

68

78

@@ -71,7 +81,8 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

71

81

72 type Columns a = GColumns TColumns (Rep (Record a))

82 type Columns a = GColumns TColumns (Rep (Record a))

73 type Context a = GContext TContext (Rep (Record a))

83 type Context a = GContext TContext (Rep (Record a))

74− type FromExprs a = DefaultFromExprs a

84+ type FromExprs a = Map TFromExprs a

85+ type Transpose context a = Map (TTranspose context) a

75

86

76 default toColumns ::

87 default toColumns ::

77 ( Generic (Record a)

88 ( Generic (Record a)

@@ -138,23 +149,6 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

138 (\(_ :: proxy x) -> fromResult @(Context x) @x)

149 (\(_ :: proxy x) -> fromResult @(Context x) @x)

139

150

140

151

141−type DefaultFromExprs :: Type -> Type

142−type family DefaultFromExprs a where

143− DefaultFromExprs (t a b c d e f g) =

144− t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)

145− (FromExprs f) (FromExprs g)

146− DefaultFromExprs (t a b c d e f) =

147− t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)

148− (FromExprs f)

149− DefaultFromExprs (t a b c d e) =

150− t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d) (FromExprs e)

151− DefaultFromExprs (t a b c d) =

152− t (FromExprs a) (FromExprs b) (FromExprs c) (FromExprs d)

153− DefaultFromExprs (t a b c) = t (FromExprs a) (FromExprs b) (FromExprs c)

154− DefaultFromExprs (t a b) = t (FromExprs a) (FromExprs b)

155− DefaultFromExprs (t a) = t (FromExprs a)

156−

157−

158data TTable :: K.Context -> Type -> Exp Constraint

152data TTable :: K.Context -> Type -> Exp Constraint

159type instance Eval (TTable context a) = Table context a

153type instance Eval (TTable context a) = Table context a

160

154

@@ -171,11 +165,16 @@ data TFromExprs :: Type -> Exp Type

171type instance Eval (TFromExprs a) = FromExprs a

165type instance Eval (TFromExprs a) = FromExprs a

172

166

173

167

168+data TTranspose :: K.Context -> Type -> Exp Type

169+type instance Eval (TTranspose context a) = Transpose context a

170+

171+

174-- | Any context is trivially a table.

172-- | Any context is trivially a table.

175instance KnownSpec spec => Table context (context spec) where

173instance KnownSpec spec => Table context (context spec) where

176 type Columns (context spec) = HIdentity spec

174 type Columns (context spec) = HIdentity spec

177 type Context (context spec) = context

175 type Context (context spec) = context

178 type FromExprs (context spec) = Result spec

176 type FromExprs (context spec) = Result spec

177+ type Transpose to (context spec) = to spec

179

178

180 toColumns = HIdentity

179 toColumns = HIdentity

181 fromColumns = unHIdentity

180 fromColumns = unHIdentity

src/Rel8/Table/Cols.hs+1−4

@@ -21,7 +21,6 @@ import qualified Rel8.Schema.Kind as K

21import Rel8.Schema.HTable ( HTable )

22import Rel8.Schema.Result ( Result )

23import Rel8.Table ( Table(..) )

24−import Rel8.Table.Recontextualize ( Recontextualize )

25

24

26

25

27type Cols :: K.Context -> K.HTable -> Type

26type Cols :: K.Context -> K.HTable -> Type

@@ -34,6 +33,7 @@ instance (HTable columns, context ~ context') =>

34 type Columns (Cols context columns) = columns

33 type Columns (Cols context columns) = columns

35 type Context (Cols context columns) = context

34 type Context (Cols context columns) = context

36 type FromExprs (Cols context columns) = Cols Result columns

35 type FromExprs (Cols context columns) = Cols Result columns

36+ type Transpose to (Cols context columns) = Cols to columns

37

38 toColumns (Cols a) = a

39 fromColumns = Cols

@@ -42,9 +42,6 @@ instance (HTable columns, context ~ context') =>

42 fromResult = Cols

43

44

45−instance HTable t => Recontextualize from to (Cols from t) (Cols to t)

46−

47−

48fromCols :: Table context a => Cols context (Columns a) -> a

45fromCols :: Table context a => Cols context (Columns a) -> a

49fromCols (Cols a) = fromColumns a

46fromCols (Cols a) = fromColumns a

50

47

src/Rel8/Table/Either.hs+3−10

@@ -49,12 +49,12 @@ import Rel8.Schema.Spec ( Spec( Spec ) )

49import Rel8.Table

50 ( Table, Columns, Context, fromColumns, toColumns

51 , FromExprs, fromResult, toResult

52+ , Transpose

52 )

53 )

53import Rel8.Table.Bool ( bool )

54import Rel8.Table.Bool ( bool )

54import Rel8.Table.Eq ( EqTable, eqTable )

55import Rel8.Table.Eq ( EqTable, eqTable )

55import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )

56import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )

56import Rel8.Table.Ord ( OrdTable, ordTable )

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

57−import Rel8.Table.Recontextualize ( Recontextualize )

58import Rel8.Table.Serialize ( ToExprs )

59import Rel8.Table.Undefined ( undefined )

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

@@ -118,6 +118,8 @@ instance

118 type Columns (EitherTable context a b) = HEitherTable (Columns a) (Columns b)

119 type Context (EitherTable context a b) = Context a

120 type FromExprs (EitherTable context a b) = Either (FromExprs a) (FromExprs b)

121+ type Transpose to (EitherTable context a b) =

122+ EitherTable to (Transpose to a) (Transpose to b)

121

123

122 toColumns EitherTable {tag, left, right} = HEitherTable

124 toColumns EitherTable {tag, left, right} = HEitherTable

123 { htag = hlabel $ HType tag

125 { htag = hlabel $ HType tag

@@ -151,15 +153,6 @@ instance

151 err = error "Either.fromColumns: mismatch between tag and data"

153 err = error "Either.fromColumns: mismatch between tag and data"

152

154

153

155

154−instance

155− ( Reifiable from, from ~ from'

156− , Reifiable to, to ~ to'

157− , Recontextualize from to a1 b1

158− , Recontextualize from to a2 b2

159− )

160− => Recontextualize from to (EitherTable from' a1 a2) (EitherTable to' b1 b2)

161−

162−

163instance (EqTable a, EqTable b, context ~ Expr) =>

156instance (EqTable a, EqTable b, context ~ Expr) =>

164 EqTable (EitherTable context a b)

157 EqTable (EitherTable context a b)

165 where

158 where

src/Rel8/Table/Eq.hs−1

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

11{-# language TypeFamilies #-}

12{-# language TypeOperators #-}

13{-# language UndecidableInstances #-}

14−{-# language UndecidableSuperClasses #-}

15{-# language ViewPatterns #-}

14{-# language ViewPatterns #-}

16

15

17module Rel8.Table.Eq

16module Rel8.Table.Eq

src/Rel8/Table/List.hs+2−5

@@ -34,6 +34,7 @@ import Rel8.Schema.Spec ( SSpec(..) )

34import Rel8.Table

35 ( Table, Context, Columns, fromColumns, toColumns

36 , FromExprs, fromResult, toResult

37+ , Transpose

37 )

38 )

38import Rel8.Table.Alternative

39import Rel8.Table.Alternative

39 ( AltTable, (<|>:)

40 ( AltTable, (<|>:)

@@ -41,7 +42,6 @@ import Rel8.Table.Alternative

41 )

42 )

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

43import Rel8.Table.Eq ( EqTable, eqTable )

43import Rel8.Table.Ord ( OrdTable, ordTable )

44import Rel8.Table.Ord ( OrdTable, ordTable )

44−import Rel8.Table.Recontextualize ( Recontextualize )

45import Rel8.Table.Serialize ( ToExprs )

46

47

@@ -58,6 +58,7 @@ instance (Table context a, context ~ context') =>

58 type Columns (ListTable context a) = HListTable (Columns a)

59 type Context (ListTable context a) = Context a

60 type FromExprs (ListTable context a) = [FromExprs a]

61+ type Transpose to (ListTable context a) = ListTable to (Transpose to a)

61

62

62 fromColumns = ListTable

63 fromColumns = ListTable

63 toColumns (ListTable a) = a

64 toColumns (ListTable a) = a

@@ -65,10 +66,6 @@ instance (Table context a, context ~ context') =>

65 toResult = hvectorize vectorizer . fmap (toResult @_ @a)

66 toResult = hvectorize vectorizer . fmap (toResult @_ @a)

66

67

68

68−instance (Recontextualize from to a b, from ~ from', to ~ to') =>

69− Recontextualize from to (ListTable from' a) (ListTable to' b)

70−

71−

72instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where

69instance (EqTable a, context ~ Expr) => EqTable (ListTable context a) where

73 eqTable =

70 eqTable =

74 hvectorize

71 hvectorize

src/Rel8/Table/Maybe.hs+2−9

@@ -50,6 +50,7 @@ import Rel8.Schema.Spec ( Spec( Spec ) )

50import Rel8.Table

51 ( Table, Columns, Context, fromColumns, toColumns

52 , FromExprs, fromResult, toResult

53+ , Transpose

53 )

54 )

54import Rel8.Table.Alternative

55import Rel8.Table.Alternative

55 ( AltTable, (<|>:)

56 ( AltTable, (<|>:)

@@ -59,7 +60,6 @@ import Rel8.Table.Bool ( bool )

59import Rel8.Table.Eq ( EqTable, eqTable )

60import Rel8.Table.Eq ( EqTable, eqTable )

60import Rel8.Table.Ord ( OrdTable, ordTable )

61import Rel8.Table.Ord ( OrdTable, ordTable )

61import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )

62import Rel8.Table.Nullify ( Nullify, aggregateNullify, guard )

62−import Rel8.Table.Recontextualize ( Recontextualize )

63import Rel8.Table.Serialize ( ToExprs )

64import Rel8.Table.Undefined ( undefined )

65import Rel8.Type ( DBType )

@@ -134,6 +134,7 @@ instance (Table context a, Reifiable context, context ~ context') =>

134 type Columns (MaybeTable context a) = HMaybeTable (Columns a)

135 type Context (MaybeTable context a) = Context a

136 type FromExprs (MaybeTable context a) = Maybe (FromExprs a)

137+ type Transpose to (MaybeTable context a) = MaybeTable to (Transpose to a)

137

138

138 toColumns MaybeTable {tag, just} = HMaybeTable

139 toColumns MaybeTable {tag, just} = HMaybeTable

139 { htag = hlabel $ HIdentity tag

140 { htag = hlabel $ HIdentity tag

@@ -157,14 +158,6 @@ instance (Table context a, Reifiable context, context ~ context') =>

157 err = error "Maybe.fromColumns: mismatch between tag and data"

158 err = error "Maybe.fromColumns: mismatch between tag and data"

158

159

160

160−instance

161− ( Recontextualize from to a b

162− , Reifiable from, from ~ from'

163− , Reifiable to, to ~ to'

164− )

165− => Recontextualize from to (MaybeTable from' a) (MaybeTable to' b)

166−

167−

168instance (EqTable a, context ~ Expr) => EqTable (MaybeTable context a) where

161instance (EqTable a, context ~ Expr) => EqTable (MaybeTable context a) where

169 eqTable = HMaybeTable

162 eqTable = HMaybeTable

170 { htag = hlabel (HType Dict)

163 { htag = hlabel (HType Dict)

src/Rel8/Table/NonEmpty.hs+3−5

@@ -35,11 +35,11 @@ import Rel8.Schema.Spec ( SSpec(..) )

35import Rel8.Table

36 ( Table, Context, Columns, fromColumns, toColumns

37 , FromExprs, fromResult, toResult

38+ , Transpose

38 )

39 )

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

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

40import Rel8.Table.Eq ( EqTable, eqTable )

41import Rel8.Table.Eq ( EqTable, eqTable )

41import Rel8.Table.Ord ( OrdTable, ordTable )

42import Rel8.Table.Ord ( OrdTable, ordTable )

42−import Rel8.Table.Recontextualize ( Recontextualize )

43import Rel8.Table.Serialize ( ToExprs )

44

45

@@ -56,6 +56,8 @@ instance (Table context a, context ~ context') =>

56 type Columns (NonEmptyTable context a) = HNonEmptyTable (Columns a)

57 type Context (NonEmptyTable context a) = Context a

58 type FromExprs (NonEmptyTable context a) = NonEmpty (FromExprs a)

59+ type Transpose to (NonEmptyTable context a) =

60+ NonEmptyTable to (Transpose to a)

59

61

60 fromColumns = NonEmptyTable

62 fromColumns = NonEmptyTable

61 toColumns (NonEmptyTable a) = a

63 toColumns (NonEmptyTable a) = a

@@ -63,10 +65,6 @@ instance (Table context a, context ~ context') =>

63 toResult = hvectorize vectorizer . fmap (toResult @_ @a)

65 toResult = hvectorize vectorizer . fmap (toResult @_ @a)

64

66

65

67

66−instance (Recontextualize from to a b, from ~ from', to ~ to') =>

67− Recontextualize from to (NonEmptyTable from' a) (NonEmptyTable to' b)

68−

69−

70instance (EqTable a, context ~ Expr) =>

68instance (EqTable a, context ~ Expr) =>

71 EqTable (NonEmptyTable context a)

69 EqTable (NonEmptyTable context a)

72 where

70 where

src/Rel8/Table/Nullify.hs+2−9

@@ -46,10 +46,10 @@ import Rel8.Schema.Spec ( Spec( Spec ) )

46import Rel8.Table

47 ( Table, Columns, Context, toColumns, fromColumns

48 , FromExprs, fromResult, toResult

49+ , Transpose

49 )

50 )

50import Rel8.Table.Eq ( EqTable, eqTable )

51import Rel8.Table.Eq ( EqTable, eqTable )

51import Rel8.Table.Ord ( OrdTable, ordTable )

52import Rel8.Table.Ord ( OrdTable, ordTable )

52−import Rel8.Table.Recontextualize ( Recontextualize )

53

54-- semigroupoids

55import Data.Functor.Apply ( Apply, (<.>), liftF2 )

@@ -126,6 +126,7 @@ instance (Table context a, Reifiable context, context ~ context') =>

126 type Columns (Nullify context a) = HNullify (Columns a)

127 type Context (Nullify context a) = Context a

128 type FromExprs (Nullify context a) = Maybe (FromExprs a)

129+ type Transpose to (Nullify context a) = Nullify to (Transpose to a)

129

130

130 fromColumns = case nullifiableOrNot contextSing of

131 fromColumns = case nullifiableOrNot contextSing of

131 Left notNullifiable -> Fields notNullifiable

132 Left notNullifiable -> Fields notNullifiable

@@ -146,14 +147,6 @@ instance (Table context a, Reifiable context, context ~ context') =>

146 fmap (toResult @_ @a)

147 fmap (toResult @_ @a)

147

148

149

149−instance

150− ( Recontextualize from to a b

151− , Reifiable from, from ~ from'

152− , Reifiable to, to ~ to'

153− )

154− => Recontextualize from' to' (Nullify from a) (Nullify to b)

155−

156−

157instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where

150instance (EqTable a, context ~ Expr) => EqTable (Nullify context a) where

158 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)

151 eqTable = hnullify (\_ Dict -> Dict) (eqTable @a)

159

152

src/Rel8/Table/Ord.hs−1

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

10{-# language TypeFamilies #-}

11{-# language TypeOperators #-}

12{-# language UndecidableInstances #-}

13−{-# language UndecidableSuperClasses #-}

14{-# language ViewPatterns #-}

13{-# language ViewPatterns #-}

15

14

16module Rel8.Table.Ord

15module Rel8.Table.Ord

src/Rel8/Table/Recontextualize.hsdeleted−99

@@ -1,99 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language FlexibleInstances #-}

3−{-# language FunctionalDependencies #-}

4−{-# language StandaloneKindSignatures #-}

5−{-# language TypeFamilies #-}

6−{-# language UndecidableInstances #-}

7−{-# language UndecidableSuperClasses #-}

8−

9−module Rel8.Table.Recontextualize

10− ( Recontextualize

11− )

12−where

13−

14−-- base

15−import Data.Kind ( Constraint, Type )

16−import Prelude ()

17−

18−-- rel8

19−import qualified Rel8.Schema.Kind as K

20−import Rel8.Schema.Spec ( KnownSpec )

21−import Rel8.Table ( Table, Congruent )

22−

23−

24−-- | @Recontextualize from to a b@ is evidence that the types @a@ and @b@ are

25−-- related, and that @b@ is the same type as @a@, but after changing the

26−-- context from the initial context @from@, to the new context @to@.

27−type Recontextualize :: K.Context -> K.Context -> Type -> Type -> Constraint

28−class

29− ( Table from a

30− , Table to b

31− , Congruent a b

32− , Recontextualize from from a a

33− , Recontextualize to to b b

34− , Recontextualize to from b a

35− ) => Recontextualize from to a b

36− | a -> from

37− , b -> to

38− , a to -> b

39− , b from -> a

40−

41−

42−instance KnownSpec spec => Recontextualize from to (from spec) (to spec)

43−

44−

45−instance

46− ( Recontextualize from to a1 b1

47− , Recontextualize from to a2 b2

48− )

49− => Recontextualize from to (a1, a2) (b1, b2)

50−

51−

52−instance

53− ( Recontextualize from to a1 b1

54− , Recontextualize from to a2 b2

55− , Recontextualize from to a3 b3

56− )

57− => Recontextualize from to (a1, a2, a3) (b1, b2, b3)

58−

59−

60−instance

61− ( Recontextualize from to a1 b1

62− , Recontextualize from to a2 b2

63− , Recontextualize from to a3 b3

64− , Recontextualize from to a4 b4

65− )

66− => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)

67−

68−

69−instance

70− ( Recontextualize from to a1 b1

71− , Recontextualize from to a2 b2

72− , Recontextualize from to a3 b3

73− , Recontextualize from to a4 b4

74− , Recontextualize from to a5 b5

75− )

76− => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)

77−

78−

79−instance

80− ( Recontextualize from to a1 b1

81− , Recontextualize from to a2 b2

82− , Recontextualize from to a3 b3

83− , Recontextualize from to a4 b4

84− , Recontextualize from to a5 b5

85− , Recontextualize from to a6 b6

86− )

87− => Recontextualize from to (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6)

88−

89−

90−instance

91− ( Recontextualize from to a1 b1

92− , Recontextualize from to a2 b2

93− , Recontextualize from to a3 b3

94− , Recontextualize from to a4 b4

95− , Recontextualize from to a5 b5

96− , Recontextualize from to a6 b6

97− , Recontextualize from to a7 b7

98− )

99− => Recontextualize from to (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7)

src/Rel8/Table/Rel8able.hs+9−17

@@ -31,23 +31,26 @@ import Rel8.Schema.HTable ( HConstrainTable, hdicts )

31import Rel8.Schema.Null ( Sql )

32import Rel8.Schema.Result ( Result )

33import Rel8.Table

34− ( Table, Columns, Context, Congruent, fromColumns, toColumns

34+ ( Table, Columns, Context, fromColumns, toColumns

35 , FromExprs, fromResult, toResult

36+ , Transpose

36 )

37 )

37import Rel8.Schema.Spec.Constrain ( ConstrainSpec )

38import Rel8.Schema.Spec.Constrain ( ConstrainSpec )

38import Rel8.Table.ADT ( ADT )

39import Rel8.Table.ADT ( ADT )

39import Rel8.Table.Eq ( EqTable, eqTable )

40import Rel8.Table.Eq ( EqTable, eqTable )

40import Rel8.Table.Ord ( OrdTable, ordTable )

41import Rel8.Table.Ord ( OrdTable, ordTable )

41−import Rel8.Table.Recontextualize ( Recontextualize )

42import Rel8.Table.Serialize ( ToExprs )

43import Rel8.Type.Eq ( DBEq )

44import Rel8.Type.Ord ( DBOrd )

45

46

47−instance (Rel8able t, Virtual f, f ~ g) => Table f (t g) where

47+instance (Rel8able t, Virtual context, context ~ context') =>

48+ Table context' (t context)

49+ where

48− type Columns (t g) = GColumns t

50+ type Columns (t context) = GColumns t

49− type Context (t g) = g

51+ type Context (t context) = context

50− type FromExprs (t g) = GFromExprs t

52+ type FromExprs (t context) = GFromExprs t

53+ type Transpose to (t context) = t to

51

54

52 fromColumns = gfromColumns virtual

55 fromColumns = gfromColumns virtual

53 toColumns = gtoColumns virtual

56 toColumns = gtoColumns virtual

@@ -55,17 +58,6 @@ instance (Rel8able t, Virtual f, f ~ g) => Table f (t g) where

55 toResult = gtoResult @t

58 toResult = gtoResult @t

56

59

57

60

58−instance

59− ( Rel8able t

60− , Virtual from

61− , Virtual to

62− , Congruent (t from) (t to)

63− , from ~ from'

64− , to ~ to'

65− )

66− => Recontextualize from' to' (t from) (t to)

67−

68−

69instance

61instance

70 ( context ~ Expr

62 ( context ~ Expr

71 , Rel8able t

63 , Rel8able t

src/Rel8/Table/These.hs+3−10

@@ -48,6 +48,7 @@ import Rel8.Schema.Name ( Name )

48import Rel8.Table

49 ( Table, Columns, Context, fromColumns, toColumns

50 , FromExprs, fromResult, toResult

51+ , Transpose

51 )

52 )

52import Rel8.Table.Eq ( EqTable, eqTable )

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

53import Rel8.Table.Maybe

54import Rel8.Table.Maybe

@@ -59,7 +60,6 @@ import Rel8.Table.Maybe

59 )

60 )

60import Rel8.Table.Nullify ( Nullify, guard )

61import Rel8.Table.Nullify ( Nullify, guard )

61import Rel8.Table.Ord ( OrdTable, ordTable )

62import Rel8.Table.Ord ( OrdTable, ordTable )

62−import Rel8.Table.Recontextualize ( Recontextualize )

63import Rel8.Table.Serialize ( ToExprs )

64import Rel8.Table.Undefined ( undefined )

65import Rel8.Type.Tag ( MaybeTag )

@@ -146,6 +146,8 @@ instance

146 type Context (TheseTable context a b) = Context a

147 type FromExprs (TheseTable context a b) =

148 These (FromExprs a) (FromExprs b)

149+ type Transpose to (TheseTable context a b) =

150+ TheseTable to (Transpose to a) (Transpose to b)

149

151

150 toColumns TheseTable {here, there} = HTheseTable

152 toColumns TheseTable {here, there} = HTheseTable

151 { hhereTag = hlabel $ HIdentity $ tag here

153 { hhereTag = hlabel $ HIdentity $ tag here

@@ -202,15 +204,6 @@ instance

202 }

204 }

203

205

204

206

205−instance

206− ( Recontextualize from to a1 b1

207− , Recontextualize from to a2 b2

208− , Reifiable from, from ~ from'

209− , Reifiable to, to ~ to'

210− )

211− => Recontextualize from to (TheseTable from' a1 a2) (TheseTable to' b1 b2)

212−

213−

214instance (EqTable a, EqTable b, context ~ Expr) =>

207instance (EqTable a, EqTable b, context ~ Expr) =>

215 EqTable (TheseTable context a b)

208 EqTable (TheseTable context a b)

216 where

209 where

src/Rel8/Table/Transpose.hsnew file+46

@@ -0,0 +1,46 @@

1+{-# language DataKinds #-}

2+{-# language FlexibleInstances #-}

3+{-# language FunctionalDependencies #-}

4+{-# language StandaloneKindSignatures #-}

5+{-# language TypeFamilies #-}

6+{-# language UndecidableInstances #-}

7+

8+module Rel8.Table.Transpose

9+ ( Transposes

10+ )

11+where

12+

13+-- base

14+import Data.Kind ( Constraint, Type )

15+import Prelude ()

16+

17+-- rel8

18+import qualified Rel8.Schema.Kind as K

19+import Rel8.Table ( Table, Transpose, Congruent )

20+

21+

22+-- | @'Transposes' from to a b@ means that @a@ and @b@ are 'Table's, in the

23+-- @from@ and @to@ contexts respectively, which share the same underlying

24+-- structure. In other words, @b@ is a version of @a@ transposed from the

25+-- @from@ context to the @to@ context (and vice versa).

26+type Transposes :: K.Context -> K.Context -> Type -> Type -> Constraint

27+class

28+ ( Table from a

29+ , Table to b

30+ , Congruent a b

31+ , b ~ Transpose to a

32+ , a ~ Transpose from b

33+ )

34+ => Transposes from to a b

35+ | a -> from

36+ , b -> to

37+ , a to -> b

38+ , b from -> a

39+instance

40+ ( Table from a

41+ , Table to b

42+ , Congruent a b

43+ , b ~ Transpose to a

44+ , a ~ Transpose from b

45+ )

46+ => Transposes from to a b