Make Rel8able have kind ((X -> Type) -> Type) -> Constraint

Previous it was `((Type -> Type) -> Type) -> Constraint`. The problem is this clashes with things like `HKD` from `higgledy`. We can use GADTs and PolyKinds hacks to get around this while mostly retaining the same API. The only major difference is we use `Result` in places where we used `Identity` before.
2024-09-11 16:05:41 +03:00 · 2021-04-15 17:00:12 +01:00 · 2021-04-15 17:00:12 +01:00 · 04fdf2732d
commit 04fdf2732d
parent f6a9c968e4
24 changed files with 258 additions and 220 deletions
--- a/rel8.cabal
+++ b/rel8.cabal
@ -113,6 +113,7 @@ library
    Rel8.Schema.Kind
    Rel8.Schema.Name
    Rel8.Schema.Null
+    Rel8.Schema.Result
    Rel8.Schema.Spec
    Rel8.Schema.Spec.ConstrainDBType
    Rel8.Schema.Spec.ConstrainType
--- a/src/Rel8.hs
+++ b/src/Rel8.hs
@ -235,6 +235,7 @@ module Rel8
  , Labelable
  , ToExprs(..)
  , FromExprs
+  , Result
  ) where

 -- base
@ -277,6 +278,7 @@ import Rel8.Schema.Generic
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )
+import Rel8.Schema.Result
 import Rel8.Schema.Table
 import Rel8.Statement.Delete
 import Rel8.Statement.Insert
--- a/src/Rel8/Aggregate.hs
+++ b/src/Rel8/Aggregate.hs
@ -3,9 +3,9 @@
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language GADTs #-}
-{-# language GeneralizedNewtypeDeriving #-}
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
+{-# language PolyKinds #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
@ -37,13 +37,14 @@ import Rel8.Schema.Context.Label ( Labelable(..) )
 import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Type ( DBType )

 -- semigroupoids
-import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
+import Data.Functor.Apply ( Apply, (<.>) )


 -- | An @Aggregate a@ describes how to aggregate @Table@s of type @a@. You can
@ -51,10 +52,17 @@ import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
 -- @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 :: Type -> Type
-newtype Aggregate a = Aggregate (Opaleye.Aggregator () a)
-  deriving newtype Functor
-  deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))
+type Aggregate :: k -> Type
+data Aggregate a where
+  Aggregate :: !(Opaleye.Aggregator () a) -> Aggregate a
+
+
+instance Functor Aggregate where
+  fmap f (Aggregate a) = Aggregate (fmap f a)
+
+
+instance Apply Aggregate where
+  Aggregate f <.> Aggregate a = Aggregate (f <*> a)


 instance Interpretation Aggregate where
@ -84,7 +92,7 @@ instance Sql DBType a =>


 instance Sql DBType a =>
-  Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)
+  Recontextualize Aggregate Result (Aggregate (Expr a)) (Identity a)


 instance Sql DBType a =>
@ -96,7 +104,7 @@ instance Sql DBType a =>


 instance Sql DBType a =>
-  Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))
+  Recontextualize Result Aggregate (Identity a) (Aggregate (Expr a))


 instance Sql DBType a =>
--- a/src/Rel8/Expr.hs
+++ b/src/Rel8/Expr.hs
@ -3,8 +3,10 @@
 {-# language FlexibleInstances #-}
 {-# language GADTs #-}
 {-# language MultiParamTypeClasses #-}
+{-# language PolyKinds #-}
 {-# language RoleAnnotations #-}
 {-# language ScopedTypeVariables #-}
+{-# language StandaloneDeriving #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeApplications #-}
 {-# language TypeFamilies #-}
@ -39,6 +41,7 @@ import Rel8.Schema.Context ( Interpretation, Col )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable.Type ( HType( HType ) )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Recontextualize ( Recontextualize )
@ -50,9 +53,12 @@ import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )

 -- | Typed SQL expressions.
 type role Expr representational
-type Expr :: Type -> Type
-newtype Expr a = Expr Opaleye.PrimExpr
-  deriving stock Show
+type Expr :: k -> Type
+data Expr a where
+  Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)
+
+
+deriving stock instance Show (Expr a)


 instance Sql DBSemigroup a => Semigroup (Expr a) where
@ -111,10 +117,10 @@ instance Sql DBType a => Table Expr (Expr a) where
 instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)


-instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)
+instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)


-instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)
+instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)


 instance Labelable Expr where
--- a/src/Rel8/Expr.hs-boot
+++ b/src/Rel8/Expr.hs-boot
@ -1,3 +1,5 @@
+{-# language GADTs #-}
+{-# language PolyKinds #-}
 {-# language RoleAnnotations #-}
 {-# language StandaloneKindSignatures #-}

@ -15,5 +17,6 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye


 type role Expr representational
-type Expr :: Type -> Type
-newtype Expr a = Expr Opaleye.PrimExpr
+type Expr :: k -> Type
+data Expr a where
+  Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)
--- a/src/Rel8/Expr/Bool.hs
+++ b/src/Rel8/Expr/Bool.hs
@ -1,3 +1,5 @@
+{-# language GADTs #-}
+
 module Rel8.Expr.Bool
  ( false, true
  , (&&.), (||.), not_
@ -17,7 +19,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

 -- rel8
 import {-# SOURCE #-} Rel8.Expr ( Expr( Expr ) )
-import Rel8.Expr.Opaleye ( mapPrimExpr, zipPrimExprsWith )
+import Rel8.Expr.Opaleye ( mapPrimExpr, toPrimExpr, zipPrimExprsWith )
 import Rel8.Expr.Serialize ( litExpr )


@ -75,7 +77,7 @@ caseExpr :: [(Expr Bool, Expr a)] -> Expr a -> Expr a
 caseExpr branches (Expr fallback) =
  Expr $ Opaleye.CaseExpr (map go branches) fallback
  where
-    go (Expr condition, Expr value) = (condition, value)
+    go (condition, value) = (toPrimExpr condition, toPrimExpr value)


 -- | Convert a @Expr (Maybe Bool)@ to a @Expr Bool@ by treating @Nothing@ as
--- a/src/Rel8/Expr/Null.hs
+++ b/src/Rel8/Expr/Null.hs
@ -78,6 +78,7 @@ liftOpNull :: DBType c
 liftOpNull f ma mb =
  boolExpr (unsafeLiftOpNull f ma mb) null
    (isNull ma ||. isNull mb)
+{-# INLINABLE liftOpNull #-}


 snull :: TypeInformation a -> Expr (Maybe a)
--- a/src/Rel8/Expr/Ord.hs
+++ b/src/Rel8/Expr/Ord.hs
@ -23,7 +23,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 import Rel8.Expr ( Expr( Expr ) )
 import Rel8.Expr.Bool ( (&&.), (||.), coalesce )
 import Rel8.Expr.Null ( isNull, isNonNull, nullable, unsafeLiftOpNull )
-import Rel8.Expr.Opaleye ( zipPrimExprsWith )
+import Rel8.Expr.Opaleye ( toPrimExpr, zipPrimExprsWith )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql )
 import qualified Rel8.Schema.Null as Schema ( nullable )
 import Rel8.Type.Ord ( DBOrd )
@ -122,7 +122,7 @@ leastExpr ma mb = case Schema.nullable @a of
  Null -> nullable ma (\a -> nullable mb (least_ a) mb) ma
  NotNull -> least_ ma mb
  where
-    least_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "LEAST" [a, b])
+    least_ a b = Expr (Opaleye.FunExpr "LEAST" [toPrimExpr a, toPrimExpr b])


 -- | Given two expressions, return the expression that sorts greater than the
@ -134,4 +134,5 @@ greatestExpr ma mb = case Schema.nullable @a of
  Null -> nullable mb (\a -> nullable ma (greatest_ a) mb) ma
  NotNull -> greatest_ ma mb
  where
-    greatest_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "GREATEST" [a, b])
+    greatest_ a b =
+      Expr (Opaleye.FunExpr "GREATEST" [toPrimExpr a, toPrimExpr b])
--- a/src/Rel8/Schema/Context.hs
+++ b/src/Rel8/Schema/Context.hs
@ -9,12 +9,12 @@ module Rel8.Schema.Context
 where

 -- base
-import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint )
 import Prelude ()

 -- rel8
 import Rel8.Schema.Kind ( Context, HContext )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( Spec( Spec ) )


@ -23,6 +23,6 @@ class Interpretation context where
  data Col context :: HContext


-instance Interpretation Identity where
-  data Col Identity _spec where
-    Result :: a -> Col Identity ('Spec labels necessity a)
+instance Interpretation Result where
+  data Col Result _spec where
+    Result :: a -> Col Result ('Spec labels necessity a)
--- a/src/Rel8/Schema/Context/Label.hs
+++ b/src/Rel8/Schema/Context/Label.hs
@ -11,7 +11,6 @@ module Rel8.Schema.Context.Label
 where

 -- base
-import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint )
 import Prelude hiding ( null )

@ -20,6 +19,7 @@ import Rel8.Schema.Context ( Interpretation, Col(..) )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.Kind ( Context, HContext )
 import Rel8.Schema.Spec ( Spec( Spec ) )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )


@ -34,7 +34,7 @@ class Interpretation context => Labelable context where
    -> Col context ('Spec labels necessity a)


-instance Labelable Identity where
+instance Labelable Result where
  labeler (Result a) = Result a
  unlabeler (Result a) = Result a

--- a/src/Rel8/Schema/Field.hs
+++ b/src/Rel8/Schema/Field.hs
@ -19,7 +19,6 @@ where

 -- base
 import Data.Bifunctor ( Bifunctor, bimap )
-import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint, Type )
 import Data.List.NonEmpty ( NonEmpty )
 import Prelude
@ -45,6 +44,7 @@ import Rel8.Schema.Insert ( Insert, Col(..) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name(..), Col(..) )
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
@ -65,12 +65,12 @@ import Data.These ( These )
 type Field :: K.Context -> Necessity -> Type -> Type
 type family Field context necessity a where
  Field (Reify context) necessity  a = AField context necessity a
-  Field Identity        _necessity a = a
+  Field Aggregate       _necessity a = Aggregate (Expr a)
  Field Expr            _necessity a = Expr a
  Field Insert          'Required  a = Expr a
  Field Insert          'Optional  a = Maybe (Expr a)
-  Field Aggregate       _necessity a = Aggregate (Expr a)
-  Field context         _necessity a = context a
+  Field Name            _necessity a = Name a
+  Field Result          _necessity a = a


 type HEither :: K.Context -> Type -> Type -> Type
@ -78,10 +78,9 @@ type family HEither context where
  HEither (Reify context) = AHEither context
  HEither Aggregate = EitherTable
  HEither Expr = EitherTable
-  HEither Identity = Either
  HEither Insert = EitherTable
  HEither Name = EitherTable
-  HEither _ = Either
+  HEither Result = Either


 type HList :: K.Context -> Type -> Type
@ -89,10 +88,9 @@ type family HList context where
  HList (Reify context) = AHList context
  HList Aggregate = ListTable
  HList Expr = ListTable
-  HList Identity = []
  HList Insert = ListTable
  HList Name = ListTable
-  HList _ = []
+  HList Result = []


 type HMaybe :: K.Context -> Type -> Type
@ -100,10 +98,9 @@ type family HMaybe context where
  HMaybe (Reify context) = AHMaybe context
  HMaybe Aggregate = MaybeTable
  HMaybe Expr = MaybeTable
-  HMaybe Identity = Maybe
  HMaybe Insert = MaybeTable
  HMaybe Name = MaybeTable
-  HMaybe _ = Maybe
+  HMaybe Result = Maybe


 type HNonEmpty :: K.Context -> Type -> Type
@ -111,10 +108,9 @@ type family HNonEmpty context where
  HNonEmpty (Reify context) = AHNonEmpty context
  HNonEmpty Aggregate = NonEmptyTable
  HNonEmpty Expr = NonEmptyTable
-  HNonEmpty Identity = NonEmpty
  HNonEmpty Insert = NonEmptyTable
  HNonEmpty Name = NonEmptyTable
-  HNonEmpty _ = NonEmpty
+  HNonEmpty Result = NonEmpty


 type HThese :: K.Context -> Type -> Type -> Type
@ -122,10 +118,9 @@ type family HThese context where
  HThese (Reify context) = AHThese context
  HThese Aggregate = TheseTable
  HThese Expr = TheseTable
-  HThese Identity = These
  HThese Insert = TheseTable
  HThese Name = TheseTable
-  HThese _ = These
+  HThese Result = These


 type AField :: K.Context -> Necessity -> Type -> Type
@ -304,9 +299,9 @@ type SContext :: K.Context -> Type
 data SContext context where
  SAggregate :: SContext Aggregate
  SExpr :: SContext Expr
-  SIdentity :: SContext Identity
  SInsert :: SContext Insert
  SName :: SContext Name
+  SResult :: SContext Result
  SReify :: SContext context -> SContext (Reify context)


@ -323,8 +318,8 @@ instance Reifiable Expr where
  contextSing = SExpr


-instance Reifiable Identity where
-  contextSing = SIdentity
+instance Reifiable Result where
+  contextSing = SResult


 instance Reifiable Insert where
@ -359,7 +354,7 @@ sfromColumn :: ()
 sfromColumn = \case
  SAggregate -> \(Aggregation a) -> AField a
  SExpr -> \(DB a) -> AField a
-  SIdentity -> \(Result a) -> AField a
+  SResult -> \(Result a) -> AField a
  SInsert -> \case
    RequiredInsert a -> AField a
    OptionalInsert a -> AField a
@ -375,7 +370,7 @@ stoColumn :: ()
 stoColumn = \case
  SAggregate -> \_ (AField a) -> Aggregation a
  SExpr -> \_ (AField a) -> DB a
-  SIdentity -> \_ (AField a) -> Result a
+  SResult -> \_ (AField a) -> Result a
  SInsert -> \case
    SRequired -> \(AField a) -> RequiredInsert a
    SOptional -> \(AField a) -> OptionalInsert a
@ -393,7 +388,7 @@ sbimapEither :: ()
 sbimapEither = \case
  SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
  SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
-  SIdentity -> \f g (AHEither a) -> AHEither (bimap f g a)
+  SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
  SInsert -> \f g (AHEither a) -> AHEither (bimap f g a)
  SName -> \f g (AHEither a) -> AHEither (bimap f g a)
  SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)
@ -414,7 +409,7 @@ sfromColumnsEither = \case
    bimap (fromColumns . hreify) (fromColumns . hreify) .
    fromColumns .
    hunreify
-  SIdentity ->
+  SResult ->
    AHEither .
    bimap (fromColumns . hreify) (fromColumns . hreify) .
    fromColumns .
@ -451,7 +446,7 @@ stoColumnsEither = \case
    toColumns .
    bimap (hunreify . toColumns) (hunreify . toColumns) .
    (\(AHEither a) -> a)
-  SIdentity ->
+  SResult ->
    hreify .
    toColumns .
    bimap (hunreify . toColumns) (hunreify . toColumns) .
@ -482,7 +477,7 @@ smapList :: Congruent a b
 smapList = \case
  SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
  SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
-  SIdentity -> \f _ (AHList as) -> AHList (fmap f as)
+  SResult -> \f _ (AHList as) -> AHList (fmap f as)
  SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
  SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
  SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
@ -495,7 +490,7 @@ sfromColumnsList :: Table (Reify context) a
 sfromColumnsList = \case
  SAggregate -> AHList . ListTable
  SExpr -> AHList . ListTable
-  SIdentity -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
  SInsert -> AHList . ListTable
  SName -> AHList . ListTable
  SReify context ->
@ -512,7 +507,7 @@ stoColumnsList :: Table (Reify context) a
 stoColumnsList = \case
  SAggregate -> \(AHList (ListTable a)) -> a
  SExpr -> \(AHList (ListTable a)) -> a
-  SIdentity ->
+  SResult ->
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
  SInsert -> \(AHList (ListTable a)) -> a
  SName -> \(AHList (ListTable a)) -> a
@ -531,7 +526,7 @@ smapMaybe :: ()
 smapMaybe = \case
  SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)
  SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)
-  SIdentity -> \f (AHMaybe a) -> AHMaybe (fmap f a)
+  SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
  SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)
  SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)
  SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)
@ -544,7 +539,7 @@ sfromColumnsMaybe :: Table (Reify context) a
 sfromColumnsMaybe = \case
  SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
  SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
-  SIdentity -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
  SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
  SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
  SReify context ->
@ -563,7 +558,7 @@ stoColumnsMaybe = \case
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
  SExpr ->
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
-  SIdentity ->
+  SResult ->
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
  SInsert ->
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
@ -585,7 +580,7 @@ smapNonEmpty :: Congruent a b
 smapNonEmpty = \case
  SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
  SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
-  SIdentity -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
+  SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
  SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
  SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
  SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
@ -598,7 +593,7 @@ sfromColumnsNonEmpty :: Table (Reify context) a
 sfromColumnsNonEmpty = \case
  SAggregate -> AHNonEmpty . NonEmptyTable
  SExpr -> AHNonEmpty . NonEmptyTable
-  SIdentity ->
+  SResult ->
    AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
  SInsert -> AHNonEmpty . NonEmptyTable
  SName -> AHNonEmpty . NonEmptyTable
@ -616,7 +611,7 @@ stoColumnsNonEmpty :: Table (Reify context) a
 stoColumnsNonEmpty = \case
  SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
  SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
-  SIdentity ->
+  SResult ->
    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
  SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
  SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
@ -636,7 +631,7 @@ sbimapThese :: ()
 sbimapThese = \case
  SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
  SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
-  SIdentity -> \f g (AHThese a) -> AHThese (bimap f g a)
+  SResult -> \f g (AHThese a) -> AHThese (bimap f g a)
  SInsert -> \f g (AHThese a) -> AHThese (bimap f g a)
  SName -> \f g (AHThese a) -> AHThese (bimap f g a)
  SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)
@ -657,7 +652,7 @@ sfromColumnsThese = \case
    bimap (fromColumns . hreify) (fromColumns . hreify) .
    fromColumns .
    hunreify
-  SIdentity ->
+  SResult ->
    AHThese .
    bimap (fromColumns . hreify) (fromColumns . hreify) .
    fromColumns .
@ -694,7 +689,7 @@ stoColumnsThese = \case
    toColumns .
    bimap (hunreify . toColumns) (hunreify . toColumns) .
    (\(AHThese a) -> a)
-  SIdentity ->
+  SResult ->
    hreify .
    toColumns .
    bimap (hunreify . toColumns) (hunreify . toColumns) .
--- a/src/Rel8/Schema/Generic.hs
+++ b/src/Rel8/Schema/Generic.hs
@ -43,7 +43,6 @@ import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
 import Rel8.Schema.HTable.Pair ( HPair(..) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name )
-import Rel8.Schema.Spec ( KTable )
 import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  )
@ -104,7 +103,7 @@ instance
 -- data MyType f = MyType { fieldA :: Column f T }
 --   deriving ( GHC.Generics.Generic, Rel8able )
 -- @
-type Rel8able :: KTable -> Constraint
+type Rel8able :: K.Table -> Constraint
 class HTable (GRep t) => Rel8able t where
  gfromColumns :: (Labelable context, Reifiable context)
    => GRep t (Col (Reify context)) -> t (Reify context)
--- a/src/Rel8/Schema/Insert.hs
+++ b/src/Rel8/Schema/Insert.hs
@ -6,6 +6,7 @@
 {-# language LambdaCase #-}
 {-# language MultiParamTypeClasses #-}
 {-# language NamedFieldPuns #-}
+{-# language PolyKinds #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
@ -36,9 +37,9 @@ import Rel8.Schema.Context.Nullify
  , runTag, unnull
  )
 import Rel8.Schema.HTable.Type ( HType( HType ) )
-import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name, Selects )
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )
 import Rel8.Schema.Table ( TableSchema )
 import Rel8.Statement.Returning ( Returning )
@ -56,7 +57,7 @@ data OnConflict


 -- | The constituent parts of a SQL @INSERT@ statement.
-type Insert :: K.Context
+type Insert :: k -> Type
 data Insert a where
  Insert :: (Selects names exprs, Inserts exprs inserts) =>
    { into :: TableSchema names
@ -78,7 +79,7 @@ instance Interpretation Insert where
    OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional a)


-type Insertion :: K.Context
+type Insertion :: Type -> Type
 newtype Insertion a = Insertion (Expr a)


@ -98,7 +99,7 @@ instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)


 instance Sql DBType a =>
-  Recontextualize Identity Insert (Identity a) (Insertion a)
+  Recontextualize Result Insert (Identity a) (Insertion a)


 instance Sql DBType a =>
@ -109,7 +110,7 @@ instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)


 instance Sql DBType a =>
-  Recontextualize Insert Identity (Insertion a) (Identity a)
+  Recontextualize Insert Result (Insertion a) (Identity a)


 instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
--- a/src/Rel8/Schema/Kind.hs
+++ b/src/Rel8/Schema/Kind.hs
@ -22,8 +22,11 @@ type HTable :: Type
 type HTable = HContext -> Type


+data X
+
+
 type Context :: Type
-type Context = Type -> Type
+type Context = X -> Type


 type Table :: Type
--- a/src/Rel8/Schema/Name.hs
+++ b/src/Rel8/Schema/Name.hs
@ -2,9 +2,11 @@
 {-# language DerivingStrategies #-}
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
-{-# language GeneralizedNewtypeDeriving #-}
+{-# language GADTs #-}
 {-# language MultiParamTypeClasses #-}
+{-# language PolyKinds #-}
 {-# language RankNTypes #-}
+{-# language StandaloneDeriving #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
 {-# language UndecidableInstances #-}
@ -20,7 +22,7 @@ where
 -- base
 import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint, Type )
-import Data.String ( IsString )
+import Data.String ( IsString, fromString )
 import Prelude

 -- rel8
@ -28,8 +30,8 @@ import Rel8.Expr ( Expr )
 import Rel8.Schema.Context ( Interpretation, Col )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable.Type ( HType( HType ) )
-import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Type ( DBType )
@ -39,10 +41,16 @@ import Rel8.Type ( DBType )
 -- schema definition. You can construct names by using the @OverloadedStrings@
 -- extension and writing string literals. This is typically done when providing
 -- a 'TableSchema' value.
-type Name :: K.Context
-newtype Name a = Name String
-  deriving stock Show
-  deriving newtype (IsString, Monoid, Semigroup)
+type Name :: k -> Type
+data Name a where
+  Name :: k ~ Type => !String -> Name (a :: k)
+
+
+deriving stock instance Show (Name a)
+
+
+instance k ~ Type => IsString (Name (a :: k)) where
+  fromString = Name


 instance Sql DBType a => Table Name (Name a) where
@ -56,13 +64,13 @@ instance Sql DBType a => Table Name (Name a) where
 instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)


-instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)
+instance Sql DBType a => Recontextualize Result Name (Identity a) (Name a)


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


-instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)
+instance Sql DBType a => Recontextualize Name Result (Name a) (Identity a)


 instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
--- a/src/Rel8/Schema/Result.hs
+++ b/src/Rel8/Schema/Result.hs
@ -0,0 +1,16 @@
+{-# language DataKinds #-}
+{-# language StandaloneKindSignatures #-}
+
+module Rel8.Schema.Result
+  ( Result
+  ) where
+
+-- base
+import Prelude ()
+
+-- rel8
+import Rel8.Schema.Kind ( Context )
+
+
+type Result :: Context
+data Result a
--- a/src/Rel8/Schema/Spec.hs
+++ b/src/Rel8/Schema/Spec.hs
@ -8,8 +8,6 @@ module Rel8.Schema.Spec
  ( Spec( Spec )
  , SSpec( SSpec, labels, necessity, info, nullity )
  , KnownSpec( specSing )
-  , KContext, HKTable
-  , KTable
  )
 where

@ -62,15 +60,3 @@ instance
    , info = typeInformation
    , nullity = nullable
    }
-
-
-type KContext :: Type
-type KContext = Spec -> Type
-
-
-type HKTable :: Type
-type HKTable = KContext -> Type
-
-
-type KTable :: Type
-type KTable = (Type -> Type) -> Type
--- a/src/Rel8/Table.hs
+++ b/src/Rel8/Table.hs
@ -44,6 +44,7 @@ import Rel8.Schema.HTable.Type ( HType( HType ) )
 import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..), KnownSpec )
 import Rel8.Type ( DBType )
 import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ),  MaybeTag( IsJust ) )
@ -94,18 +95,17 @@ instance KnownSpec spec => Table context (Col context spec) where
  fromColumns = unHIdentity


-instance Sql DBType a => Table Identity (Identity a) where
+instance Sql DBType a => Table Result (Identity a) where
  type Columns (Identity a) = HType a
-  type Context (Identity a) = Identity
+  type Context (Identity a) = Result

  toColumns (Identity a) = HType (Result a)
  fromColumns (HType (Result a)) = Identity a


-instance (Table Identity a, Table Identity b) => Table Identity (Either a b)
- where
+instance (Table Result a, Table Result b) => Table Result (Either a b) where
  type Columns (Either a b) = HEitherTable (Columns a) (Columns b)
-  type Context (Either a b) = Identity
+  type Context (Either a b) = Result

  toColumns = \case
    Left table -> HEitherTable
@ -127,17 +127,17 @@ instance (Table Identity a, Table Identity b) => Table Identity (Either a b)
      err = error "Either.fromColumns: mismatch between tag and data"


-instance Table Identity a => Table Identity [a] where
+instance Table Result a => Table Result [a] where
  type Columns [a] = HListTable (Columns a)
-  type Context [a] = Identity
+  type Context [a] = Result

  toColumns = hvectorize vectorizer . fmap toColumns
  fromColumns = fmap fromColumns . hunvectorize unvectorizer


-instance Table Identity a => Table Identity (Maybe a) where
+instance Table Result a => Table Result (Maybe a) where
  type Columns (Maybe a) = HMaybeTable (Columns a)
-  type Context (Maybe a) = Identity
+  type Context (Maybe a) = Result

  toColumns = \case
    Nothing -> HMaybeTable
@ -156,18 +156,17 @@ instance Table Identity a => Table Identity (Maybe a) where
        Just just -> fromColumns just


-instance Table Identity a => Table Identity (NonEmpty a) where
+instance Table Result a => Table Result (NonEmpty a) where
  type Columns (NonEmpty a) = HNonEmptyTable (Columns a)
-  type Context (NonEmpty a) = Identity
+  type Context (NonEmpty a) = Result

  toColumns = hvectorize vectorizer . fmap toColumns
  fromColumns = fmap fromColumns . hunvectorize unvectorizer


-instance (Table Identity a, Table Identity b) => Table Identity (These a b)
- where
+instance (Table Result a, Table Result b) => Table Result (These a b) where
  type Columns (These a b) = HTheseTable (Columns a) (Columns b)
-  type Context (These a b) = Identity
+  type Context (These a b) = Result

  toColumns tables = HTheseTable
    { hhereTag = relabel hhereTag
@ -311,14 +310,14 @@ class Columns a ~ Columns b => Congruent a b
 instance Columns a ~ Columns b => Congruent a b


-null :: Col Identity ('Spec labels necessity (Maybe a))
+null :: Col Result ('Spec labels necessity (Maybe a))
 null = Result Nothing


 nullifier :: ()
  => SSpec ('Spec labels necessity a)
-  -> Col Identity ('Spec labels necessity a)
-  -> Col Identity ('Spec labels necessity (Nullify a))
+  -> Col Result ('Spec labels necessity a)
+  -> Col Result ('Spec labels necessity (Nullify a))
 nullifier SSpec {nullity} (Result a) = Result $ case nullity of
  Null -> a
  NotNull -> Just a
@ -326,8 +325,8 @@ nullifier SSpec {nullity} (Result a) = Result $ case nullity of

 unnullifier :: ()
  => SSpec ('Spec labels necessity a)
-  -> Col Identity ('Spec labels necessity (Nullify a))
-  -> Maybe (Col Identity ('Spec labels necessity a))
+  -> Col Result ('Spec labels necessity (Nullify a))
+  -> Maybe (Col Result ('Spec labels necessity a))
 unnullifier SSpec {nullity} (Result a) =
  case nullity of
    Null -> pure $ Result a
@ -336,19 +335,19 @@ unnullifier SSpec {nullity} (Result a) =

 vectorizer :: Functor f
  => SSpec ('Spec labels necessity a)
-  -> f (Col Identity ('Spec labels necessity a))
-  -> Col Identity ('Spec labels necessity (f a))
+  -> f (Col Result ('Spec labels necessity a))
+  -> Col Result ('Spec labels necessity (f a))
 vectorizer _ = Result . fmap (\(Result a) -> a)


 unvectorizer :: Functor f
  => SSpec ('Spec labels necessity a)
-  -> Col Identity ('Spec labels necessity (f a))
-  -> f (Col Identity ('Spec labels necessity a))
+  -> Col Result ('Spec labels necessity (f a))
+  -> f (Col Result ('Spec labels necessity a))
 unvectorizer _ (Result results) = Result <$> results


 relabel :: ()
-  => HIdentity ('Spec labels necessity a) (Col Identity)
-  -> HIdentity ('Spec relabels necessity a) (Col Identity)
+  => HIdentity ('Spec labels necessity a) (Col Result)
+  -> HIdentity ('Spec relabels necessity a) (Col Result)
 relabel (HIdentity (Result a)) = HIdentity (Result a)
--- a/src/Rel8/Table/Eq.hs
+++ b/src/Rel8/Table/Eq.hs
@ -40,6 +40,7 @@ import Rel8.Schema.HTable.Pair ( HPair(..) )
 import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
 import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
 import Rel8.Schema.HTable.Trio ( HTrio(..) )
+import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
 import Rel8.Table ( Table, Columns, toColumns )
@ -60,7 +61,7 @@ class Table Expr a => EqTable a where


 instance
-  ( Table Expr (t Expr)
+  ( Table Expr (t (Expr :: Context))
  , f ~ Expr
  , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)
  )
--- a/src/Rel8/Table/Name.hs
+++ b/src/Rel8/Table/Name.hs
@ -23,8 +23,12 @@ import Prelude
 -- casing
 import Text.Casing ( quietSnake )

+-- opaleye
+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
+
 -- rel8
 import Rel8.Expr ( Expr, Col(..) )
+import Rel8.Expr.Opaleye ( toPrimExpr )
 import Rel8.Kind.Labels ( renderLabels )
 import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
 import Rel8.Schema.Name ( Name, Col(..) )
@ -45,11 +49,11 @@ namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
    SSpec {labels} -> NameCol (f (renderLabels labels))


-showExprs :: Table Expr a => a -> [(String, String)]
+showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
 showExprs as = case (namesFromLabels, toColumns as) of
  (names, exprs) -> getConst $ htabulateA $ \field ->
    case (hfield names field, hfield exprs field) of
-      (NameCol name, DB expr) -> Const [(name, show expr)]
+      (NameCol name, DB expr) -> Const [(name, toPrimExpr expr)]


 showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
--- a/src/Rel8/Table/Ord.hs
+++ b/src/Rel8/Table/Ord.hs
@ -37,6 +37,7 @@ import Rel8.Schema.HTable.Pair ( HPair(..) )
 import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
 import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
 import Rel8.Schema.HTable.Trio ( HTrio(..) )
+import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Null (Sql)
 import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
 import Rel8.Table ( Table, Columns, toColumns )
@ -58,7 +59,7 @@ class EqTable a => OrdTable a where


 instance
-  ( Table Expr (t Expr)
+  ( Table Expr (t (Expr :: Context))
  , f ~ Expr
  , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBEq)
  , HConstrainTable (Columns (t Expr)) (ConstrainDBType DBOrd)
--- a/src/Rel8/Table/Recontextualize.hs
+++ b/src/Rel8/Table/Recontextualize.hs
@ -22,6 +22,7 @@ import Rel8.Schema.Context.Label ( Labelable )
 import Rel8.Schema.HTable ( HTable )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Null ( Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Table ( Table, Congruent )
 import Rel8.Type ( DBType )

@ -41,7 +42,7 @@ class
    , b from -> a


-instance Sql DBType a => Recontextualize Identity Identity (Identity a) (Identity a)
+instance Sql DBType a => Recontextualize Result Result (Identity a) (Identity a)


 instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))
--- a/src/Rel8/Table/Serialize.hs
+++ b/src/Rel8/Table/Serialize.hs
@ -21,7 +21,6 @@ where

 -- base
 import Data.Bifunctor ( bimap )
-import Data.Functor.Identity ( Identity )
 import Data.Kind ( Constraint, Type )
 import Data.List.NonEmpty ( NonEmpty )
 import Prelude
@ -42,6 +41,7 @@ import Rel8.Schema.HTable.Pair ( HPair(..) )
 import Rel8.Schema.HTable.Trio ( HTrio(..) )
 import Rel8.Schema.HTable.Type ( HType(..) )
 import Rel8.Schema.Null ( NotNull, Sql )
+import Rel8.Schema.Result ( Result )
 import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
 import Rel8.Table ( Table, Columns, fromColumns, toColumns )
 import Rel8.Table.Either ( EitherTable )
@ -59,90 +59,90 @@ import Data.Functor.Apply ( WrappedApplicative(..) )
 import Data.These ( These )


-fromIdentity' :: forall exprs a. ToExprs a exprs => Columns exprs (Col Identity) -> a
-fromIdentity' = fromIdentity @_ @exprs
+fromResult' :: forall exprs a. ToExprs a exprs => Columns exprs (Col Result) -> a
+fromResult' = fromResult @_ @exprs


-toIdentity' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (Col Identity)
-toIdentity' = toIdentity @_ @exprs
+toResult' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (Col Result)
+toResult' = toResult @_ @exprs


 type ToExprs :: Type -> Type -> Constraint
 class Table Expr exprs => ToExprs a exprs where
-  fromIdentity :: Columns exprs (Col Identity) -> a
-  toIdentity :: a -> Columns exprs (Col Identity)
+  fromResult :: Columns exprs (Col Result) -> a
+  toResult :: a -> Columns exprs (Col Result)


 instance {-# OVERLAPPABLE #-} (Sql DBType a, x ~ Expr a) => ToExprs a x where
-  fromIdentity (HType (Result a)) = a
-  toIdentity = HType . Result
+  fromResult (HType (Result a)) = a
+  toResult = HType . Result


 instance (Sql DBType a, x ~ [a]) => ToExprs [a] (Expr x) where
-  fromIdentity (HType (Result a)) = a
-  toIdentity = HType . Result
+  fromResult (HType (Result a)) = a
+  toResult = HType . Result


 instance (Sql DBType a, NotNull a, x ~ Maybe a) => ToExprs (Maybe a) (Expr x)
 where
-  fromIdentity (HType (Result a)) = a
-  toIdentity = HType . Result
+  fromResult (HType (Result a)) = a
+  toResult = HType . Result


 instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (NonEmpty a) (Expr x)
 where
-  fromIdentity (HType (Result a)) = a
-  toIdentity = HType . Result
+  fromResult (HType (Result a)) = a
+  toResult = HType . Result


 instance (ToExprs a exprs1, ToExprs b exprs2, x ~ EitherTable exprs1 exprs2) =>
  ToExprs (Either a b) x
 where
-  fromIdentity =
-    bimap (fromIdentity' @exprs1) (fromIdentity' @exprs2) .
+  fromResult =
+    bimap (fromResult' @exprs1) (fromResult' @exprs2) .
    fromColumns
-  toIdentity =
+  toResult =
    toColumns .
-    bimap (toIdentity' @exprs1) (toIdentity' @exprs2)
+    bimap (toResult' @exprs1) (toResult' @exprs2)


 instance ToExprs a exprs => ToExprs [a] (ListTable exprs) where
-  fromIdentity = fmap (fromIdentity' @exprs) . fromColumns
-  toIdentity = toColumns . fmap (toIdentity' @exprs)
+  fromResult = fmap (fromResult' @exprs) . fromColumns
+  toResult = toColumns . fmap (toResult' @exprs)


 instance ToExprs a exprs => ToExprs (Maybe a) (MaybeTable exprs) where
-  fromIdentity = fmap (fromIdentity' @exprs) . fromColumns
-  toIdentity = toColumns . fmap (toIdentity' @exprs)
+  fromResult = fmap (fromResult' @exprs) . fromColumns
+  toResult = toColumns . fmap (toResult' @exprs)


 instance ToExprs a exprs => ToExprs (NonEmpty a) (NonEmptyTable exprs)
 where
-  fromIdentity = fmap (fromIdentity' @exprs) . fromColumns
-  toIdentity = toColumns . fmap (toIdentity' @exprs)
+  fromResult = fmap (fromResult' @exprs) . fromColumns
+  toResult = toColumns . fmap (toResult' @exprs)


 instance (ToExprs a exprs1, ToExprs b exprs2, x ~ TheseTable exprs1 exprs2) =>
  ToExprs (These a b) x
 where
-  fromIdentity =
-    bimap (fromIdentity' @exprs1) (fromIdentity' @exprs2) .
+  fromResult =
+    bimap (fromResult' @exprs1) (fromResult' @exprs2) .
    fromColumns
-  toIdentity =
+  toResult =
    toColumns .
-    bimap (toIdentity' @exprs1) (toIdentity' @exprs2)
+    bimap (toResult' @exprs1) (toResult' @exprs2)


 instance (ToExprs a exprs1, ToExprs b exprs2, x ~ (exprs1, exprs2)) =>
  ToExprs (a, b) x
 where
-  fromIdentity (HPair a b) =
-    ( fromIdentity' @exprs1 $ hunlabel unlabeler a
-    , fromIdentity' @exprs2 $ hunlabel unlabeler b
+  fromResult (HPair a b) =
+    ( fromResult' @exprs1 $ hunlabel unlabeler a
+    , fromResult' @exprs2 $ hunlabel unlabeler b
    )
-  toIdentity (a, b) = HPair
-    { hfst = hlabel labeler $ toIdentity' @exprs1 a
-    , hsnd = hlabel labeler $ toIdentity' @exprs2 b
+  toResult (a, b) = HPair
+    { hfst = hlabel labeler $ toResult' @exprs1 a
+    , hsnd = hlabel labeler $ toResult' @exprs2 b
    }


@ -153,15 +153,15 @@ instance
  , x ~ (exprs1, exprs2, exprs3)
  ) => ToExprs (a, b, c) x
 where
-  fromIdentity (HTrio a b c) =
-    ( fromIdentity' @exprs1 $ hunlabel unlabeler a
-    , fromIdentity' @exprs2 $ hunlabel unlabeler b
-    , fromIdentity' @exprs3 $ hunlabel unlabeler c
+  fromResult (HTrio a b c) =
+    ( fromResult' @exprs1 $ hunlabel unlabeler a
+    , fromResult' @exprs2 $ hunlabel unlabeler b
+    , fromResult' @exprs3 $ hunlabel unlabeler c
    )
-  toIdentity (a, b, c) = HTrio
-    { hfst = hlabel labeler $ toIdentity' @exprs1 a
-    , hsnd = hlabel labeler $ toIdentity' @exprs2 b
-    , htrd = hlabel labeler $ toIdentity' @exprs3 c
+  toResult (a, b, c) = HTrio
+    { hfst = hlabel labeler $ toResult' @exprs1 a
+    , hsnd = hlabel labeler $ toResult' @exprs2 b
+    , htrd = hlabel labeler $ toResult' @exprs3 c
    }


@ -173,17 +173,17 @@ instance
  , x ~ (exprs1, exprs2, exprs3, exprs4)
  ) => ToExprs (a, b, c, d) x
 where
-  fromIdentity (HQuartet a b c d) =
-    ( fromIdentity' @exprs1 $ hunlabel unlabeler a
-    , fromIdentity' @exprs2 $ hunlabel unlabeler b
-    , fromIdentity' @exprs3 $ hunlabel unlabeler c
-    , fromIdentity' @exprs4 $ hunlabel unlabeler d
+  fromResult (HQuartet a b c d) =
+    ( fromResult' @exprs1 $ hunlabel unlabeler a
+    , fromResult' @exprs2 $ hunlabel unlabeler b
+    , fromResult' @exprs3 $ hunlabel unlabeler c
+    , fromResult' @exprs4 $ hunlabel unlabeler d
    )
-  toIdentity (a, b, c, d) = HQuartet
-    { hfst = hlabel labeler $ toIdentity' @exprs1 a
-    , hsnd = hlabel labeler $ toIdentity' @exprs2 b
-    , htrd = hlabel labeler $ toIdentity' @exprs3 c
-    , hfrt = hlabel labeler $ toIdentity' @exprs4 d
+  toResult (a, b, c, d) = HQuartet
+    { hfst = hlabel labeler $ toResult' @exprs1 a
+    , hsnd = hlabel labeler $ toResult' @exprs2 b
+    , htrd = hlabel labeler $ toResult' @exprs3 c
+    , hfrt = hlabel labeler $ toResult' @exprs4 d
    }


@ -196,47 +196,47 @@ instance
  , x ~ (exprs1, exprs2, exprs3, exprs4, exprs5)
  ) => ToExprs (a, b, c, d, e) x
 where
-  fromIdentity (HQuintet a b c d e) =
-    ( fromIdentity' @exprs1 $ hunlabel unlabeler a
-    , fromIdentity' @exprs2 $ hunlabel unlabeler b
-    , fromIdentity' @exprs3 $ hunlabel unlabeler c
-    , fromIdentity' @exprs4 $ hunlabel unlabeler d
-    , fromIdentity' @exprs5 $ hunlabel unlabeler e
+  fromResult (HQuintet a b c d e) =
+    ( fromResult' @exprs1 $ hunlabel unlabeler a
+    , fromResult' @exprs2 $ hunlabel unlabeler b
+    , fromResult' @exprs3 $ hunlabel unlabeler c
+    , fromResult' @exprs4 $ hunlabel unlabeler d
+    , fromResult' @exprs5 $ hunlabel unlabeler e
    )
-  toIdentity (a, b, c, d, e) = HQuintet
-    { hfst = hlabel labeler $ toIdentity' @exprs1 a
-    , hsnd = hlabel labeler $ toIdentity' @exprs2 b
-    , htrd = hlabel labeler $ toIdentity' @exprs3 c
-    , hfrt = hlabel labeler $ toIdentity' @exprs4 d
-    , hfft = hlabel labeler $ toIdentity' @exprs5 e
+  toResult (a, b, c, d, e) = HQuintet
+    { hfst = hlabel labeler $ toResult' @exprs1 a
+    , hsnd = hlabel labeler $ toResult' @exprs2 b
+    , htrd = hlabel labeler $ toResult' @exprs3 c
+    , hfrt = hlabel labeler $ toResult' @exprs4 d
+    , hfft = hlabel labeler $ toResult' @exprs5 e
    }


-instance (HTable t, result ~ Col Identity, x ~ t (Col Expr)) =>
+instance (HTable t, result ~ Col Result, x ~ t (Col Expr)) =>
  ToExprs (t result) x
 where
-  fromIdentity = id
-  toIdentity = id
+  fromResult = id
+  toResult = id


-instance (Recontextualize Identity Expr (t Identity) (t Expr), result ~ Identity, x ~ t Expr) =>
+instance (Recontextualize Result Expr (t Result) (t Expr), result ~ Result, x ~ t Expr) =>
  ToExprs (t result) x
 where
-  fromIdentity = fromColumns
-  toIdentity = toColumns
+  fromResult = fromColumns
+  toResult = toColumns


 instance (KnownSpec spec, x ~ Col Expr spec) =>
-  ToExprs (Col Identity spec) x
+  ToExprs (Col Result spec) x
 where
-  fromIdentity = fromColumns
-  toIdentity = toColumns
+  fromResult = fromColumns
+  toResult = toColumns


 type FromExprs :: Type -> Type
 type family FromExprs a
 type instance FromExprs (Expr a) = a
-type instance FromExprs (Col Expr spec) = Col Identity spec
+type instance FromExprs (Col Expr spec) = Col Result spec
 type instance FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)
 type instance FromExprs (ListTable a) = [FromExprs a]
 type instance FromExprs (MaybeTable a) = Maybe (FromExprs a)
@ -248,8 +248,8 @@ type instance FromExprs (a, b, c, d) =
  (FromExprs a, FromExprs b, FromExprs c, FromExprs d)
 type instance FromExprs (a, b, c, d, e) =
  (FromExprs a, FromExprs b, FromExprs c, FromExprs d, FromExprs e)
-type instance FromExprs (t Expr) = t Identity
-type instance FromExprs (t (Col Expr)) = t (Col Identity)
+type instance FromExprs (t Expr) = t Result
+type instance FromExprs (t (Col Expr)) = t (Col Result)


 -- | @Serializable@ witnesses the one-to-one correspondence between the type
@ -264,24 +264,24 @@ instance {-# OVERLAPPING #-} Sql DBType a => Serializable (Expr a) a
 -- | Use @lit@ to turn literal Haskell values into expressions. @lit@ is
 -- capable of lifting single @Expr@s to full tables.
 lit :: forall exprs a. Serializable exprs a => a -> exprs
-lit = fromColumns . litHTable . toIdentity' @exprs
+lit = fromColumns . litHTable . toResult' @exprs


 parse :: forall exprs a. Serializable exprs a => Hasql.Row a
-parse = fromIdentity' @exprs <$> parseHTable
+parse = fromResult' @exprs <$> parseHTable


 type Encodes :: Type -> Type -> Constraint
 class Serializable exprs a => Encodes a exprs | a -> exprs, exprs -> a


-instance KnownSpec spec => Encodes (Col Identity spec) (Col Expr spec)
+instance KnownSpec spec => Encodes (Col Result spec) (Col Expr spec)


-instance Serializable (t Identity) (t Expr) => Encodes (t Expr) (t Identity)
+instance Serializable (t Result) (t Expr) => Encodes (t Expr) (t Result)


-instance HTable t => Encodes (t (Col Identity)) (t (Col Expr))
+instance HTable t => Encodes (t (Col Result)) (t (Col Expr))


 instance (Encodes a x, Encodes b y) => Encodes (Either a b) (EitherTable x y)
@ -318,14 +318,14 @@ litTable :: Encodes a exprs => a -> exprs
 litTable = lit


-litHTable :: HTable t => t (Col Identity) -> t (Col Expr)
+litHTable :: HTable t => t (Col Result) -> t (Col Expr)
 litHTable as = htabulate $ \field ->
  case hfield hspecs field of
    SSpec {nullity, info} -> case hfield as field of
      Result value -> DB (slitExpr nullity info value)


-parseHTable :: HTable t => Hasql.Row (t (Col Identity))
+parseHTable :: HTable t => Hasql.Row (t (Col Result))
 parseHTable = unwrapApplicative $ htabulateA $ \field ->
  WrapApplicative $ case hfield hspecs field of
    SSpec {nullity, info} -> Result <$> sparseValue nullity info
--- a/tests/Main.hs
+++ b/tests/Main.hs
@ -27,7 +27,6 @@ import Control.Monad (void)
 import Control.Monad.IO.Class ( MonadIO, liftIO )
 import Data.Bifunctor ( bimap )
 import Data.Foldable ( for_ )
-import Data.Functor.Identity ( Identity )
 import Data.Int ( Int32, Int64 )
 import Data.List ( nub, sort )
 import Data.Maybe ( catMaybes )
@ -60,6 +59,7 @@ import Control.Exception.Lifted ( bracket, throwIO, bracket_ )
 import Control.Monad.Trans.Control ( MonadBaseControl )

 -- rel8
+import Rel8 ( Result )
 import qualified Rel8

 -- scientific
@ -161,9 +161,9 @@ data TestTable f = TestTable
  deriving anyclass Rel8.Rel8able


-deriving stock instance Eq (TestTable Identity)
-deriving stock instance Ord (TestTable Identity)
-deriving stock instance Show (TestTable Identity)
+deriving stock instance Eq (TestTable Result)
+deriving stock instance Ord (TestTable Result)
+deriving stock instance Show (TestTable Result)


 testTableSchema :: Rel8.TableSchema (TestTable Rel8.Name)
@ -543,9 +543,9 @@ data TwoTestTables f =
  deriving anyclass Rel8.Rel8able


-deriving stock instance Eq (TwoTestTables Identity)
-deriving stock instance Ord (TwoTestTables Identity)
-deriving stock instance Show (TwoTestTables Identity)
+deriving stock instance Eq (TwoTestTables Result)
+deriving stock instance Ord (TwoTestTables Result)
+deriving stock instance Show (TwoTestTables Result)


 testNestedTables :: IO TmpPostgres.DB -> TestTree
@ -578,7 +578,7 @@ testMaybeTableApplicative = databasePropertyTest "MaybeTable (<*>)" \transaction
      (as, []) -> selected === (Nothing <$ as)
      (as, bs) -> sort selected === sort (Just <$> liftA2 (,) as bs)
  where
-    genRows :: PropertyT IO [TestTable Identity]
+    genRows :: PropertyT IO [TestTable Result]
    genRows = forAll do
      Gen.list (Range.linear 0 10) $ liftA2 TestTable (Gen.text (Range.linear 0 10) Gen.unicode) (pure True)

@ -591,7 +591,7 @@ rollingBack connection =
    (liftIO (run (sql "ROLLBACK") connection))


-genTestTable :: Gen (TestTable Identity)
+genTestTable :: Gen (TestTable Result)
 genTestTable = do
  testTableColumn1 <- Gen.text (Range.linear 0 5) Gen.alphaNum
  testTableColumn2 <- Gen.bool
@ -673,9 +673,9 @@ newtype HKNestedPair f = HKNestedPair { pairOne :: (TestTable f, TestTable f) }
  deriving stock Generic
  deriving anyclass Rel8.Rel8able

-deriving stock instance Eq (HKNestedPair Identity)
-deriving stock instance Ord (HKNestedPair Identity)
-deriving stock instance Show (HKNestedPair Identity)
+deriving stock instance Eq (HKNestedPair Result)
+deriving stock instance Ord (HKNestedPair Result)
+deriving stock instance Show (HKNestedPair Result)


 testSelectNestedPairs :: IO TmpPostgres.DB -> TestTree
@ -708,9 +708,9 @@ data NestedMaybeTable f = NestedMaybeTable
  deriving anyclass Rel8.Rel8able


-deriving stock instance Eq (NestedMaybeTable Identity)
-deriving stock instance Ord (NestedMaybeTable Identity)
-deriving stock instance Show (NestedMaybeTable Identity)
+deriving stock instance Eq (NestedMaybeTable Result)
+deriving stock instance Ord (NestedMaybeTable Result)
+deriving stock instance Show (NestedMaybeTable Result)


 testNestedMaybeTable :: IO TmpPostgres.DB -> TestTree