Remove Interpretation and Col (#107)

This commit removes the `Interpretation` type class and - by extension - the associated `Col` newtype. We were doing this because we want to use things like `Expr` with `Type`s (e.g., `Expr Bool`), but also use `Expr`s with `Spec`s (e.g., `Col Expr ('Spec Bool)`). I realised that we don't need to jump through `Col` to do this, we can take advantage of `Expr`s polymorphic kind. This essentially means moving the constructors in `Col` directly into the associated contexts.

With this done, we no longer need to distinguish between a `HContext` and `Context`, so we drop `HContext` and change `Context` to be `Spec -> Type`. A consequence of this is that `KRel8able` changes to be `(Spec -> Type) -> Type`, which is direct conflict with `HTable` - so only one of these can be `Table`s. We choose `Rel8able` to win, and add `Cols` to treat any `HTable` as a `Table` (thus allowing any `htable f` to be a `Table f`).

rel8.cabal

@@ -114,7 +114,6 @@ library
     Rel8.Query.These
     Rel8.Query.Values
 
-    Rel8.Schema.Context
     Rel8.Schema.Context.Nullify
     Rel8.Schema.Context.Virtual
     Rel8.Schema.Dict
@@ -150,6 +149,7 @@ library
     Rel8.Table.Aggregate
     Rel8.Table.Alternative
     Rel8.Table.Bool
+    Rel8.Table.Cols
     Rel8.Table.Either
     Rel8.Table.Eq
     Rel8.Table.HKD

src/Rel8/Aggregate.hs

@@ -5,6 +5,7 @@
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
 {-# language PolyKinds #-}
+{-# language RankNTypes #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
@@ -14,7 +15,6 @@ module Rel8.Aggregate
   ( Aggregate(..), foldInputs, mapInputs
   , Aggregator(..), unsafeMakeAggregate
   , Aggregates
-  , Col( A, unA )
   )
 where
 
@@ -30,11 +30,10 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 
 -- rel8
 import Rel8.Expr ( Expr )
-import Rel8.Schema.Context ( Interpretation(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Sql )
-import Rel8.Schema.Result ( Col( R ) )
+import Rel8.Schema.Result ( Result( R ) )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
@@ -51,14 +50,8 @@ import Rel8.Type ( DBType )
 -- combine @Aggregate@s using the @<.>@ combinator.
 type Aggregate :: k -> Type
 data Aggregate a where
-  Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a
-
-
-instance Interpretation Aggregate where
-  data Col Aggregate _spec where
-    A :: ()
-      => { unA :: !(Aggregate a) }
-      -> Col Aggregate ('Spec a)
+  Aggregate :: forall (a :: Type). !(Opaleye.Aggregator () (Expr a)) -> Aggregate a
+  A :: { unA :: !(Aggregate a) } -> Aggregate ('Spec a)
 
 
 instance Sql DBType a => Table Aggregate (Aggregate a) where
@@ -99,7 +92,7 @@ class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates e
 instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
 
 
-foldInputs :: Monoid b
+foldInputs :: forall (a :: Type) (b :: Type). Monoid b
   => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
 foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
   getConst $ flip agg () $ \(aggregator, a) ->
@@ -109,7 +102,7 @@ foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
       Aggregator {operation, ordering, distinction}
 
 
-mapInputs :: ()
+mapInputs :: forall (a :: Type). ()
   => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a
 mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
   Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->
@@ -124,7 +117,7 @@ data Aggregator = Aggregator
   }
 
 
-unsafeMakeAggregate :: ()
+unsafeMakeAggregate :: forall (input :: Type) (output :: Type). ()
   => (Expr input -> Opaleye.PrimExpr)
   -> (Opaleye.PrimExpr -> Expr output)
   -> Maybe Aggregator

src/Rel8/Expr.hs

@@ -13,11 +13,7 @@
 {-# language UndecidableInstances #-}
 {-# language UndecidableSuperClasses #-}
 
-module Rel8.Expr
-  ( Expr(..)
-  , Col( E, unE )
-  )
-where
+module Rel8.Expr ( Expr(..) ) where
 
 -- base
 import Data.Kind ( Type )
@@ -37,10 +33,9 @@ import Rel8.Expr.Opaleye
   , zipPrimExprsWith
   )
 import Rel8.Expr.Serialize ( litExpr )
-import Rel8.Schema.Context ( Interpretation, Col )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
-import Rel8.Schema.Result ( Col( R ) )
+import Rel8.Schema.Result ( Result( R ) )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
   ( Table, Columns, Context, fromColumns, toColumns
@@ -54,10 +49,10 @@ import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
 
 
 -- | Typed SQL expressions.
-type role Expr representational
 type Expr :: k -> Type
 data Expr a where
-  Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)
+  Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a
+  E :: { unE :: !(Expr a) } -> Expr ('Spec a)
 
 
 deriving stock instance Show (Expr a)
@@ -124,11 +119,6 @@ instance Sql DBFloating a => Floating (Expr a) where
   atanh = function "atanh"
 
 
-instance Interpretation Expr where
-  data Col Expr _spec where
-    E :: {unE :: !(Expr a)} -> Col Expr ('Spec a)
-
-
 instance Sql DBType a => Table Expr (Expr a) where
   type Columns (Expr a) = HType a
   type Context (Expr a) = Expr

src/Rel8/Expr.hs-boot

@@ -1,5 +1,7 @@
+{-# language DataKinds #-}
 {-# language GADTs #-}
 {-# language PolyKinds #-}
+{-# language RankNTypes #-}
 {-# language RoleAnnotations #-}
 {-# language StandaloneKindSignatures #-}
 
@@ -15,8 +17,10 @@ import Prelude ()
 -- opaleye
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
+import Rel8.Schema.Spec ( Spec(..) )
+
 
-type role Expr representational
 type Expr :: k -> Type
 data Expr a where
-  Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)
+  Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a
+  E :: { unE :: !(Expr a) } -> Expr ('Spec a)

src/Rel8/Generic/Construction.hs

@@ -29,8 +29,8 @@ import GHC.TypeLits ( Symbol )
 import Prelude
 
 -- rel8
-import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ) )
-import Rel8.Expr ( Col( E ), Expr )
+import Rel8.Aggregate ( Aggregate( A, Aggregate ) )
+import Rel8.Expr ( Expr( E ) )
 import Rel8.Expr.Aggregate ( groupByExpr )
 import Rel8.Expr.Eq ( (==.) )
 import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
@@ -59,7 +59,7 @@ import Rel8.Schema.Context.Nullify ( sguard, snullify )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Name ( Col( N ), Name( Name ) )
+import Rel8.Schema.Name ( Name( N, Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
 import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
 import Rel8.Table
@@ -86,11 +86,11 @@ type family GGBuildable' algebra name rep where
   GGBuildable' 'K.Product name rep =
     ( name ~ GConstructor (Eval (rep Expr))
     , Representable Id (Eval (rep Expr))
-    , GConstructable (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))
+    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))
     )
   GGBuildable' 'K.Sum name rep =
     ( Representable Id (GConstructorADT name (Eval (rep Expr)))
-    , GMakeableADT (TTable Expr) TColumns Id (Col Expr) name (Eval (rep Expr))
+    , GMakeableADT (TTable Expr) TColumns Id Expr name (Eval (rep Expr))
     )
 
 
@@ -103,7 +103,7 @@ type family GGBuild algebra name rep r where
 
 
 ggbuild :: forall algebra name rep a. GGBuildable algebra name rep
-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr) -> a)
+  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
   -> GGBuild algebra name rep a
 ggbuild gfromColumns = case algebraSing @algebra of
   SProduct ->
@@ -113,7 +113,7 @@ ggbuild gfromColumns = case algebraSing @algebra of
       @(TTable Expr)
       @TColumns
       @Id
-      @(Col Expr)
+      @Expr
       @(Eval (rep Expr))
       (const toColumns)
   SSum ->
@@ -123,7 +123,7 @@ ggbuild gfromColumns = case algebraSing @algebra of
       @(TTable Expr)
       @TColumns
       @Id
-      @(Col Expr)
+      @Expr
       @name
       @(Eval (rep Expr))
       (const toColumns)
@@ -151,19 +151,19 @@ type family GGConstructable' algebra rep where
     ( Representable Id (Eval (rep Aggregate))
     , Representable Id (Eval (rep Expr))
     , Representable Id (Eval (rep Name))
-    , GConstructable (TTable Aggregate) TColumns Id (Col Aggregate) (Eval (rep Aggregate))
-    , GConstructable (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))
-    , GConstructable (TTable Name) TColumns Id (Col Name) (Eval (rep Name))
+    , GConstructable (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))
+    , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))
+    , GConstructable (TTable Name) TColumns Id Name (Eval (rep Name))
     )
   GGConstructable' 'K.Sum rep =
     ( RepresentableConstructors Id (Eval (rep Expr))
     , RepresentableFields Id (Eval (rep Aggregate))
     , RepresentableFields Id (Eval (rep Expr))
     , RepresentableFields Id (Eval (rep Name))
     , Functor (GConstructors Id (Eval (rep Expr)))
-    , GConstructableADT (TTable Aggregate) TColumns Id (Col Aggregate) (Eval (rep Aggregate))
-    , GConstructableADT (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))
-    , GConstructableADT (TTable Name) TColumns Id (Col Name) (Eval (rep Name))
+    , GConstructableADT (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))
+    , GConstructableADT (TTable Expr) TColumns Id Expr (Eval (rep Expr))
+    , GConstructableADT (TTable Name) TColumns Id Name (Eval (rep Name))
     )
 
 
@@ -174,7 +174,7 @@ type family GGConstruct algebra rep r where
 
 
 ggconstruct :: forall algebra rep a. GGConstructable algebra rep
-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr) -> a)
+  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)
   -> GGConstruct algebra rep a -> a
 ggconstruct gfromColumns f = case algebraSing @algebra of
   SProduct ->
@@ -185,7 +185,7 @@ ggconstruct gfromColumns f = case algebraSing @algebra of
       @(TTable Expr)
       @TColumns
       @Id
-      @(Col Expr)
+      @Expr
       @(Eval (rep Expr))
       (const toColumns)
   SSum ->
@@ -195,7 +195,7 @@ ggconstruct gfromColumns f = case algebraSing @algebra of
       @(TTable Expr)
       @TColumns
       @Id
-      @(Col Expr)
+      @Expr
       @(Eval (rep Expr))
       (const toColumns)
       (\SSpec {info} -> E (snull info))
@@ -214,7 +214,7 @@ type family GGDeconstruct algebra rep a r where
 
 
 ggdeconstruct :: forall algebra rep a r. (GGConstructable algebra rep, Table Expr r)
-  => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr))
+  => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
   -> GGDeconstruct algebra rep a r
 ggdeconstruct gtoColumns = case algebraSing @algebra of
   SProduct -> \build ->
@@ -223,7 +223,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of
       @(TTable Expr)
       @TColumns
       @Id
-      @(Col Expr)
+      @Expr
       @(Eval (rep Expr))
       (const fromColumns) .
     gtoColumns
@@ -235,7 +235,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of
             @(TTable Expr)
             @TColumns
             @Id
-            @(Col Expr)
+            @Expr
             @(Eval (rep Expr))
             (const fromColumns)
             (\SSpec {nullity} -> case nullity of
@@ -256,7 +256,7 @@ type family GGName algebra rep a where
 
 
 ggname :: forall algebra rep a. GGConstructable algebra rep
-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Name) -> a)
+  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)
   -> GGName algebra rep a
 ggname gfromColumns = case algebraSing @algebra of
   SProduct ->
@@ -266,7 +266,7 @@ ggname gfromColumns = case algebraSing @algebra of
       @(TTable Name)
       @TColumns
       @Id
-      @(Col Name)
+      @Name
       @(Eval (rep Name))
       (const toColumns)
   SSum -> \tag ->
@@ -276,7 +276,7 @@ ggname gfromColumns = case algebraSing @algebra of
       @(TTable Name)
       @TColumns
       @Id
-      @(Col Name)
+      @Name
       @(Eval (rep Name))
       (const toColumns)
       (\_ _ (N (Name a)) -> N (Name a))
@@ -294,8 +294,8 @@ type family GGAggregate algebra rep r where
 
 
 ggaggregate :: forall algebra rep exprs agg. GGConstructable algebra rep
-  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Aggregate) -> agg)
-  -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr))
+  => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate -> agg)
+  -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)
   -> GGAggregate algebra rep agg -> exprs -> agg
 ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
   SProduct -> flip f exprs $
@@ -304,7 +304,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
       @(TTable Aggregate)
       @TColumns
       @Id
-      @(Col Aggregate)
+      @Aggregate
       @(Eval (rep Aggregate))
       (const toColumns)
     where
@@ -317,7 +317,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
           @(TTable Expr)
           @TColumns
           @Id
-          @(Col Expr)
+          @Expr
           @(Eval (rep Expr))
           (const fromColumns) $
         gtoColumns es
@@ -327,7 +327,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
       @(TTable Aggregate)
       @TColumns
       @Id
-      @(Col Aggregate)
+      @Aggregate
       @(Eval (rep Aggregate))
       (const toColumns)
       (\tag' SSpec {nullity} (A (Aggregate a)) ->
@@ -343,7 +343,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
           @(TTable Expr)
           @TColumns
           @Id
-          @(Col Expr)
+          @Expr
           @(Eval (rep Expr))
           (const fromColumns)
           (\SSpec {nullity} -> case nullity of