Get rid of the Spec kind, it can be simplified to just Type (#110)

This is basically the same idea as #92, but we can even further now after #107.

I had thought that this would hinder any future efforts to make Rel8 interoperate with Barbies, but #110 shows that this need not be the case.

rel8.cabal

@@ -114,7 +114,6 @@ library
     Rel8.Query.These
     Rel8.Query.Values
 
-    Rel8.Schema.Context.Lower
     Rel8.Schema.Context.Nullify
     Rel8.Schema.Context.Virtual
     Rel8.Schema.Dict
@@ -135,7 +134,6 @@ library
     Rel8.Schema.Null
     Rel8.Schema.Result
     Rel8.Schema.Spec
-    Rel8.Schema.Spec.Constrain
     Rel8.Schema.Table
 
     Rel8.Statement.Delete

src/Rel8/Aggregate.hs

@@ -1,10 +1,8 @@
 {-# language DataKinds #-}
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
-{-# language GADTs #-}
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
-{-# language PolyKinds #-}
 {-# language RankNTypes #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
@@ -19,6 +17,7 @@ where
 
 -- base
 import Data.Functor.Const ( Const( Const ), getConst )
+import Data.Functor.Identity ( Identity( Identity ) )
 import Data.Kind ( Constraint, Type )
 import Prelude
 
@@ -29,11 +28,9 @@ 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.HTable.Identity ( HIdentity(..) )
+import qualified Rel8.Schema.Kind as K
 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
@@ -48,25 +45,20 @@ import Rel8.Type ( DBType )
 -- @Aggregate@ is almost an 'Applicative' functor - but there is no 'pure'
 -- operation. This means 'Aggregate' is an instance of 'Apply', and you can
 -- combine @Aggregate@s using the @<.>@ combinator.
-type Aggregate :: k -> Type
-data Aggregate a where
-  Aggregate :: forall (a :: Type). !(Opaleye.Aggregator () (Expr a)) -> Aggregate a
-  A :: { unA :: !(Aggregate a) } -> Aggregate ('Spec a)
-
-
-type instance Lower Aggregate = Aggregate
+type Aggregate :: K.Context
+newtype Aggregate a = Aggregate (Opaleye.Aggregator () (Expr a))
 
 
 instance Sql DBType a => Table Aggregate (Aggregate a) where
-  type Columns (Aggregate a) = HType a
+  type Columns (Aggregate a) = HIdentity a
   type Context (Aggregate a) = Aggregate
   type FromExprs (Aggregate a) = a
-  type Transpose to (Aggregate a) = Lower to a
+  type Transpose to (Aggregate a) = to a
 
-  toColumns = HIdentity . A
-  fromColumns (HIdentity (A a)) = a
-  toResult = HIdentity . R
-  fromResult (HIdentity (R a)) = a
+  toColumns = HIdentity
+  fromColumns (HIdentity a) = a
+  toResult = HIdentity . Identity
+  fromResult (HIdentity (Identity a)) = a
 
 
 -- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's

src/Rel8/Column.hs

@@ -15,7 +15,6 @@ import Prelude ()
 -- rel8
 import Rel8.FCF ( Eval, Exp )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Context.Lower ( Lower )
 import Rel8.Schema.Result ( Result )
 
 
@@ -25,7 +24,7 @@ import Rel8.Schema.Result ( Result )
 type Column :: K.Context -> Type -> Type
 type family Column context a where
   Column Result  a = a
-  Column context a = Lower context a
+  Column context a = context a
 
 
 data TColumn :: K.Context -> Type -> Exp Type

src/Rel8/Expr.hs

@@ -1,12 +1,8 @@
 {-# language DataKinds #-}
 {-# language DerivingStrategies #-}
 {-# language FlexibleInstances #-}
-{-# language GADTs #-}
 {-# language MultiParamTypeClasses #-}
-{-# language PolyKinds #-}
-{-# language RoleAnnotations #-}
 {-# language ScopedTypeVariables #-}
-{-# language StandaloneDeriving #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeApplications #-}
 {-# language TypeFamilies #-}
@@ -18,7 +14,7 @@ module Rel8.Expr
 where
 
 -- base
-import Data.Kind ( Type )
+import Data.Functor.Identity ( Identity( Identity ) )
 import Data.String ( IsString, fromString )
 import Prelude hiding ( null )
 
@@ -35,11 +31,9 @@ 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.HTable.Identity ( HIdentity( HIdentity ) )
+import qualified Rel8.Schema.Kind as K
 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
@@ -52,16 +46,9 @@ import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )
 
 
 -- | Typed SQL expressions.
-type Expr :: k -> Type
-data Expr a where
-  Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a
-  E :: { unE :: !(Expr a) } -> Expr ('Spec a)
-
-
-deriving stock instance Show (Expr a)
-
-
-type instance  Lower Expr = Expr
+type Expr :: K.Context
+newtype Expr a = Expr Opaleye.PrimExpr
+  deriving stock Show
 
 
 instance Sql DBSemigroup a => Semigroup (Expr a) where
@@ -126,12 +113,12 @@ instance Sql DBFloating a => Floating (Expr a) where
 
 
 instance Sql DBType a => Table Expr (Expr a) where
-  type Columns (Expr a) = HType a
+  type Columns (Expr a) = HIdentity a
   type Context (Expr a) = Expr
   type FromExprs (Expr a) = a
-  type Transpose to (Expr a) = Lower to a
+  type Transpose to (Expr a) = to a
 
-  toColumns a = HType (E a)
-  fromColumns (HType (E a)) = a
-  toResult a = HType (R a)
-  fromResult (HType (R a)) = a
+  toColumns a = HIdentity a
+  fromColumns (HIdentity a) = a
+  toResult a = HIdentity (Identity a)
+  fromResult (HIdentity (Identity a)) = a

src/Rel8/Expr.hs-boot

@@ -1,8 +1,4 @@
 {-# language DataKinds #-}
-{-# language GADTs #-}
-{-# language PolyKinds #-}
-{-# language RankNTypes #-}
-{-# language RoleAnnotations #-}
 {-# language StandaloneKindSignatures #-}
 
 module Rel8.Expr
@@ -11,16 +7,14 @@ module Rel8.Expr
 where
 
 -- base
-import Data.Kind ( Type )
 import Prelude ()
 
 -- opaleye
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 
-import Rel8.Schema.Spec ( Spec(..) )
+-- rel8
+import Rel8.Schema.Kind ( Context )
 
 
-type Expr :: k -> Type
-data Expr a where
-  Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a
-  E :: { unE :: !(Expr a) } -> Expr ('Spec a)
+type Expr :: Context
+newtype Expr a = Expr Opaleye.PrimExpr

src/Rel8/Generic/Construction.hs

@@ -29,8 +29,8 @@ import GHC.TypeLits ( Symbol )
 import Prelude
 
 -- rel8
-import Rel8.Aggregate ( Aggregate( A, Aggregate ) )
-import Rel8.Expr ( Expr( E ) )
+import Rel8.Aggregate ( Aggregate( Aggregate ) )
+import Rel8.Expr ( Expr )
 import Rel8.Expr.Aggregate ( groupByExpr )
 import Rel8.Expr.Eq ( (==.) )
 import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
@@ -57,11 +57,11 @@ import Rel8.Kind.Algebra
 import qualified Rel8.Kind.Algebra as K
 import Rel8.Schema.Context.Nullify ( sguard, snullify )
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Name ( Name( N, Name ) )
+import Rel8.Schema.Name ( Name( Name ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
-import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
+import Rel8.Schema.Spec ( Spec( Spec, nullity, info ) )
 import Rel8.Table
   ( TTable, TColumns
   , Table, fromColumns, toColumns
@@ -127,11 +127,11 @@ ggbuild gfromColumns = case algebraSing @algebra of
       @name
       @(Eval (rep Expr))
       (const toColumns)
-      (\SSpec {info} -> E (snull info))
-      (\SSpec {nullity} -> case nullity of
+      (\Spec {info} -> snull info)
+      (\Spec {nullity} -> case nullity of
         Null -> id
-        NotNull -> \(E a) -> E (nullify a))
-      (HType . E . litExpr)
+        NotNull -> nullify)
+      (HIdentity . litExpr)
 
 
 type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
@@ -198,11 +198,11 @@ ggconstruct gfromColumns f = case algebraSing @algebra of
       @Expr
       @(Eval (rep Expr))
       (const toColumns)
-      (\SSpec {info} -> E (snull info))
-      (\SSpec {nullity} -> case nullity of
+      (\Spec {info} -> snull info)
+      (\Spec {nullity} -> case nullity of
         Null -> id
-        NotNull -> \(E a) -> E (nullify a))
-      (HType . E . litExpr)
+        NotNull -> nullify)
+      (HIdentity . litExpr)
 
 
 type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type
@@ -230,17 +230,17 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of
   SSum ->
     gctabulate @Id @(Eval (rep Expr)) @r @(a -> r) $ \constructors as ->
       let
-        (HType (E tag), cases) =
+        (HIdentity tag, cases) =
           gdeconstructADT
             @(TTable Expr)
             @TColumns
             @Id
             @Expr
             @(Eval (rep Expr))
             (const fromColumns)
-            (\SSpec {nullity} -> case nullity of
+            (\Spec {nullity} -> case nullity of
               Null -> id
-              NotNull -> \(E a) -> E (unsafeUnnullify a))
+              NotNull -> unsafeUnnullify)
             constructors $
           gtoColumns as
       in
@@ -279,8 +279,8 @@ ggname gfromColumns = case algebraSing @algebra of
       @Name
       @(Eval (rep Name))
       (const toColumns)
-      (\_ _ (N (Name a)) -> N (Name a))
-      (HType (N tag))
+      (\_ _ (Name a) -> Name a)
+      (HIdentity tag)
 
 
 type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
@@ -330,23 +330,23 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
       @Aggregate
       @(Eval (rep Aggregate))
       (const toColumns)
-      (\tag' SSpec {nullity} (A (Aggregate a)) ->
-        A $ Aggregate $ sguard (tag ==. litExpr tag') . snullify nullity <$> a)
-      (HType (A (groupByExpr tag)))
+      (\tag' Spec {nullity} (Aggregate a) ->
+        Aggregate $ sguard (tag ==. litExpr tag') . snullify nullity <$> a)
+      (HIdentity (groupByExpr tag))
     where
       f =
         gfindex @Id @(Eval (rep Expr)) @agg .
         agg .
         gftabulate @Id @(Eval (rep Aggregate)) @agg
-      (HType (E tag), exprs) =
+      (HIdentity tag, exprs) =
         gunbuildADT
           @(TTable Expr)
           @TColumns
           @Id
           @Expr
           @(Eval (rep Expr))
           (const fromColumns)
-          (\SSpec {nullity} -> case nullity of
+          (\Spec {nullity} -> case nullity of
             Null -> id
-            NotNull -> \(E a) -> E (unsafeUnnullify a)) $
+            NotNull -> unsafeUnnullify) $
         gtoColumns es