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.

rel8.cabal

@@ -114,6 +114,7 @@ library
     Rel8.Query.These
     Rel8.Query.Values
 
+    Rel8.Schema.Context.Lower
     Rel8.Schema.Context.Nullify
     Rel8.Schema.Context.Virtual
     Rel8.Schema.Dict
@@ -161,10 +162,10 @@ library
     Rel8.Table.Opaleye
     Rel8.Table.Ord
     Rel8.Table.Order
-    Rel8.Table.Recontextualize
     Rel8.Table.Rel8able
     Rel8.Table.Serialize
     Rel8.Table.These
+    Rel8.Table.Transpose
     Rel8.Table.Undefined
 
     Rel8.Type

src/Rel8.hs

@@ -43,7 +43,7 @@ module Rel8
 
   , Table(..)
   , HTable
-  , Recontextualize
+  , Transposes
   , AltTable((<|>:))
   , AlternativeTable( emptyTable )
   , EqTable, (==:), (/=:)
@@ -342,10 +342,10 @@ import Rel8.Table.Name
 import Rel8.Table.NonEmpty
 import Rel8.Table.Ord
 import Rel8.Table.Order
-import Rel8.Table.Recontextualize
 import Rel8.Table.Rel8able ()
 import Rel8.Table.Serialize
 import Rel8.Table.These
+import Rel8.Table.Transpose
 import Rel8.Type
 import Rel8.Type.Composite
 import Rel8.Type.Eq

src/Rel8/Aggregate.hs

@@ -9,7 +9,6 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}
 
 module Rel8.Aggregate
   ( Aggregate(..), foldInputs, mapInputs
@@ -30,16 +29,17 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr )
+import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
-import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Result ( Result( R ) )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , FromExprs, fromResult, toResult
+  , Transpose
   )
-import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Transpose ( Transposes )
 import Rel8.Type ( DBType )
 
 
@@ -54,42 +54,26 @@ data Aggregate a where
   A :: { unA :: !(Aggregate a) } -> Aggregate ('Spec a)
 
 
+type instance Lower Aggregate = Aggregate
+
+
 instance Sql DBType a => Table Aggregate (Aggregate a) where
   type Columns (Aggregate a) = HType a
   type Context (Aggregate a) = Aggregate
   type FromExprs (Aggregate a) = a
+  type Transpose to (Aggregate a) = Lower to a
 
   toColumns = HIdentity . A
   fromColumns (HIdentity (A a)) = a
   toResult = HIdentity . R
   fromResult (HIdentity (R a)) = a
 
 
-instance Sql DBType a =>
-  Recontextualize Aggregate Aggregate (Aggregate a) (Aggregate a)
-
-
-instance Sql DBType a =>
-  Recontextualize Aggregate Expr (Aggregate a) (Expr a)
-
-
-instance Sql DBType a =>
-  Recontextualize Aggregate Name (Aggregate a) (Name a)
-
-
-instance Sql DBType a =>
-  Recontextualize Expr Aggregate (Expr a) (Aggregate a)
-
-
-instance Sql DBType a =>
-  Recontextualize Name Aggregate (Name a) (Aggregate a)
-
-
 -- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
 -- for the columns in @b@.
 type Aggregates :: Type -> Type -> Constraint
-class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
-instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
+class Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
+instance Transposes Aggregate Expr aggregates exprs => Aggregates aggregates exprs
 
 
 foldInputs :: forall (a :: Type) (b :: Type). Monoid b

src/Rel8/Column.hs

@@ -13,11 +13,9 @@ import Data.Kind ( Type )
 import Prelude ()
 
 -- rel8
-import Rel8.Aggregate ( Aggregate )
-import Rel8.Expr ( Expr )
 import Rel8.FCF ( Eval, Exp )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Name ( Name(..) )
+import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.Result ( Result )
 
 
@@ -26,10 +24,8 @@ import Rel8.Schema.Result ( Result )
 -- 'Rel8able' definitions), and @a@ is the type of the column.
 type Column :: K.Context -> Type -> Type
 type family Column context a where
-  Column Aggregate       a = Aggregate a
-  Column Expr            a = Expr a
-  Column Name            a = Name a
-  Column Result          a = a
+  Column Result  a = a
+  Column context a = Lower context a
 
 
 data TColumn :: K.Context -> Type -> Exp Type

src/Rel8/Expr.hs

@@ -11,9 +11,11 @@
 {-# language TypeApplications #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}
 
-module Rel8.Expr ( Expr(..) ) where
+module Rel8.Expr
+  ( Expr(..)
+  )
+where
 
 -- base
 import Data.Kind ( Type )
@@ -33,15 +35,16 @@ import Rel8.Expr.Opaleye
   , zipPrimExprsWith
   )
 import Rel8.Expr.Serialize ( litExpr )
+import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
 import Rel8.Schema.Result ( Result( R ) )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , FromExprs, fromResult, toResult
+  , Transpose
   )
-import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Type ( DBType )
 import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
 import Rel8.Type.Num ( DBFloating, DBFractional, DBNum )
@@ -58,6 +61,9 @@ data Expr a where
 deriving stock instance Show (Expr a)
 
 
+type instance  Lower Expr = Expr
+
+
 instance Sql DBSemigroup a => Semigroup (Expr a) where
   (<>) = case nullable @a of
     Null -> liftOpNull (<>.)
@@ -123,11 +129,9 @@ instance Sql DBType a => Table Expr (Expr a) where
   type Columns (Expr a) = HType a
   type Context (Expr a) = Expr
   type FromExprs (Expr a) = a
+  type Transpose to (Expr a) = Lower to a
 
   toColumns a = HType (E a)
   fromColumns (HType (E a)) = a
   toResult a = HType (R a)
   fromResult (HType (R a)) = a
-
-
-instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)

src/Rel8/Generic/Map.hs

@@ -2,9 +2,11 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language TypeOperators #-}
+{-# language UndecidableInstances #-}
 
 module Rel8.Generic.Map
   ( GMap
+  , Map
   )
 where
 
@@ -27,3 +29,21 @@ type family GMap f rep where
   GMap _ U1 = U1
   GMap f (rep1 :*: rep2) = GMap f rep1 :*: GMap f rep2
   GMap f (K1 i a) = K1 i (Eval (f a))
+
+
+-- | Map a @Type -> Type@ function over the @Type@-kinded type variables in
+-- of a type constructor.
+type Map :: (Type -> Exp Type) -> Type -> Type
+type family Map f a where
+  Map p (t a b c d e f g) =
+    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))
+      (Eval (p f)) (Eval (p g))
+  Map p (t a b c d e f) =
+    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))
+      (Eval (p f))
+  Map p (t a b c d e) =
+    t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d)) (Eval (p e))
+  Map p (t a b c d) = t (Eval (p a)) (Eval (p b)) (Eval (p c)) (Eval (p d))
+  Map p (t a b c) = t (Eval (p a)) (Eval (p b)) (Eval (p c))
+  Map p (t a b) = t (Eval (p a)) (Eval (p b))
+  Map p (t a) = t (Eval (p a))

src/Rel8/Schema/Context/Lower.hs

@@ -0,0 +1,19 @@
+{-# language DataKinds #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeFamilyDependencies #-}
+
+module Rel8.Schema.Context.Lower
+  ( Lower
+  )
+where
+
+-- base
+import Data.Kind ( Type )
+import Prelude ()
+
+-- rel8
+import Rel8.Schema.Kind ( Context )
+
+
+type Lower :: Context -> Type -> Type
+type family Lower context = f | f -> context

src/Rel8/Schema/Name.hs

@@ -10,7 +10,6 @@
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}
 
 module Rel8.Schema.Name
   ( Name(..)
@@ -25,15 +24,17 @@ import Prelude
 
 -- rel8
 import Rel8.Expr ( Expr )
+import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Result ( Result( R ) )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
   , FromExprs, fromResult, toResult
+  , Transpose
   )
-import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.Transpose ( Transposes )
 import Rel8.Type ( DBType )
 
 
@@ -47,6 +48,9 @@ data Name a where
   N :: { unN :: !(Name a) } -> Name ('Spec a)
 
 
+type instance Lower Name = Name
+
+
 deriving stock instance Show (Name a)
 
 
@@ -58,24 +62,16 @@ instance Sql DBType a => Table Name (Name a) where
   type Columns (Name a) = HType a
   type Context (Name a) = Name
   type FromExprs (Name a) = a
+  type Transpose to (Name a) = Lower to a
 
   toColumns a = HType (N a)
   fromColumns (HType (N a)) = a
   toResult a = HType (R a)
   fromResult (HType (R a)) = a
 
 
-instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
-
-
-instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)
-
-
-instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
-
-
 -- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
 -- the 'Expr' columns in @b@.
 type Selects :: Type -> Type -> Constraint
-class Recontextualize Name Expr names exprs => Selects names exprs
-instance Recontextualize Name Expr names exprs => Selects names exprs
+class Transposes Name Expr names exprs => Selects names exprs
+instance Transposes Name Expr names exprs => Selects names exprs

src/Rel8/Schema/Result.hs

@@ -1,25 +1,22 @@
 {-# language DataKinds #-}
-{-# language EmptyCase #-}
 {-# language GADTs #-}
-{-# language LambdaCase #-}
 {-# language NamedFieldPuns #-}
-{-# language PolyKinds #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 
 module Rel8.Schema.Result
   ( Result( R, unR )
-  , NotResult( NotResult ), absurd
   , null, nullifier, unnullifier
   , vectorizer, unvectorizer
   )
 where
 
 -- base
-import Data.Kind ( Type )
+import Data.Functor.Identity ( Identity )
 import Prelude hiding ( null )
 
 -- rel8
+import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )
 import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
@@ -29,24 +26,12 @@ import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
 --
 -- When a query is executed against a PostgreSQL database, Rel8 parses the
 -- returned rows, decoding each row into the @Result@ context.
-type Result :: k -> Type
+type Result :: Context
 data Result a where
   R :: { unR :: !a } -> Result ('Spec a)
 
 
-type IsResult :: Context -> Bool
-type family IsResult context where
-  IsResult Result = 'True
-  IsResult _ = 'False
-
-
-type NotResult :: Context -> Type
-data NotResult context where
-  NotResult :: IsResult context ~ 'False => NotResult context
-
-
-absurd :: NotResult Result -> a
-absurd = \case
+type instance Lower Result = Identity
 
 
 null :: Result ('Spec (Maybe a))