e0a1851 · rel8 · git.iko.soy

git.iko.soy/rel8

Replace Recontextualize type class with Transpose associated type (#109)

We also add the `Transposes` type class which is a drop-in replacement for `Recontextualize`, but it's no longer necessary to write instances for it; these can all be derived from the `Transpose` associated type which we add to the `Table` class.

commite0a185140e930dbd600074b2e92a656d64ad8bd4 authorShane <shane.obrien@circuithub.com> dateWed 7 Jul 2021, 11:36 (5 years ago) parent89ccf02

22 files changed+168−263

compare with master

unifiedsplit

rel8.cabal+2−1

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

114114 Rel8.Query.These

115115 Rel8.Query.Values

116116

117+ Rel8.Schema.Context.Lower

117118 Rel8.Schema.Context.Nullify

118119 Rel8.Schema.Context.Virtual

119120 Rel8.Schema.Dict

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

161162 Rel8.Table.Opaleye

162163 Rel8.Table.Ord

163164 Rel8.Table.Order

164− Rel8.Table.Recontextualize

165165 Rel8.Table.Rel8able

166166 Rel8.Table.Serialize

167167 Rel8.Table.These

168+ Rel8.Table.Transpose

168169 Rel8.Table.Undefined

169170

170171 Rel8.Type

src/Rel8.hs+2−2

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

4343

4444 , Table(..)

4545 , HTable

46− , Recontextualize

46+ , Transposes

4747 , AltTable((<|>:))

4848 , AlternativeTable( emptyTable )

4949 , EqTable, (==:), (/=:)

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

342342import Rel8.Table.NonEmpty

343343import Rel8.Table.Ord

344344import Rel8.Table.Order

345−import Rel8.Table.Recontextualize

346345import Rel8.Table.Rel8able ()

347346import Rel8.Table.Serialize

348347import Rel8.Table.These

348+import Rel8.Table.Transpose

349349import Rel8.Type

350350import Rel8.Type.Composite

351351import Rel8.Type.Eq

src/Rel8/Aggregate.hs+9−25

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

99{-# language StandaloneKindSignatures #-}

1010{-# language TypeFamilies #-}

1111{-# language UndecidableInstances #-}

12−{-# language UndecidableSuperClasses #-}

1312

1413module Rel8.Aggregate

1514 ( Aggregate(..), foldInputs, mapInputs

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

3029

3130-- rel8

3231import Rel8.Expr ( Expr )

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

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

34−import Rel8.Schema.Name ( Name )

3534import Rel8.Schema.Null ( Sql )

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

3736import Rel8.Schema.Spec ( Spec( Spec ) )

3837import Rel8.Table

3938 ( Table, Columns, Context, fromColumns, toColumns

4039 , FromExprs, fromResult, toResult

40+ , Transpose

4141 )

42−import Rel8.Table.Recontextualize ( Recontextualize )

42+import Rel8.Table.Transpose ( Transposes )

4343import Rel8.Type ( DBType )

4444

4545

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

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

5555

5656

57+type instance Lower Aggregate = Aggregate

58+

59+

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

5861 type Columns (Aggregate a) = HType a

5962 type Context (Aggregate a) = Aggregate

6063 type FromExprs (Aggregate a) = a

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

6165

6266 toColumns = HIdentity . A

6367 fromColumns (HIdentity (A a)) = a

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

6569 fromResult (HIdentity (R a)) = a

6670

6771

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−

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

8973-- for the columns in @b@.

9074type Aggregates :: Type -> Type -> Constraint

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

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

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

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

9377

9478

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

src/Rel8/Column.hs+3−7

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

1313import Prelude ()

1414

1515-- rel8

16−import Rel8.Aggregate ( Aggregate )

17−import Rel8.Expr ( Expr )

1816import Rel8.FCF ( Eval, Exp )

1917import qualified Rel8.Schema.Kind as K

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

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

2119import Rel8.Schema.Result ( Result )

2220

2321

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

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

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

2826type 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

3329

3430

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

src/Rel8/Expr.hs+10−6

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

1111{-# language TypeApplications #-}

1212{-# language TypeFamilies #-}

1313{-# language UndecidableInstances #-}

14−{-# language UndecidableSuperClasses #-}

1514

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

15+module Rel8.Expr

16+ ( Expr(..)

17+ )

18+where

1719

1820-- base

1921import Data.Kind ( Type )

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

3335 , zipPrimExprsWith

3436 )

3537import Rel8.Expr.Serialize ( litExpr )

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

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

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

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

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

4043import Rel8.Table

4144 ( Table, Columns, Context, fromColumns, toColumns

4245 , FromExprs, fromResult, toResult

46+ , Transpose

4347 )

44−import Rel8.Table.Recontextualize ( Recontextualize )

4548import Rel8.Type ( DBType )

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

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

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

5861deriving stock instance Show (Expr a)

5962

6063

64+type instance Lower Expr = Expr

65+

66+

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

6268 (<>) = case nullable @a of

6369 Null -> liftOpNull (<>.)

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

123129 type Columns (Expr a) = HType a

124130 type Context (Expr a) = Expr

125131 type FromExprs (Expr a) = a

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

126133

127134 toColumns a = HType (E a)

128135 fromColumns (HType (E a)) = a

129136 toResult a = HType (R a)

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

22{-# language StandaloneKindSignatures #-}

33{-# language TypeFamilies #-}

44{-# language TypeOperators #-}

5+{-# language UndecidableInstances #-}

67module Rel8.Generic.Map

78 ( GMap

9+ , Map

810 )

911where

1012

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

2729 GMap _ U1 = U1

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

2931 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 #-}

5+module Rel8.Schema.Context.Lower

6+ ( Lower

7+ )

8+where

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

1010{-# language StandaloneKindSignatures #-}

1111{-# language TypeFamilies #-}

1212{-# language UndecidableInstances #-}

13−{-# language UndecidableSuperClasses #-}

1413

1514module Rel8.Schema.Name

1615 ( Name(..)

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

2524

2625-- rel8

2726import Rel8.Expr ( Expr )

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

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

2929import Rel8.Schema.Null ( Sql )

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

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

3232import Rel8.Table

3333 ( Table, Columns, Context, fromColumns, toColumns

3434 , FromExprs, fromResult, toResult

35+ , Transpose

3536 )

36−import Rel8.Table.Recontextualize ( Recontextualize )

37+import Rel8.Table.Transpose ( Transposes )

3738import Rel8.Type ( DBType )

3839

3940

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

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

4849

4950

51+type instance Lower Name = Name

52+

53+

5054deriving stock instance Show (Name a)

5155

5256

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

5862 type Columns (Name a) = HType a

5963 type Context (Name a) = Name

6064 type FromExprs (Name a) = a

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

6166

6267 toColumns a = HType (N a)

6368 fromColumns (HType (N a)) = a

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

6570 fromResult (HType (R a)) = a

6671

6772

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−

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

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

7975type Selects :: Type -> Type -> Constraint

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

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

76+class Transposes 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 @@

11{-# language DataKinds #-}

2−{-# language EmptyCase #-}

32{-# language GADTs #-}

4−{-# language LambdaCase #-}

53{-# language NamedFieldPuns #-}

6−{-# language PolyKinds #-}

74{-# language StandaloneKindSignatures #-}

85{-# language TypeFamilies #-}

107module Rel8.Schema.Result

118 ( Result( R, unR )

12− , NotResult( NotResult ), absurd

139 , null, nullifier, unnullifier

1410 , vectorizer, unvectorizer

1511 )

1612where

1713

1814-- base

19−import Data.Kind ( Type )

15+import Data.Functor.Identity ( Identity )

2016import Prelude hiding ( null )

2117

2218-- rel8

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

2320import Rel8.Schema.Kind ( Context )

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

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

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

2926--

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

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

32−type Result :: k -> Type

29+type Result :: Context

3330data Result a where

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

3532

3633

37−type IsResult :: Context -> Bool

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

34+type instance Lower Result = Identity

5035

5136

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

src/Rel8/Table.hs+19−20

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

1414 ( Table

1515 ( Columns, Context, fromColumns, toColumns

1616 , FromExprs, fromResult, toResult

17+ , Transpose

1718 )

1819 , Congruent

1920 , TTable, TColumns, TContext, TFromExprs

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

2728

2829-- rel8

2930import Rel8.FCF ( Eval, Exp )

30−import Rel8.Generic.Map ( GMap )

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

3132import Rel8.Generic.Table.Record

3233 ( GTable, GColumns, GContext

3334 , gfromColumns, gtoColumns, gfromResult, gtoResult

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

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

5354-- 'Table'.

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

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

56+class

57+ ( HTable (Columns a)

58+ , context ~ Context a

59+ , a ~ Transpose context a

60+ )

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

62+ where

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

5764 type Columns a :: K.HTable

5865

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

6370 -- corresponding Haskell type.

6471 type FromExprs a :: Type

6572

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

74+

75+

6676 toColumns :: a -> Columns a context

6777 fromColumns :: Columns a context -> a

6878

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

7181

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

7383 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

7586

7687 default toColumns ::

7788 ( Generic (Record a)

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

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

139150

140151

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−

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

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

160154

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

171165type instance Eval (TFromExprs a) = FromExprs a

172166

173167

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

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

170+

171+

174172-- | Any context is trivially a table.

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

176174 type Columns (context spec) = HIdentity spec

177175 type Context (context spec) = context

178176 type FromExprs (context spec) = Result spec

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

179178

180179 toColumns = HIdentity

181180 fromColumns = unHIdentity

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

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

2121import Rel8.Schema.HTable ( HTable )

2222import Rel8.Schema.Result ( Result )

2323import Rel8.Table ( Table(..) )

24−import Rel8.Table.Recontextualize ( Recontextualize )

2524

2625

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

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

3433 type Columns (Cols context columns) = columns

3534 type Context (Cols context columns) = context

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

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

3737

3838 toColumns (Cols a) = a

3939 fromColumns = Cols

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

4242 fromResult = Cols

4343

4444

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

46−

47−

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

4946fromCols (Cols a) = fromColumns a

5047

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

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

4949import Rel8.Table

5050 ( Table, Columns, Context, fromColumns, toColumns

5151 , FromExprs, fromResult, toResult

52+ , Transpose

5253 )

5354import Rel8.Table.Bool ( bool )

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

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

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

57−import Rel8.Table.Recontextualize ( Recontextualize )

5858import Rel8.Table.Serialize ( ToExprs )

5959import Rel8.Table.Undefined ( undefined )

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

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

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

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

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

121123

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

123125 { htag = hlabel $ HType tag

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

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

152154

153155

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−

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

164157 EqTable (EitherTable context a b)

165158 where

src/Rel8/Table/Eq.hs−1

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

1111{-# language TypeFamilies #-}

1212{-# language TypeOperators #-}

1313{-# language UndecidableInstances #-}

14−{-# language UndecidableSuperClasses #-}

1514{-# language ViewPatterns #-}

1615

1716module Rel8.Table.Eq

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

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

3434import Rel8.Table

3535 ( Table, Context, Columns, fromColumns, toColumns

3636 , FromExprs, fromResult, toResult

37+ , Transpose

3738 )

3839import Rel8.Table.Alternative

3940 ( AltTable, (<|>:)

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

4142 )

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

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

44−import Rel8.Table.Recontextualize ( Recontextualize )

4545import Rel8.Table.Serialize ( ToExprs )

4646

4747

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

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

5959 type Context (ListTable context a) = Context a

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

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

6162

6263 fromColumns = ListTable

6364 toColumns (ListTable a) = a

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

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

6667

6768

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

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

70−

71−

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

7370 eqTable =

7471 hvectorize

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

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

5050import Rel8.Table

5151 ( Table, Columns, Context, fromColumns, toColumns

5252 , FromExprs, fromResult, toResult

53+ , Transpose

5354 )

5455import Rel8.Table.Alternative

5556 ( AltTable, (<|>:)

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

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

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

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

62−import Rel8.Table.Recontextualize ( Recontextualize )

6363import Rel8.Table.Serialize ( ToExprs )

6464import Rel8.Table.Undefined ( undefined )

6565import Rel8.Type ( DBType )

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

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

135135 type Context (MaybeTable context a) = Context a

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

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

137138

138139 toColumns MaybeTable {tag, just} = HMaybeTable

139140 { htag = hlabel $ HIdentity tag

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

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

158159

159160

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−

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

169162 eqTable = HMaybeTable

170163 { htag = hlabel (HType Dict)

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

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

3535import Rel8.Table

3636 ( Table, Context, Columns, fromColumns, toColumns

3737 , FromExprs, fromResult, toResult

38+ , Transpose

3839 )

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

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

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

42−import Rel8.Table.Recontextualize ( Recontextualize )

4343import Rel8.Table.Serialize ( ToExprs )

4444

4545

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

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

5757 type Context (NonEmptyTable context a) = Context a

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

59+ type Transpose to (NonEmptyTable context a) =

60+ NonEmptyTable to (Transpose to a)

5961

6062 fromColumns = NonEmptyTable

6163 toColumns (NonEmptyTable a) = a

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

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

6466

6567

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

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

68−

69−

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

7169 EqTable (NonEmptyTable context a)

7270 where

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

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

4646import Rel8.Table

4747 ( Table, Columns, Context, toColumns, fromColumns

4848 , FromExprs, fromResult, toResult

49+ , Transpose

4950 )

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

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

52−import Rel8.Table.Recontextualize ( Recontextualize )

5353

5454-- semigroupoids

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

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

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

127127 type Context (Nullify context a) = Context a

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

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

129130

130131 fromColumns = case nullifiableOrNot contextSing of

131132 Left notNullifiable -> Fields notNullifiable

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

146147 fmap (toResult @_ @a)

147148

148149

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−

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

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

159152

src/Rel8/Table/Ord.hs−1

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

1010{-# language TypeFamilies #-}

1111{-# language TypeOperators #-}

1212{-# language UndecidableInstances #-}

13−{-# language UndecidableSuperClasses #-}

1413{-# language ViewPatterns #-}

1514

1615module 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 )

3131import Rel8.Schema.Null ( Sql )

3232import Rel8.Schema.Result ( Result )

3333import Rel8.Table

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

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

3535 , FromExprs, fromResult, toResult

36+ , Transpose

3637 )

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

3839import Rel8.Table.ADT ( ADT )

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

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

41−import Rel8.Table.Recontextualize ( Recontextualize )

4242import Rel8.Table.Serialize ( ToExprs )

4343import Rel8.Type.Eq ( DBEq )

4444import Rel8.Type.Ord ( DBOrd )

4545

4646

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

48− type Columns (t g) = GColumns t

49− type Context (t g) = g

50− type FromExprs (t g) = GFromExprs t

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

48+ Table context' (t context)

49+ where

50+ type Columns (t context) = GColumns t

51+ type Context (t context) = context

52+ type FromExprs (t context) = GFromExprs t

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

5154

5255 fromColumns = gfromColumns virtual

5356 toColumns = gtoColumns virtual

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

5558 toResult = gtoResult @t

5659

5760

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−

6961instance

7062 ( context ~ Expr

7163 , Rel8able t

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

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

4848import Rel8.Table

4949 ( Table, Columns, Context, fromColumns, toColumns

5050 , FromExprs, fromResult, toResult

51+ , Transpose

5152 )

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

5354import Rel8.Table.Maybe

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

5960 )

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

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

62−import Rel8.Table.Recontextualize ( Recontextualize )

6363import Rel8.Table.Serialize ( ToExprs )

6464import Rel8.Table.Undefined ( undefined )

6565import Rel8.Type.Tag ( MaybeTag )

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

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

147147 type FromExprs (TheseTable context a b) =

148148 These (FromExprs a) (FromExprs b)

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

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

149151

150152 toColumns TheseTable {here, there} = HTheseTable

151153 { hhereTag = hlabel $ HIdentity $ tag here

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

202204 }

203205

204206

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−

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

215208 EqTable (TheseTable context a b)

216209 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 #-}

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