Complete overhaul of Rel8.Schema.Generic

2024-08-17 20:00:23 +03:00 · 2021-04-13 19:54:23 +01:00 · 2021-04-13 19:54:23 +01:00 · 5e4df5096c
commit 5e4df5096c
parent 09e449bc48
23 changed files with 1189 additions and 1626 deletions
--- a/rel8.cabal
+++ b/rel8.cabal
@ -87,7 +87,6 @@ library

    Rel8.Schema.Column
    Rel8.Schema.Context
-    Rel8.Schema.Context.Identity
    Rel8.Schema.Context.Label
    Rel8.Schema.Context.Nullify
    Rel8.Schema.Dict
@ -117,6 +116,7 @@ library
    Rel8.Schema.Spec
    Rel8.Schema.Spec.ConstrainDBType
    Rel8.Schema.Spec.ConstrainType
+    Rel8.Schema.Structure
    Rel8.Schema.Table

    Rel8.Statement.Delete
@ -133,7 +133,6 @@ library
    Rel8.Table.Either
    Rel8.Table.Eq
    Rel8.Table.Insert
-    Rel8.Table.Lifted
    Rel8.Table.List
    Rel8.Table.Maybe
    Rel8.Table.Name
@ -163,8 +162,6 @@ library
    Rel8.Type.Sum
    Rel8.Type.Tag

-    Rel8.Schema.Structure
-
 test-suite tests
  type:             exitcode-stdio-1.0
  build-depends:
--- a/src/Rel8.hs
+++ b/src/Rel8.hs
@ -28,7 +28,7 @@ module Rel8
    -- * Tables and higher-kinded tables
  , Rel8able
  , Column, Field, Necessity( Required, Optional )
-  , Default, Label
+  , Default
  , HMaybe
  , HList
  , HNonEmpty
@ -268,7 +268,7 @@ import Rel8.Query.These
 import Rel8.Query.Values
 import Rel8.Schema.Column
 import Rel8.Schema.Context.Label
-import Rel8.Schema.Field (Field)
+import Rel8.Schema.Field
 import Rel8.Schema.Generic
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
@ -307,5 +307,3 @@ import Rel8.Type.ReadShow
 import Rel8.Type.Semigroup
 import Rel8.Type.String
 import Rel8.Type.Sum
-
-
--- a/src/Rel8/Expr/Eq.hs
+++ b/src/Rel8/Expr/Eq.hs
@ -22,7 +22,7 @@ import Prelude
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

 -- rel8
-import Rel8.Expr ( Expr )
+import {-# SOURCE #-} Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( (&&.), (||.), false, or_, coalesce )
 import Rel8.Expr.Null ( isNull, unsafeLiftOpNull )
 import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr, zipPrimExprsWith )
--- a/src/Rel8/Schema/Column.hs
+++ b/src/Rel8/Schema/Column.hs
@ -3,67 +3,24 @@
 {-# language StandaloneKindSignatures #-}

 module Rel8.Schema.Column
-  ( Column, Default, Label
-  , HEither
-  , HList
-  , HMaybe
-  , HNonEmpty
-  , HThese
+  ( Column, Default
  )
 where

 -- base
-import Data.Functor.Identity ( Identity )
 import Data.Kind ( Type )
-import Data.List.NonEmpty ( NonEmpty )
-import GHC.TypeLits ( Symbol )
-import Prelude
+import Prelude ()

 -- rel8
-import Rel8.Aggregate ( Aggregate )
-import Rel8.Expr ( Expr )
-import Rel8.Kind.Labels ( Labels )
 import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
 import Rel8.Schema.Field ( Field )
-import Rel8.Schema.Insert ( Insert )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Name ( Name )
-import Rel8.Schema.Structure
-  ( Structure
-  , Shape( Either, List, Maybe, NonEmpty, These )
-  , Shape1
-  , Shape2
-  )
-import Rel8.Table.Either ( EitherTable )
-import Rel8.Table.List ( ListTable )
-import Rel8.Table.Maybe ( MaybeTable )
-import Rel8.Table.NonEmpty ( NonEmptyTable )
-import Rel8.Table.These ( TheseTable )
-
-- these
-import Data.These ( These )
-
-
-type Label :: Symbol -> Type -> Type
-data Label label a


 type Default :: Type -> Type
 data Default a


-type GetLabel :: Type -> Labels
-type family GetLabel a where
-  GetLabel (Label label _) = '[label]
-  GetLabel _ = '[]
-
-
-type UnwrapLabel :: Type -> Type
-type family UnwrapLabel a where
-  UnwrapLabel (Label _ a) = a
-  UnwrapLabel a = a
-
-
 type GetNecessity :: Type -> Necessity
 type family GetNecessity a where
  GetNecessity (Default _) = 'Optional
@ -82,61 +39,4 @@ type family UnwrapDefault a where
 -- both query data and rows decoded to Haskell.
 type Column :: K.Context -> Type -> Type
 type Column context a =
-  Field context (GetLabel a)
-    (GetNecessity (UnwrapLabel a))
-    (UnwrapDefault (UnwrapLabel a))
-
-
-type HEither :: K.Context -> Type -> Type -> Type
-type family HEither context where
-  HEither Structure = Shape2 'Either
-  HEither Aggregate = EitherTable
-  HEither Expr = EitherTable
-  HEither Identity = Either
-  HEither Insert = EitherTable
-  HEither Name = EitherTable
-  HEither _ = Either
-
-
-type HList :: K.Context -> Type -> Type
-type family HList context where
-  HList Structure = Shape1 'List
-  HList Aggregate = ListTable
-  HList Expr = ListTable
-  HList Identity = []
-  HList Insert = ListTable
-  HList Name = ListTable
-  HList _ = []
-
-
-type HMaybe :: K.Context -> Type -> Type
-type family HMaybe context where
-  HMaybe Structure = Shape1 'Maybe
-  HMaybe Aggregate = MaybeTable
-  HMaybe Expr = MaybeTable
-  HMaybe Identity = Maybe
-  HMaybe Insert = MaybeTable
-  HMaybe Name = MaybeTable
-  HMaybe _ = Maybe
-
-
-type HNonEmpty :: K.Context -> Type -> Type
-type family HNonEmpty context where
-  HNonEmpty Structure = Shape1 'NonEmpty
-  HNonEmpty Aggregate = NonEmptyTable
-  HNonEmpty Expr = NonEmptyTable
-  HNonEmpty Identity = NonEmpty
-  HNonEmpty Insert = NonEmptyTable
-  HNonEmpty Name = NonEmptyTable
-  HNonEmpty _ = NonEmpty
-
-
-type HThese :: K.Context -> Type -> Type -> Type
-type family HThese context where
-  HThese Structure = Shape2 'These
-  HThese Aggregate = TheseTable
-  HThese Expr = TheseTable
-  HThese Identity = These
-  HThese Insert = TheseTable
-  HThese Name = TheseTable
-  HThese _ = These
+  Field context (GetNecessity a) (UnwrapDefault a)
--- a/src/Rel8/Schema/Context/Identity.hs
+++ b/src/Rel8/Schema/Context/Identity.hs
@ -1,196 +0,0 @@
-{-# language DataKinds #-}
-{-# language DisambiguateRecordFields #-}
-{-# language NamedFieldPuns #-}
-{-# language TypeFamilies #-}
-
-module Rel8.Schema.Context.Identity
-  ( fromHEitherTable, toHEitherTable
-  , fromHListTable, toHListTable
-  , fromHMaybeTable, toHMaybeTable
-  , fromHNonEmptyTable, toHNonEmptyTable
-  , fromHTheseTable, toHTheseTable
-  )
-where
-
-- base
-import Data.Functor ( ($>) )
-import Data.Functor.Identity ( Identity )
-import Data.List.NonEmpty ( NonEmpty )
-import Prelude hiding ( null )
-
-- rel8
-import Rel8.Schema.Context ( Col( Result ) )
-import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Either ( HEitherTable(..) )
-import Rel8.Schema.HTable.Identity ( HIdentity(..) )
-import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
-import Rel8.Schema.HTable.List ( HListTable )
-import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
-import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
-import Rel8.Schema.HTable.These ( HTheseTable(..) )
-import Rel8.Schema.HTable.Vectorize ( hvectorize, hunvectorize )
-import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )
-import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
-import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ),  MaybeTag( IsJust ) )
-
-- these
-import Data.These ( These( This, That, These ) )
-import Data.These.Combinators ( justHere, justThere )
-
-
-toHEitherTable :: (HTable t, HTable u)
-  => Either (t (Col Identity)) (u (Col Identity))
-  -> HEitherTable t u (Col Identity)
-toHEitherTable = either hleft hright
-  where
-    hleft table = HEitherTable
-      { htag = HIdentity (Result IsLeft)
-      , hleft = hnullify nullifier table
-      , hright = hnulls null
-      }
-    hright table = HEitherTable
-      { htag = HIdentity (Result IsRight)
-      , hleft = hnulls null
-      , hright = hnullify nullifier table
-      }
-{-# INLINABLE toHEitherTable #-}
-
-
-fromHEitherTable :: (HTable t, HTable u)
-  => HEitherTable t u (Col Identity)
-  -> Either (t (Col Identity)) (u (Col Identity))
-fromHEitherTable HEitherTable {htag, hleft, hright} = case htag of
-  HIdentity (Result tag) -> case tag of
-    IsLeft -> maybe err Left $ hunnullify unnullifier hleft
-    IsRight -> maybe err Right $ hunnullify unnullifier hright
-  where
-    err = error "fromHEitherTable: mismatch between tag and data"
-{-# INLINABLE fromHEitherTable #-}
-
-
-toHListTable :: HTable t => [t (Col Identity)] -> HListTable t (Col Identity)
-toHListTable = hvectorize vectorizer
-{-# INLINABLE toHListTable #-}
-
-
-fromHListTable :: HTable t => HListTable t (Col Identity) -> [t (Col Identity)]
-fromHListTable = hunvectorize unvectorizer
-{-# INLINABLE fromHListTable #-}
-
-
-toHMaybeTable :: HTable t => Maybe (t (Col Identity)) -> HMaybeTable t (Col Identity)
-toHMaybeTable = maybe hnothing hjust
-  where
-    hnothing = HMaybeTable
-      { htag = HIdentity (Result Nothing)
-      , hjust = hnulls null
-      }
-    hjust table = HMaybeTable
-      { htag = HIdentity (Result (Just IsJust))
-      , hjust = hnullify nullifier table
-      }
-{-# INLINABLE toHMaybeTable #-}
-
-
-fromHMaybeTable :: HTable t => HMaybeTable t (Col Identity) -> Maybe (t (Col Identity))
-fromHMaybeTable HMaybeTable {htag, hjust} = case htag of
-  HIdentity (Result tag) -> tag $>
-    case hunnullify unnullifier hjust of
-      Nothing -> error "fromHMaybeTable: mismatch between tag and data"
-      Just just -> just
-{-# INLINABLE fromHMaybeTable #-}
-
-
-toHNonEmptyTable :: HTable t => NonEmpty (t (Col Identity)) -> HNonEmptyTable t (Col Identity)
-toHNonEmptyTable = hvectorize vectorizer
-{-# INLINABLE toHNonEmptyTable #-}
-
-
-fromHNonEmptyTable :: HTable t => HNonEmptyTable t (Col Identity) -> NonEmpty (t (Col Identity))
-fromHNonEmptyTable = hunvectorize unvectorizer
-{-# INLINABLE fromHNonEmptyTable #-}
-
-
-toHTheseTable :: (HTable t, HTable u)
-  => These (t (Col Identity)) (u (Col Identity))
-  -> HTheseTable t u (Col Identity)
-toHTheseTable tables = HTheseTable
-  { hhereTag = relabel hhereTag
-  , hhere
-  , hthereTag = relabel hthereTag
-  , hthere
-  }
-  where
-    HMaybeTable
-      { htag = hhereTag
-      , hjust = hhere
-      } = toHMaybeTable (justHere tables)
-    HMaybeTable
-      { htag = hthereTag
-      , hjust = hthere
-      } = toHMaybeTable (justThere tables)
-{-# INLINABLE toHTheseTable #-}
-
-
-fromHTheseTable :: (HTable t, HTable u)
-  => HTheseTable t u (Col Identity)
-  -> These (t (Col Identity)) (u (Col Identity))
-fromHTheseTable HTheseTable {hhereTag, hhere, hthereTag, hthere} =
-  case (fromHMaybeTable mhere, fromHMaybeTable mthere) of
-    (Just a, Nothing) -> This a
-    (Nothing, Just b) -> That b
-    (Just a, Just b) -> These a b
-    _ -> error "fromHTheseTable: mismatch between tags and data"
-  where
-    mhere = HMaybeTable
-      { htag = relabel hhereTag
-      , hjust = hhere
-      }
-    mthere = HMaybeTable
-      { htag = relabel hthereTag
-      , hjust = hthere
-      }
-{-# INLINABLE fromHTheseTable #-}
-
-
-null :: Col Identity ('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))
-nullifier SSpec {nullity} (Result a) = Result $ case nullity of
-  Null -> a
-  NotNull -> Just a
-
-
-unnullifier :: ()
-  => SSpec ('Spec labels necessity a)
-  -> Col Identity ('Spec labels necessity (Nullify a))
-  -> Maybe (Col Identity ('Spec labels necessity a))
-unnullifier SSpec {nullity} (Result a) =
-  case nullity of
-    Null -> pure $ Result a
-    NotNull -> Result <$> a
-
-
-vectorizer :: Functor f
-  => SSpec ('Spec labels necessity a)
-  -> f (Col Identity ('Spec labels necessity a))
-  -> Col Identity ('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))
-unvectorizer _ (Result results) = Result <$> results
-
-
-relabel :: ()
-  => HIdentity ('Spec labels necessity a) (Col Identity)
-  -> HIdentity ('Spec relabels necessity a) (Col Identity)
-relabel (HIdentity (Result a)) = HIdentity (Result a)
--- a/src/Rel8/Schema/Field.hs
+++ b/src/Rel8/Schema/Field.hs
@ -1,34 +1,725 @@
 {-# language DataKinds #-}
+{-# language FlexibleContexts #-}
+{-# language GADTs #-}
+{-# language LambdaCase #-}
+{-# language MultiParamTypeClasses #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
+{-# language UndecidableInstances #-}

 module Rel8.Schema.Field
  ( Field
+  , HEither, HList, HMaybe, HNonEmpty, HThese
+  , Reify, hreify, hunreify
+  , Reifiable
+  , AField(..)
+  , AHEither(..), AHList(..), AHMaybe(..), AHNonEmpty(..), AHThese(..)
  )
 where

 -- base
+import Data.Bifunctor ( Bifunctor, bimap )
 import Data.Functor.Identity ( Identity )
-import Data.Kind ( Type )
+import Data.Kind ( Constraint, Type )
+import Data.List.NonEmpty ( NonEmpty )
 import Prelude

 -- rel8
-import Rel8.Aggregate ( Aggregate )
-import Rel8.Expr ( Expr )
-import Rel8.Kind.Labels ( Labels )
-import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
-import Rel8.Schema.Insert ( Insert )
+import Rel8.Aggregate ( Aggregate, Col(..) )
+import Rel8.Expr ( Expr, Col(..) )
+import Rel8.Kind.Necessity
+  ( Necessity( Required, Optional )
+  , SNecessity( SRequired, SOptional )
+  , KnownNecessity, necessitySing
+  )
+import Rel8.Schema.Context ( Interpretation, Col(..) )
+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
+import Rel8.Schema.HTable ( HTable, hfield, htabulate )
+import Rel8.Schema.HTable.Either ( HEitherTable )
+import Rel8.Schema.HTable.List ( HListTable )
+import Rel8.Schema.HTable.Maybe ( HMaybeTable )
+import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
+import Rel8.Schema.HTable.These ( HTheseTable )
+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
+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.Spec ( Spec( Spec ) )
-import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )
+import Rel8.Table
+  ( Table, Columns, Context, fromColumns, toColumns
+  , Congruent
+  )
+import Rel8.Table.Either ( EitherTable )
+import Rel8.Table.List ( ListTable( ListTable ) )
+import Rel8.Table.Maybe ( MaybeTable )
+import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
+import Rel8.Table.Recontextualize ( Recontextualize )
+import Rel8.Table.These ( TheseTable )
+import Rel8.Type ( DBType )
+
+-- these
+import Data.These ( These )


-type Field :: K.Context -> Labels -> Necessity -> Type -> Type
-type family Field labels context necessity a where
-  Field Identity  _labels _necessity a = a
-  Field Expr      _labels _necessity a = Expr a
-  Field Insert    _labels 'Required  a = Expr a
-  Field Insert    _labels 'Optional  a = Maybe (Expr a)
-  Field Aggregate _labels _necessity a = Aggregate (Expr a)
-  Field Structure labels  necessity  a = Shape1 'Column ('Spec labels necessity a)
-  Field context   _labels _necessity a = context a
+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 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
+
+
+type HEither :: K.Context -> Type -> Type -> Type
+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
+
+
+type HList :: K.Context -> Type -> Type
+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 _ = []
+
+
+type HMaybe :: K.Context -> Type -> Type
+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
+
+
+type HNonEmpty :: K.Context -> Type -> Type
+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
+
+
+type HThese :: K.Context -> Type -> Type -> Type
+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
+
+
+type AField :: K.Context -> Necessity -> Type -> Type
+newtype AField context necessity a = AField (Field context necessity a)
+
+
+instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
+  Table (Reify context) (AField context necessity a)
+ where
+  type Context (AField context necessity a) = Reify context
+  type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)
+
+  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
+  toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , KnownNecessity necessity, Sql DBType a
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AField context necessity a)
+    (AField context' necessity a)
+
+
+type AHEither :: K.Context -> Type -> Type -> Type
+newtype AHEither context a b = AHEither (HEither context a b)
+
+
+instance Reifiable context => Bifunctor (AHEither context) where
+  bimap = sbimapEither contextSing
+
+
+instance Reifiable context => Functor (AHEither context a) where
+  fmap = bimap id
+
+
+instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
+  => Table (Reify context) (AHEither context a b)
+ where
+  type Context (AHEither context a b) = Reify context
+  type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
+
+  fromColumns = sfromColumnsEither contextSing
+  toColumns = stoColumnsEither contextSing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , Recontextualize (Reify context) (Reify context') a a'
+  , Recontextualize (Reify context) (Reify context') b b'
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AHEither context a b)
+    (AHEither context' a' b')
+
+
+type AHList :: K.Context -> Type -> Type
+newtype AHList context a = AHList (HList context a)
+
+
+instance (Reifiable context, Table (Reify context) a) =>
+  Table (Reify context) (AHList context a)
+ where
+  type Context (AHList context a) = Reify context
+  type Columns (AHList context a) = HListTable (Columns a)
+
+  fromColumns = sfromColumnsList contextSing
+  toColumns = stoColumnsList contextSing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , Recontextualize (Reify context) (Reify context') a a'
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AHList context a)
+    (AHList context' a')
+
+
+type AHMaybe :: K.Context -> Type -> Type
+newtype AHMaybe context a = AHMaybe (HMaybe context a)
+
+
+instance Reifiable context => Functor (AHMaybe context) where
+  fmap = smapMaybe contextSing
+
+
+instance (Reifiable context, Table (Reify context) a) =>
+  Table (Reify context) (AHMaybe context a)
+ where
+  type Context (AHMaybe context a) = Reify context
+  type Columns (AHMaybe context a) = HMaybeTable (Columns a)
+
+  fromColumns = sfromColumnsMaybe contextSing
+  toColumns = stoColumnsMaybe contextSing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , Recontextualize (Reify context) (Reify context') a a'
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AHMaybe context a)
+    (AHMaybe context' a')
+
+
+type AHNonEmpty :: K.Context -> Type -> Type
+newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
+
+
+instance (Reifiable context, Table (Reify context) a) =>
+  Table (Reify context) (AHNonEmpty context a)
+ where
+  type Context (AHNonEmpty context a) = Reify context
+  type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
+
+  fromColumns = sfromColumnsNonEmpty contextSing
+  toColumns = stoColumnsNonEmpty contextSing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , Recontextualize (Reify context) (Reify context') a a'
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AHNonEmpty context a)
+    (AHNonEmpty context' a')
+
+
+type AHThese :: K.Context -> Type -> Type -> Type
+newtype AHThese context a b = AHThese (HThese context a b)
+
+
+instance Reifiable context => Bifunctor (AHThese context) where
+  bimap = sbimapThese contextSing
+
+
+instance Reifiable context => Functor (AHThese context a) where
+  fmap = bimap id
+
+
+instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
+  => Table (Reify context) (AHThese context a b)
+ where
+  type Context (AHThese context a b) = Reify context
+  type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
+
+  fromColumns = sfromColumnsThese contextSing
+  toColumns = stoColumnsThese contextSing
+
+
+instance
+  ( Reifiable context, Reifiable context'
+  , Recontextualize (Reify context) (Reify context') a a'
+  , Recontextualize (Reify context) (Reify context') b b'
+  ) =>
+  Recontextualize
+    (Reify context)
+    (Reify context')
+    (AHThese context a b)
+    (AHThese context' a' b')
+
+
+type SContext :: K.Context -> Type
+data SContext context where
+  SAggregate :: SContext Aggregate
+  SExpr :: SContext Expr
+  SIdentity :: SContext Identity
+  SInsert :: SContext Insert
+  SName :: SContext Name
+  SReify :: SContext context -> SContext (Reify context)
+
+
+type Reifiable :: K.Context -> Constraint
+class Interpretation context => Reifiable context where
+  contextSing :: SContext context
+
+
+instance Reifiable Aggregate where
+  contextSing = SAggregate
+
+
+instance Reifiable Expr where
+  contextSing = SExpr
+
+
+instance Reifiable Identity where
+  contextSing = SIdentity
+
+
+instance Reifiable Insert where
+  contextSing = SInsert
+
+
+instance Reifiable Name where
+  contextSing = SName
+
+
+type Reify :: K.Context -> K.Context
+data Reify context a
+
+
+instance Interpretation (Reify context) where
+  newtype Col (Reify context) spec = Reify (Col context spec)
+
+
+instance Labelable context => Labelable (Reify context) where
+  labeler (Reify a) = Reify (labeler a)
+  unlabeler (Reify a) = Reify (unlabeler a)
+
+
+instance Reifiable context => Reifiable (Reify context) where
+  contextSing = SReify contextSing
+
+
+sfromColumn :: ()
+  => SContext context
+  -> Col context ('Spec labels necessity a)
+  -> AField context necessity a
+sfromColumn = \case
+  SAggregate -> \(Aggregation a) -> AField a
+  SExpr -> \(DB a) -> AField a
+  SIdentity -> \(Result a) -> AField a
+  SInsert -> \case
+    RequiredInsert a -> AField a
+    OptionalInsert a -> AField a
+  SName -> \(NameCol a) -> AField (Name a)
+  SReify context -> \(Reify a) -> AField (sfromColumn context a)
+
+
+stoColumn :: ()
+  => SContext context
+  -> SNecessity necessity
+  -> AField context necessity a
+  -> Col context ('Spec labels necessity a)
+stoColumn = \case
+  SAggregate -> \_ (AField a) -> Aggregation a
+  SExpr -> \_ (AField a) -> DB a
+  SIdentity -> \_ (AField a) -> Result a
+  SInsert -> \case
+    SRequired -> \(AField a) -> RequiredInsert a
+    SOptional -> \(AField a) -> OptionalInsert a
+  SName -> \_ (AField (Name a)) -> NameCol a
+  SReify context ->
+    \necessity (AField a) -> Reify (stoColumn context necessity a)
+
+
+sbimapEither :: ()
+  => SContext context
+  -> (a -> c)
+  -> (b -> d)
+  -> AHEither context a b
+  -> AHEither context c d
+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)
+  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)
+
+
+sfromColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
+  => SContext context
+  -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
+  -> AHEither context a b
+sfromColumnsEither = \case
+  SAggregate ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SExpr ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SIdentity ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SInsert ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SName ->
+    AHEither .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SReify context ->
+    AHEither .
+    sbimapEither context (fromColumns . hreify) (fromColumns . hreify) .
+    sfromColumnsEither context .
+    hunreify
+
+
+stoColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
+  => SContext context
+  -> AHEither context a b
+  -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
+stoColumnsEither = \case
+  SAggregate ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+  SExpr ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+  SIdentity ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+  SInsert ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+  SName ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+  SReify context ->
+    hreify .
+    stoColumnsEither context .
+    sbimapEither context (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHEither a) -> a)
+
+
+smapList :: Congruent a b
+  => SContext context
+  -> (a -> b)
+  -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
+  -> AHList context a
+  -> AHList context 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)
+  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)
+
+
+sfromColumnsList :: Table (Reify context) a
+  => SContext context
+  -> HListTable (Columns a) (Col (Reify context))
+  -> AHList context a
+sfromColumnsList = \case
+  SAggregate -> AHList . ListTable
+  SExpr -> AHList . ListTable
+  SIdentity -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SInsert -> AHList . ListTable
+  SName -> AHList . ListTable
+  SReify context ->
+    AHList .
+    smapList context (fromColumns . hreify) hreify .
+    sfromColumnsList context .
+    hunreify
+
+
+stoColumnsList :: Table (Reify context) a
+  => SContext context
+  -> AHList context a
+  -> HListTable (Columns a) (Col (Reify context))
+stoColumnsList = \case
+  SAggregate -> \(AHList (ListTable a)) -> a
+  SExpr -> \(AHList (ListTable a)) -> a
+  SIdentity ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
+  SInsert -> \(AHList (ListTable a)) -> a
+  SName -> \(AHList (ListTable a)) -> a
+  SReify context ->
+    hreify .
+    stoColumnsList context .
+    smapList context (hunreify . toColumns) hunreify .
+    (\(AHList a) -> a)
+
+
+smapMaybe :: ()
+  => SContext context
+  -> (a -> b)
+  -> AHMaybe context a
+  -> AHMaybe context b
+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)
+  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)
+
+
+sfromColumnsMaybe :: Table (Reify context) a
+  => SContext context
+  -> HMaybeTable (Columns a) (Col (Reify context))
+  -> AHMaybe 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
+  SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SReify context ->
+    AHMaybe .
+    smapMaybe context (fromColumns . hreify) .
+    sfromColumnsMaybe context .
+    hunreify
+
+
+stoColumnsMaybe :: Table (Reify context) a
+  => SContext context
+  -> AHMaybe context a
+  -> HMaybeTable (Columns a) (Col (Reify context))
+stoColumnsMaybe = \case
+  SAggregate ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SExpr ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SIdentity ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SInsert ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SName ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
+  SReify context ->
+    hreify .
+    stoColumnsMaybe context .
+    smapMaybe context (hunreify . toColumns) .
+    (\(AHMaybe a) -> a)
+
+
+smapNonEmpty :: Congruent a b
+  => SContext context
+  -> (a -> b)
+  -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
+  -> AHNonEmpty context a
+  -> AHNonEmpty context 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)
+  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)
+
+
+sfromColumnsNonEmpty :: Table (Reify context) a
+  => SContext context
+  -> HNonEmptyTable (Columns a) (Col (Reify context))
+  -> AHNonEmpty context a
+sfromColumnsNonEmpty = \case
+  SAggregate -> AHNonEmpty . NonEmptyTable
+  SExpr -> AHNonEmpty . NonEmptyTable
+  SIdentity ->
+    AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
+  SInsert -> AHNonEmpty . NonEmptyTable
+  SName -> AHNonEmpty . NonEmptyTable
+  SReify context ->
+    AHNonEmpty .
+    smapNonEmpty context (fromColumns . hreify) hreify .
+    sfromColumnsNonEmpty context .
+    hunreify
+
+
+stoColumnsNonEmpty :: Table (Reify context) a
+  => SContext context
+  -> AHNonEmpty context a
+  -> HNonEmptyTable (Columns a) (Col (Reify context))
+stoColumnsNonEmpty = \case
+  SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SIdentity ->
+    hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
+  SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
+  SReify context ->
+    hreify .
+    stoColumnsNonEmpty context .
+    smapNonEmpty context (hunreify . toColumns) hunreify .
+    (\(AHNonEmpty a) -> a)
+
+
+sbimapThese :: ()
+  => SContext context
+  -> (a -> c)
+  -> (b -> d)
+  -> AHThese context a b
+  -> AHThese context c d
+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)
+  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)
+
+
+sfromColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
+  => SContext context
+  -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
+  -> AHThese context a b
+sfromColumnsThese = \case
+  SAggregate ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SExpr ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SIdentity ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SInsert ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SName ->
+    AHThese .
+    bimap (fromColumns . hreify) (fromColumns . hreify) .
+    fromColumns .
+    hunreify
+  SReify context ->
+    AHThese .
+    sbimapThese context (fromColumns . hreify) (fromColumns . hreify) .
+    sfromColumnsThese context .
+    hunreify
+
+
+stoColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
+  => SContext context
+  -> AHThese context a b
+  -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
+stoColumnsThese = \case
+  SAggregate ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+  SExpr ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+  SIdentity ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+  SInsert ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+  SName ->
+    hreify .
+    toColumns .
+    bimap (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+  SReify context ->
+    hreify .
+    stoColumnsThese context .
+    sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
+    (\(AHThese a) -> a)
+
+
+hreify :: HTable t => t (Col context) -> t (Col (Reify context))
+hreify a = htabulate $ \field -> Reify (hfield a field)
+
+
+hunreify :: HTable t => t (Col (Reify context)) -> t (Col context)
+hunreify a = htabulate $ \field -> case hfield a field of
+  Reify x -> x
--- a/src/Rel8/Schema/Generic.hs
+++ b/src/Rel8/Schema/Generic.hs
--- a/src/Rel8/Schema/Generic/Test.hs
+++ b/src/Rel8/Schema/Generic/Test.hs
@ -4,8 +4,6 @@
 {-# language DerivingStrategies #-}
 {-# language DuplicateRecordFields #-}

-{-# options_ghc -O0 #-}
-
 module Rel8.Schema.Generic.Test
  ( module Rel8.Schema.Generic.Test
  )
@ -17,6 +15,7 @@ import Prelude

 -- rel8
 import Rel8.Schema.Column
+import Rel8.Schema.Field
 import Rel8.Schema.Generic

 -- text
@ -24,7 +23,7 @@ import Data.Text ( Text )


 data Table f = Table
-  { foo :: Column f (Label "blah" Bool)
+  { foo :: Column f Bool
  , bar :: Column f (Maybe Bool)
  }
  deriving stock Generic
@ -40,7 +39,7 @@ data TablePair f = TablePair


 data TableMaybe f = TableMaybe
-  { foo :: Column f (Label "ABC" [Maybe Bool])
+  { foo :: Column f [Maybe Bool]
  , bars :: HMaybe f (TablePair f, TablePair f)
  }
  deriving stock Generic
@ -49,7 +48,7 @@ data TableMaybe f = TableMaybe

 data TableEither f = TableEither
  { foo :: Column f Bool
-  , bars :: HEither f (HMaybe f (TablePair f, TablePair f)) (Column f (Label "XYZ" Char))
+  , bars :: HEither f (HMaybe f (TablePair f, TablePair f)) (Column f Char)
  }
  deriving stock Generic
  deriving anyclass Rel8able
--- a/src/Rel8/Schema/HTable/Either.hs
+++ b/src/Rel8/Schema/HTable/Either.hs
@ -2,27 +2,22 @@
 {-# language DeriveAnyClass #-}
 {-# language DeriveGeneric #-}
 {-# language DerivingStrategies #-}
-{-# language FlexibleInstances #-}
 {-# language StandaloneKindSignatures #-}
-{-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}

 module Rel8.Schema.HTable.Either
  ( HEitherTable(..)
-  , HEitherNullifiable
  )
 where

 -- base
-import Data.Kind ( Constraint )
 import GHC.Generics ( Generic )
 import Prelude ()

 -- rel8
 import Rel8.Kind.Necessity ( Necessity( Required ) )
-import Rel8.Schema.Context.Nullify ( HNullifiable, HConstrainTag )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
+import Rel8.Schema.HTable.Label ( HLabel )
 import Rel8.Schema.HTable.Nullify ( HNullify )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Spec ( Spec( Spec ) )
@ -32,13 +27,8 @@ import Rel8.Type.Tag ( EitherTag )
 type HEitherTable :: K.HTable -> K.HTable -> K.HTable
 data HEitherTable left right context = HEitherTable
  { htag :: HIdentity ('Spec '["isRight"] 'Required EitherTag) context
-  , hleft :: HNullify left context
-  , hright :: HNullify right context
+  , hleft :: HLabel "Left" (HNullify left) context
+  , hright :: HLabel "Right" (HNullify right) context
  }
  deriving stock Generic
  deriving anyclass HTable
-
-
-type HEitherNullifiable :: K.HContext -> Constraint
-class (HNullifiable context, HConstrainTag context EitherTag) => HEitherNullifiable context
-instance (HNullifiable context, HConstrainTag context EitherTag) => HEitherNullifiable context
--- a/src/Rel8/Schema/HTable/MapTable.hs
+++ b/src/Rel8/Schema/HTable/MapTable.hs
@ -35,13 +35,15 @@ import Rel8.Schema.Dict ( Dict( Dict ) )


 type HMapTable :: (a -> Exp b) -> ((a -> Type) -> Type) -> (b -> Type) -> Type
-data HMapTable f t g where
-  HMapTable :: { unHMapTable :: t (Precompose f g) } -> HMapTable f t g
+newtype HMapTable f t g = HMapTable
+  { unHMapTable :: t (Precompose f g)
+  }


 type Precompose :: (a -> Exp b) -> (b -> Type) -> a -> Type
-newtype Precompose f g x where
-  Precompose :: { precomposed :: g (Eval (f x)) } -> Precompose f g x
+newtype Precompose f g x = Precompose
+  { precomposed :: g (Eval (f x))
+  }


 type HMapTableField :: (Spec -> Exp a) -> K.HTable -> a -> Type
@ -64,6 +66,7 @@ instance (HTable t, MapSpec f) => HTable (HMapTable f t) where

  htraverse f (HMapTable x) = 
    HMapTable <$> htraverse (fmap Precompose . f . precomposed) x
+  {-# INLINABLE htraverse #-}

  hdicts :: forall c. HConstrainTable (HMapTable f t) c => HMapTable f t (Dict c)
  hdicts = 
@ -73,6 +76,7 @@ instance (HTable t, MapSpec f) => HTable (HMapTable f t) where

  hspecs = 
    HMapTable $ htabulate $ Precompose . mapInfo @f . hfield hspecs
+  {-# INLINABLE hspecs #-}


 type MapSpec :: (Spec -> Exp Spec) -> Constraint
--- a/src/Rel8/Schema/HTable/Maybe.hs
+++ b/src/Rel8/Schema/HTable/Maybe.hs
@ -2,42 +2,32 @@
 {-# language DeriveAnyClass #-}
 {-# language DeriveGeneric #-}
 {-# language DerivingStrategies #-}
-{-# language FlexibleInstances #-}
 {-# language StandaloneKindSignatures #-}
-{-# language UndecidableInstances #-}
-{-# language UndecidableSuperClasses #-}

 module Rel8.Schema.HTable.Maybe
  ( HMaybeTable(..)
-  , HMaybeNullifiable
  )
 where

 -- base
-import Data.Kind ( Constraint )
 import GHC.Generics ( Generic )
 import Prelude

 -- rel8
 import Rel8.Kind.Necessity ( Necessity( Required ) )
-import Rel8.Schema.Context.Nullify ( HConstrainTag, HNullifiable )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
+import Rel8.Schema.HTable.Label ( HLabel )
+import Rel8.Schema.HTable.Nullify ( HNullify )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Spec ( Spec( Spec ) )
 import Rel8.Type.Tag ( MaybeTag )
-import Rel8.Schema.HTable.Nullify ( HNullify )


 type HMaybeTable :: K.HTable -> K.HTable
 data HMaybeTable table context = HMaybeTable
  { htag :: HIdentity ('Spec '["isJust"] 'Required (Maybe MaybeTag)) context
-  , hjust :: HNullify table context
+  , hjust :: HLabel "Just" (HNullify table) context
  }
  deriving stock Generic
  deriving anyclass HTable
-
-
-type HMaybeNullifiable :: K.HContext -> Constraint
-class (HNullifiable context, HConstrainTag context MaybeTag) => HMaybeNullifiable context
-instance (HNullifiable context, HConstrainTag context MaybeTag) => HMaybeNullifiable context
--- a/src/Rel8/Schema/HTable/These.hs
+++ b/src/Rel8/Schema/HTable/These.hs
@ -17,6 +17,7 @@ import Prelude
 import Rel8.Kind.Necessity ( Necessity( Required ) )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity )
+import Rel8.Schema.HTable.Label ( HLabel )
 import Rel8.Schema.HTable.Nullify ( HNullify )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Spec ( Spec( Spec ) )
@ -26,9 +27,9 @@ import Rel8.Type.Tag ( MaybeTag )
 type HTheseTable :: K.HTable -> K.HTable -> K.HTable
 data HTheseTable here there context = HTheseTable
  { hhereTag :: HIdentity ('Spec '["hasHere"] 'Required (Maybe MaybeTag)) context
-  , hhere :: HNullify here context
+  , hhere :: HLabel "Here" (HNullify here) context
  , hthereTag :: HIdentity ('Spec '["hasThere"] 'Required (Maybe MaybeTag)) context
-  , hthere :: HNullify there context
+  , hthere :: HLabel "There" (HNullify there) context
  }
  deriving stock Generic
  deriving anyclass HTable
--- a/src/Rel8/Schema/HTable/Vectorize.hs
+++ b/src/Rel8/Schema/HTable/Vectorize.hs
@ -23,7 +23,6 @@ module Rel8.Schema.HTable.Vectorize
  ( HVectorize
  , hvectorize, hunvectorize
  , happend, hempty
-  , hrelabel
  )
 where

@ -150,10 +149,3 @@ hempty empty = HVectorize $ htabulate $ \(HMapTableField field) -> case hfield h
 instance HLabelable g => HLabelable (Precompose (Vectorize list) g) where
  hlabeler = Precompose . hlabeler . precomposed
  hunlabeler = Precompose . hunlabeler . precomposed
-
-
-hrelabel :: HLabelable context
-  => (forall ctx. HLabelable ctx => t ctx -> u ctx)
-  -> HVectorize list t context
-  -> HVectorize list u context
-hrelabel f (HVectorize (HMapTable table)) = HVectorize (HMapTable (f table))
--- a/src/Rel8/Schema/Insert.hs
+++ b/src/Rel8/Schema/Insert.hs
@ -15,8 +15,8 @@ module Rel8.Schema.Insert
  ( Insert(..)
  , OnConflict(..)
  , Col( RequiredInsert, OptionalInsert )
-  , Insertion(..)
  , Inserts
+  , Insertion(..)
  )
 where

@ -35,7 +35,7 @@ import Rel8.Schema.Context.Nullify
  ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
  , runTag, unnull
  )
-import Rel8.Schema.HTable.Type ( HType(HType) )
+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 )
--- a/src/Rel8/Schema/Structure.hs
+++ b/src/Rel8/Schema/Structure.hs
@ -1,54 +1,17 @@
 {-# language DataKinds #-}
 {-# language StandaloneKindSignatures #-}
-{-# language PolyKinds #-}
-{-# language TypeFamilies #-}

 module Rel8.Schema.Structure
  ( Structure
-  , Shape( Column, Either, List, Maybe, NonEmpty, These )
-  , Shape1
-  , Shape2
-  , IsStructure
  )
 where

 -- base
-import Data.Kind ( Type )
-import Prelude
+import Prelude ()

 -- rel8
-import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Spec ( Spec )
+import Rel8.Schema.Kind ( Context )


-type Structure :: K.Context
+type Structure :: Context
 data Structure a
-
-
-type Shape :: Type
-data Shape
-  = Column Spec
-  | Either Type Type
-  | List Type
-  | Maybe Type
-  | NonEmpty Type
-  | These Type Type
-
-
-type Shape1 :: (a -> Shape) -> a -> Type
-data Shape1 shape a
-
-
-type Shape2 :: (a -> b -> Shape) -> a -> b -> Type
-data Shape2 shape a b
-
-
-type IsStructure :: Type -> Bool
-type family IsStructure a where
-  IsStructure (Shape1 _ _) = 'True
-  IsStructure (Shape2 _ _ _) = 'True
-  IsStructure (_, _) = 'True
-  IsStructure (_, _, _) = 'True
-  IsStructure (_, _, _, _) = 'True
-  IsStructure (_, _, _, _, _) = 'True
-  IsStructure _ = 'False
--- a/src/Rel8/Table.hs
+++ b/src/Rel8/Table.hs
@ -3,8 +3,11 @@
 {-# language FlexibleContexts #-}
 {-# language FlexibleInstances #-}
 {-# language FunctionalDependencies #-}
+{-# language LambdaCase #-}
+{-# language NamedFieldPuns #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
+{-# language TypeOperators #-}
 {-# language UndecidableInstances #-}

 module Rel8.Table
@ -15,25 +18,39 @@ module Rel8.Table
 where

 -- base
+import Data.Functor ( ($>) )
 import Data.Functor.Identity ( Identity( Identity ) )
 import Data.Kind ( Constraint, Type )
-import Prelude
+import Data.List.NonEmpty ( NonEmpty )
+import Prelude hiding ( null )

 -- rel8
 import Rel8.Schema.Context ( Col(..) )
 import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable ( HTable )
+import Rel8.Schema.HTable.Either ( HEitherTable(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
+import Rel8.Schema.HTable.List ( HListTable )
+import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
+import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
+import Rel8.Schema.HTable.Nullify ( hnulls, hnullify, hunnullify )
 import Rel8.Schema.HTable.Pair ( HPair(..) )
 import Rel8.Schema.HTable.Quartet ( HQuartet(..) )
 import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
+import Rel8.Schema.HTable.These ( HTheseTable(..) )
 import Rel8.Schema.HTable.Trio ( HTrio(..) )
 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 ( Sql )
-import Rel8.Schema.Spec ( KnownSpec )
+import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..), KnownSpec )
 import Rel8.Type ( DBType )
+import Rel8.Type.Tag ( EitherTag( IsLeft, IsRight ),  MaybeTag( IsJust ) )
+
+-- these
+import Data.These ( These( This, That, These ) )
+import Data.These.Combinators ( justHere, justThere )


 -- | @Table@s are one of the foundational elements of Rel8, and describe data
@ -85,6 +102,106 @@ instance Sql DBType a => Table Identity (Identity a) where
  fromColumns (HType (Result a)) = Identity a


+instance (Table Identity a, Table Identity b) => Table Identity (Either a b)
+ where
+  type Columns (Either a b) = HEitherTable (Columns a) (Columns b)
+  type Context (Either a b) = Identity
+
+  toColumns = \case
+    Left table -> HEitherTable
+      { htag = HIdentity (Result IsLeft)
+      , hleft = hlabel labeler (hnullify nullifier (toColumns table))
+      , hright = hlabel labeler (hnulls null)
+      }
+    Right table -> HEitherTable
+      { htag = HIdentity (Result IsRight)
+      , hleft = hlabel labeler (hnulls null)
+      , hright = hlabel labeler (hnullify nullifier (toColumns table))
+      }
+
+  fromColumns HEitherTable {htag, hleft, hright} = case htag of
+    HIdentity (Result tag) -> case tag of
+      IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hleft)
+      IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hright)
+    where
+      err = error "Either.fromColumns: mismatch between tag and data"
+
+
+instance Table Identity a => Table Identity [a] where
+  type Columns [a] = HListTable (Columns a)
+  type Context [a] = Identity
+
+  toColumns = hvectorize vectorizer . fmap toColumns
+  fromColumns = fmap fromColumns . hunvectorize unvectorizer
+
+
+instance Table Identity a => Table Identity (Maybe a) where
+  type Columns (Maybe a) = HMaybeTable (Columns a)
+  type Context (Maybe a) = Identity
+
+  toColumns = \case
+    Nothing -> HMaybeTable
+      { htag = HIdentity (Result Nothing)
+      , hjust = hlabel labeler (hnulls null)
+      }
+    Just table -> HMaybeTable
+      { htag = HIdentity (Result (Just IsJust))
+      , hjust = hlabel labeler (hnullify nullifier (toColumns table))
+      }
+
+  fromColumns HMaybeTable {htag, hjust} = case htag of
+    HIdentity (Result tag) -> tag $>
+      case hunnullify unnullifier (hunlabel unlabeler hjust) of
+        Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
+        Just just -> fromColumns just
+
+
+instance Table Identity a => Table Identity (NonEmpty a) where
+  type Columns (NonEmpty a) = HNonEmptyTable (Columns a)
+  type Context (NonEmpty a) = Identity
+
+  toColumns = hvectorize vectorizer . fmap toColumns
+  fromColumns = fmap fromColumns . hunvectorize unvectorizer
+
+
+instance (Table Identity a, Table Identity b) => Table Identity (These a b)
+ where
+  type Columns (These a b) = HTheseTable (Columns a) (Columns b)
+  type Context (These a b) = Identity
+
+  toColumns tables = HTheseTable
+    { hhereTag = relabel hhereTag
+    , hhere = hlabel labeler (hunlabel unlabeler (toColumns hhere))
+    , hthereTag = relabel hthereTag
+    , hthere = hlabel labeler (hunlabel unlabeler (toColumns hthere))
+    }
+    where
+      HMaybeTable
+        { htag = hhereTag
+        , hjust = hhere
+        } = toColumns (justHere tables)
+      HMaybeTable
+        { htag = hthereTag
+        , hjust = hthere
+        } = toColumns (justThere tables)
+
+  fromColumns HTheseTable {hhereTag, hhere, hthereTag, hthere} =
+    case (fromColumns mhere, fromColumns mthere) of
+      (Just a, Nothing) -> This (fromColumns a)
+      (Nothing, Just b) -> That (fromColumns b)
+      (Just a, Just b) -> These (fromColumns a) (fromColumns b)
+      _ -> error "These.fromColumns: mismatch between tags and data"
+    where
+      mhere = HMaybeTable
+        { htag = relabel hhereTag
+        , hjust = hlabel labeler (hunlabel unlabeler hhere)
+        }
+      mthere = HMaybeTable
+        { htag = relabel hthereTag
+        , hjust = hlabel labeler (hunlabel unlabeler hthere)
+        }
+
+
 instance
  ( Table context a, Table context b
  , Labelable context
@ -192,3 +309,46 @@ instance
 type Congruent :: Type -> Type -> Constraint
 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 = Result Nothing
+
+
+nullifier :: ()
+  => SSpec ('Spec labels necessity a)
+  -> Col Identity ('Spec labels necessity a)
+  -> Col Identity ('Spec labels necessity (Nullify a))
+nullifier SSpec {nullity} (Result a) = Result $ case nullity of
+  Null -> a
+  NotNull -> Just a
+
+
+unnullifier :: ()
+  => SSpec ('Spec labels necessity a)
+  -> Col Identity ('Spec labels necessity (Nullify a))
+  -> Maybe (Col Identity ('Spec labels necessity a))
+unnullifier SSpec {nullity} (Result a) =
+  case nullity of
+    Null -> pure $ Result a
+    NotNull -> Result <$> a
+
+
+vectorizer :: Functor f
+  => SSpec ('Spec labels necessity a)
+  -> f (Col Identity ('Spec labels necessity a))
+  -> Col Identity ('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))
+unvectorizer _ (Result results) = Result <$> results
+
+
+relabel :: ()
+  => HIdentity ('Spec labels necessity a) (Col Identity)
+  -> HIdentity ('Spec relabels necessity a) (Col Identity)
+relabel (HIdentity (Result a)) = HIdentity (Result a)
--- a/src/Rel8/Table/Either.hs
+++ b/src/Rel8/Table/Either.hs
@ -30,23 +30,25 @@ import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
 import Rel8.Expr.Serialize ( litExpr )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )
+import Rel8.Schema.Context.Label
+  ( Labelable
+  , HLabelable, hlabeler, hunlabeler
+  )
 import Rel8.Schema.Context.Nullify
  ( Nullifiable, ConstrainTag
+  , HNullifiable, HConstrainTag
  , hencodeTag, hdecodeTag
  , hnullifier, hunnullifier
  )
-import Rel8.Schema.HTable.Either ( HEitherTable(..), HEitherNullifiable )
+import Rel8.Schema.HTable ( HTable )
+import Rel8.Schema.HTable.Either ( HEitherTable(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
+import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
 import Rel8.Schema.Name ( Name )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Bool ( bool )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Lifted
-  ( Table2, Columns2, ConstrainHContext2, fromColumns2, toColumns2
-  )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
@ -95,51 +97,17 @@ instance (Table Expr a, Table Expr b) => Semigroup (EitherTable a b) where
  a <> b = bool a b (isRightTable a)


-instance Table2 EitherTable where
-  type Columns2 EitherTable = HEitherTable
-  type ConstrainHContext2 EitherTable = HEitherNullifiable
-
-  toColumns2 f g EitherTable {tag, left, right} = HEitherTable
-    { htag
-    , hleft = hnullify (hnullifier tag isLeft) $ f left
-    , hright = hnullify (hnullifier tag isRight) $ g right
-    }
-    where
-      htag = HIdentity (hencodeTag tag)
-
-  fromColumns2 f g HEitherTable {htag = htag, hleft, hright} =
-    EitherTable
-      { tag
-      , left = f $ runIdentity $
-          hunnullify (\a -> pure . hunnullifier a) hleft
-      , right = g $ runIdentity $
-          hunnullify (\a -> pure . hunnullifier a) hright
-      }
-    where
-      tag = hdecodeTag $ unHIdentity htag
-
-  {-# INLINABLE fromColumns2 #-}
-  {-# INLINABLE toColumns2 #-}
-
-
 instance
  ( Table context a, Table context b
  , Labelable context, Nullifiable context, ConstrainTag context EitherTag
  ) =>
  Table context (EitherTable a b)
 where
-  type Columns (EitherTable a b) =
-    HEitherTable (HLabel "Left" (Columns a)) (HLabel "Right" (Columns b))
+  type Columns (EitherTable a b) = HEitherTable (Columns a) (Columns b)
  type Context (EitherTable a b) = Context a

-  toColumns =
-    toColumns2
-      (hlabel labeler . toColumns)
-      (hlabel labeler . toColumns)
-  fromColumns =
-    fromColumns2
-      (fromColumns . hunlabel unlabeler)
-      (fromColumns . hunlabel unlabeler)
+  toColumns = toColumns2 toColumns toColumns
+  fromColumns = fromColumns2 fromColumns fromColumns


 instance
@ -152,15 +120,11 @@ instance


 instance (EqTable a, EqTable b) => EqTable (EitherTable a b) where
-  eqTable =
-    toColumns2 (hlabel hlabeler) (hlabel hlabeler)
-      (rightTableWith (eqTable @a) (eqTable @b))
+  eqTable = toColumns2 id id (rightTableWith (eqTable @a) (eqTable @b))


 instance (OrdTable a, OrdTable b) => OrdTable (EitherTable a b) where
-  ordTable =
-    toColumns2 (hlabel hlabeler) (hlabel hlabeler)
-      (rightTableWith (ordTable @a) (ordTable @b))
+  ordTable = toColumns2 id id (rightTableWith (ordTable @a) (ordTable @b))


 isLeftTable :: EitherTable a b -> Expr Bool
@ -203,3 +167,49 @@ aggregateEitherTable f g EitherTable {tag, left, right} =

 nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b
 nameEitherTable = EitherTable . fromName
+
+
+toColumns2 ::
+  ( HTable t
+  , HTable u
+  , HConstrainTag context EitherTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (a -> t context)
+  -> (b -> u context)
+  -> EitherTable a b
+  -> HEitherTable t u context
+toColumns2 f g EitherTable {tag, left, right} = HEitherTable
+  { htag
+  , hleft = hlabel hlabeler $ hnullify (hnullifier tag isLeft) $ f left
+  , hright = hlabel hlabeler $ hnullify (hnullifier tag isRight) $ g right
+  }
+  where
+    htag = HIdentity (hencodeTag tag)
+
+
+fromColumns2 ::
+  ( HTable t
+  , HTable u
+  , HConstrainTag context EitherTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (t context -> a)
+  -> (u context -> b)
+  -> HEitherTable t u context
+  -> EitherTable a b
+fromColumns2 f g HEitherTable {htag, hleft, hright} = EitherTable
+  { tag
+  , left = f $ runIdentity $
+     hunnullify (\a -> pure . hunnullifier a) $
+     hunlabel hunlabeler
+     hleft
+  , right = g $ runIdentity $
+     hunnullify (\a -> pure . hunnullifier a) $
+     hunlabel hunlabeler
+     hright
+  }
+  where
+    tag = hdecodeTag $ unHIdentity htag
--- a/src/Rel8/Table/Lifted.hs
+++ b/src/Rel8/Table/Lifted.hs
@ -1,81 +0,0 @@
-{-# language ConstraintKinds #-}
-{-# language DataKinds #-}
-{-# language FlexibleContexts #-}
-{-# language FlexibleInstances #-}
-{-# language MultiParamTypeClasses #-}
-{-# language QuantifiedConstraints #-}
-{-# language StandaloneKindSignatures #-}
-{-# language TypeFamilies #-}
-{-# language UndecidableInstances #-}
-
-module Rel8.Table.Lifted
-  ( Table1( Columns1, ConstrainHContext1, toColumns1, fromColumns1 )
-  , Table2( Columns2, ConstrainHContext2, toColumns2, fromColumns2 )
-  , ConstrainContext
-  )
-where
-
-- base
-import Data.Kind ( Constraint, Type )
-import Prelude ()
-
-- rel8
-import Rel8.Schema.Context ( Col )
-import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Pair
-import qualified Rel8.Schema.Kind as K
-
-
-type Table1 :: (Type -> Type) -> Constraint
-class Table1 f where
-  type Columns1 f :: K.HTable -> K.HTable
-  type ConstrainHContext1 f :: K.HContext -> Constraint
-  type ConstrainHContext1 _ = DefaultConstrainContext
-
-  toColumns1 :: (ConstrainHContext1 f context, HTable t)
-    => (a -> t context)
-    -> f a
-    -> Columns1 f t context
-
-  fromColumns1 :: (ConstrainHContext1 f context, HTable t)
-    => (t context -> a)
-    -> Columns1 f t context
-    -> f a
-
-
-type Table2 :: (Type -> Type -> Type) -> Constraint
-class Table2 p where
-  type Columns2 p :: K.HTable -> K.HTable -> K.HTable
-  type ConstrainHContext2 p :: K.HContext -> Constraint
-  type ConstrainHContext2 _ = DefaultConstrainContext
-
-  toColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)
-    => (a -> t context)
-    -> (b -> u context)
-    -> p a b
-    -> Columns2 p t u context
-
-  fromColumns2 :: (ConstrainHContext2 p context, HTable t, HTable u)
-    => (t context -> a)
-    -> (u context -> b)
-    -> Columns2 p t u context
-    -> p a b
-
-
-instance Table2 (,) where
-  type Columns2 (,) = HPair
-
-  toColumns2 f g (a, b) = HPair (f a) (g b)
-  fromColumns2 f g (HPair a b) = (f a, g b)
-
-
-type DefaultConstrainContext :: K.HContext -> Constraint
-class DefaultConstrainContext context
-instance DefaultConstrainContext context
-
-
-type ConstrainContext :: (K.Context -> Constraint) -> K.HContext -> Constraint
-class (forall context. hcontext ~ Col context => constraint context)
-  => ConstrainContext constraint hcontext
-instance (hcontext ~ Col context, constraint context) =>
-  ConstrainContext constraint hcontext
--- a/src/Rel8/Table/Maybe.hs
+++ b/src/Rel8/Table/Maybe.hs
@ -24,7 +24,7 @@ where
 -- base
 import Data.Functor.Identity ( runIdentity )
 import Data.Kind ( Type )
-import Prelude hiding ( null, repeat, undefined, zipWith )
+import Prelude hiding ( null, undefined )

 -- rel8
 import Rel8.Aggregate ( Aggregate, unsafeMakeAggregate )
@ -32,15 +32,19 @@ import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( boolExpr )
 import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )
 import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )
+import Rel8.Schema.Context.Label
+  ( Labelable, HLabelable, hlabeler, hunlabeler
+  )
 import Rel8.Schema.Context.Nullify
  ( Nullifiable, ConstrainTag
+  , HNullifiable, HConstrainTag
  , hencodeTag, hdecodeTag
  , hnullifier, hunnullifier
  )
+import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
-import Rel8.Schema.HTable.Maybe ( HMaybeTable(..), HMaybeNullifiable )
+import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
+import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql, nullable )
@ -51,9 +55,6 @@ import Rel8.Table.Alternative
  )
 import Rel8.Table.Bool ( bool )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Lifted
-  ( Table1, Columns1, ConstrainHContext1, fromColumns1, toColumns1
-  )
 import Rel8.Table.Ord ( OrdTable, ordTable )
 import Rel8.Table.Recontextualize ( Recontextualize )
 import Rel8.Table.Tag ( Tag(..), fromExpr, fromName )
@ -127,40 +128,17 @@ instance (Table Expr a, Semigroup a) => Monoid (MaybeTable a) where
  mempty = nothingTable


-instance Table1 MaybeTable where
-  type Columns1 MaybeTable = HMaybeTable
-  type ConstrainHContext1 MaybeTable = HMaybeNullifiable
-
-  toColumns1 f MaybeTable {tag, just} = HMaybeTable
-    { htag
-    , hjust = hnullify (hnullifier tag isNonNull) $ f just
-    }
-    where
-      htag = HIdentity (hencodeTag tag)
-
-  fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable
-    { tag
-    , just = f $ runIdentity $
-        hunnullify (\a -> pure . hunnullifier a) hjust
-    }
-    where
-      tag = hdecodeTag htag
-
-  {-# INLINABLE fromColumns1 #-}
-  {-# INLINABLE toColumns1 #-}
-
-
 instance
  ( Table context a
  , Labelable context, Nullifiable context
  , ConstrainTag context MaybeTag
  ) => Table context (MaybeTable a)
 where
-  type Columns (MaybeTable a) = HMaybeTable (HLabel "Just" (Columns a))
+  type Columns (MaybeTable a) = HMaybeTable (Columns a)
  type Context (MaybeTable a) = Context a

-  toColumns = toColumns1 (hlabel labeler . toColumns)
-  fromColumns = fromColumns1 (fromColumns . hunlabel unlabeler)
+  toColumns = toColumns1 toColumns
+  fromColumns = fromColumns1 fromColumns


 instance
@ -171,11 +149,11 @@ instance


 instance EqTable a => EqTable (MaybeTable a) where
-  eqTable = toColumns1 (hlabel hlabeler) (justTable (eqTable @a))
+  eqTable = toColumns1 id (justTable (eqTable @a))


 instance OrdTable a => OrdTable (MaybeTable a) where
-  ordTable = toColumns1 (hlabel hlabeler) (justTable (ordTable @a))
+  ordTable = toColumns1 id (justTable (ordTable @a))


 -- | Check if a @MaybeTable@ is absent of any row. Like 'Data.Maybe.isNothing'.
@ -226,3 +204,38 @@ aggregateMaybeTable f MaybeTable {tag = tag@Tag {aggregator, expr}, just} =

 nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a
 nameMaybeTable = MaybeTable . fromName
+
+
+toColumns1 ::
+  ( HTable t
+  , HConstrainTag context MaybeTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (a -> t context)
+  -> MaybeTable a
+  -> HMaybeTable t context
+toColumns1 f MaybeTable {tag, just} = HMaybeTable
+  { htag
+  , hjust = hlabel hlabeler $ hnullify (hnullifier tag isNonNull) $ f just
+  }
+  where
+    htag = HIdentity (hencodeTag tag)
+
+
+fromColumns1 ::
+  ( HTable t
+  , HConstrainTag context MaybeTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (t context -> a)
+  -> HMaybeTable t context
+  -> MaybeTable a
+fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable
+  { tag
+  , just = f $ runIdentity $
+      hunnullify (\a -> pure . hunnullifier a) (hunlabel hunlabeler hjust)
+  }
+  where
+    tag = hdecodeTag htag
--- a/src/Rel8/Table/Serialize.hs
+++ b/src/Rel8/Table/Serialize.hs
@ -31,13 +31,6 @@ import qualified Hasql.Decoders as Hasql
 import Rel8.Expr ( Expr, Col(..) )
 import Rel8.Expr.Serialize ( slitExpr, sparseValue )
 import Rel8.Schema.Context ( Col(..) )
-import Rel8.Schema.Context.Identity
-  ( fromHEitherTable, toHEitherTable
-  , fromHListTable, toHListTable
-  , fromHMaybeTable, toHMaybeTable
-  , fromHNonEmptyTable, toHNonEmptyTable
-  , fromHTheseTable, toHTheseTable
-  )
 import Rel8.Schema.Context.Label ( labeler, unlabeler )
 import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
 import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
@ -104,50 +97,38 @@ instance (ToExprs a exprs1, ToExprs b exprs2, x ~ EitherTable exprs1 exprs2) =>
  ToExprs (Either a b) x
 where
  fromIdentity =
-    bimap
-      (fromIdentity' @exprs1 . hunlabel unlabeler)
-      (fromIdentity' @exprs2 . hunlabel unlabeler) .
-    fromHEitherTable
+    bimap (fromIdentity' @exprs1) (fromIdentity' @exprs2) .
+    fromColumns
  toIdentity =
-    toHEitherTable .
-    bimap
-      (hlabel labeler . toIdentity' @exprs1)
-      (hlabel labeler . toIdentity' @exprs2)
+    toColumns .
+    bimap (toIdentity' @exprs1) (toIdentity' @exprs2)


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


 instance ToExprs a exprs => ToExprs (Maybe a) (MaybeTable exprs) where
-  fromIdentity =
-    fmap (fromIdentity' @exprs . hunlabel unlabeler) .
-    fromHMaybeTable
-  toIdentity =
-    toHMaybeTable .
-    fmap (hlabel labeler . toIdentity' @exprs)
+  fromIdentity = fmap (fromIdentity' @exprs) . fromColumns
+  toIdentity = toColumns . fmap (toIdentity' @exprs)


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


 instance (ToExprs a exprs1, ToExprs b exprs2, x ~ TheseTable exprs1 exprs2) =>
  ToExprs (These a b) x
 where
  fromIdentity =
-    bimap
-      (fromIdentity' @exprs1 . hunlabel unlabeler)
-      (fromIdentity' @exprs2 . hunlabel unlabeler) .
-    fromHTheseTable
+    bimap (fromIdentity' @exprs1) (fromIdentity' @exprs2) .
+    fromColumns
  toIdentity =
-    toHTheseTable .
-    bimap
-      (hlabel labeler . toIdentity' @exprs1)
-      (hlabel labeler . toIdentity' @exprs2)
+    toColumns .
+    bimap (toIdentity' @exprs1) (toIdentity' @exprs2)


 instance (ToExprs a exprs1, ToExprs b exprs2, x ~ (exprs1, exprs2)) =>
@ -251,22 +232,22 @@ instance (KnownSpec spec, x ~ Col Expr spec) =>


 type FromExprs :: Type -> Type
-type family FromExprs a where
-  FromExprs (Expr a) = a
-  FromExprs (Col Expr spec) = Col Identity spec
-  FromExprs (EitherTable a b) = Either (FromExprs a) (FromExprs b)
-  FromExprs (ListTable a) = [FromExprs a]
-  FromExprs (MaybeTable a) = Maybe (FromExprs a)
-  FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
-  FromExprs (TheseTable a b) = These (FromExprs a) (FromExprs b)
-  FromExprs (a, b) = (FromExprs a, FromExprs b)
-  FromExprs (a, b, c) = (FromExprs a, FromExprs b, FromExprs c)
-  FromExprs (a, b, c, d) =
-    (FromExprs a, FromExprs b, FromExprs c, FromExprs d)
-  FromExprs (a, b, c, d, e) =
-    (FromExprs a, FromExprs b, FromExprs c, FromExprs d, FromExprs e)
-  FromExprs (t Expr) = t Identity
-  FromExprs (t (Col Expr)) = t (Col Identity)
+type family FromExprs a
+type instance FromExprs (Expr a) = a
+type instance FromExprs (Col Expr spec) = Col Identity 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)
+type instance FromExprs (NonEmptyTable a) = NonEmpty (FromExprs a)
+type instance FromExprs (TheseTable a b) = These (FromExprs a) (FromExprs b)
+type instance FromExprs (a, b) = (FromExprs a, FromExprs b)
+type instance FromExprs (a, b, c) = (FromExprs a, FromExprs b, FromExprs c)
+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)


 -- | @Serializable@ witnesses the one-to-one correspondence between the type
--- a/src/Rel8/Table/These.hs
+++ b/src/Rel8/Table/These.hs
@ -34,23 +34,24 @@ import Rel8.Aggregate ( Aggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( (&&.), not_ )
 import Rel8.Expr.Null ( isNonNull )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler, hlabeler )
+import Rel8.Schema.Context.Label
+  ( Labelable
+  , HLabelable, hlabeler, hunlabeler
+  )
 import Rel8.Schema.Context.Nullify
  ( Nullifiable, ConstrainTag
+  , HNullifiable, HConstrainTag
  , hencodeTag, hdecodeTag
  , hnullifier, hunnullifier
  )
-import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
+import Rel8.Schema.HTable ( HTable )
+import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Identity ( HIdentity(..) )
-import Rel8.Schema.HTable.Maybe ( HMaybeNullifiable )
 import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )
 import Rel8.Schema.HTable.These ( HTheseTable(..) )
 import Rel8.Schema.Name ( Name  )
 import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
 import Rel8.Table.Eq ( EqTable, eqTable )
-import Rel8.Table.Lifted
-  ( Table2, Columns2, ConstrainHContext2, fromColumns2, toColumns2
-  )
 import Rel8.Table.Maybe
  ( MaybeTable(..)
  , maybeTable, justTable, nothingTable
@ -117,66 +118,16 @@ instance (Table Expr a, Table Expr b, Semigroup a, Semigroup b) =>
    }


-instance Table2 TheseTable where
-  type Columns2 TheseTable = HTheseTable
-  type ConstrainHContext2 TheseTable = HMaybeNullifiable
-
-  toColumns2 f g TheseTable {here, there} = HTheseTable
-    { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))
-    , hhere =
-        hnullify (hnullifier (tag here) isNonNull) $ f (just here)
-    , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))
-    , hthere =
-        hnullify (hnullifier (tag there) isNonNull) $ g (just there)
-    }
-
-  fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} =
-    TheseTable
-      { here =
-          let
-            tag = hdecodeTag $ unHIdentity hhereTag
-          in
-            MaybeTable
-              { tag
-              , just = f $
-                  runIdentity $
-                  hunnullify (\a -> pure . hunnullifier a)
-                  hhere
-              }
-      , there =
-          let
-            tag = hdecodeTag $ unHIdentity hthereTag
-          in
-            MaybeTable
-              { tag
-              , just = g $
-                  runIdentity $
-                  hunnullify (\a -> pure . hunnullifier a)
-                  hthere
-              }
-      }
-
-  {-# INLINABLE fromColumns2 #-}
-  {-# INLINABLE toColumns2 #-}
-
-
 instance
  ( Table context a, Table context b
  , Labelable context, Nullifiable context, ConstrainTag context MaybeTag
  ) => Table context (TheseTable a b)
 where
-  type Columns (TheseTable a b) =
-    HTheseTable (HLabel "Here" (Columns a)) (HLabel "There" (Columns b))
+  type Columns (TheseTable a b) = HTheseTable (Columns a) (Columns b)
  type Context (TheseTable a b) = Context a

-  toColumns =
-    toColumns2
-      (hlabel labeler . toColumns)
-      (hlabel labeler . toColumns)
-  fromColumns =
-    fromColumns2
-      (fromColumns . hunlabel unlabeler)
-      (fromColumns . hunlabel unlabeler)
+  toColumns = toColumns2 toColumns toColumns
+  fromColumns = fromColumns2 fromColumns fromColumns


 instance
@ -189,15 +140,11 @@ instance


 instance (EqTable a, EqTable b) => EqTable (TheseTable a b) where
-  eqTable =
-    toColumns2 (hlabel hlabeler) (hlabel hlabeler)
-      (thoseTable (eqTable @a) (eqTable @b))
+  eqTable = toColumns2 id id (thoseTable (eqTable @a) (eqTable @b))


 instance (OrdTable a, OrdTable b) => OrdTable (TheseTable a b) where
-  ordTable =
-    toColumns2 (hlabel hlabeler) (hlabel hlabeler)
-      (thoseTable (ordTable @a) (ordTable @b))
+  ordTable = toColumns2 id id (thoseTable (ordTable @a) (ordTable @b))


 toHereTag :: Tag "isJust" a -> Tag "hasHere" a
@ -277,3 +224,63 @@ nameTheseTable here there a b =
    { here = nameMaybeTable here a
    , there = nameMaybeTable there b
    }
+
+
+toColumns2 ::
+  ( HTable t
+  , HTable u
+  , HConstrainTag context MaybeTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (a -> t context)
+  -> (b -> u context)
+  -> TheseTable a b
+  -> HTheseTable t u context
+toColumns2 f g TheseTable {here, there} = HTheseTable
+  { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))
+  , hhere =
+      hlabel hlabeler $ hnullify (hnullifier (tag here) isNonNull) $ f (just here)
+  , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))
+  , hthere =
+      hlabel hlabeler $ hnullify (hnullifier (tag there) isNonNull) $ g (just there)
+  }
+
+
+fromColumns2 ::
+  ( HTable t
+  , HTable u
+  , HConstrainTag context MaybeTag
+  , HLabelable context
+  , HNullifiable context
+  )
+  => (t context -> a)
+  -> (u context -> b)
+  -> HTheseTable t u context
+  -> TheseTable a b
+fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} = TheseTable
+  { here =
+      let
+        tag = hdecodeTag $ unHIdentity hhereTag
+      in
+        MaybeTable
+          { tag
+          , just = f $
+              runIdentity $
+              hunnullify (\a -> pure . hunnullifier a) $
+              hunlabel hunlabeler
+              hhere
+          }
+  , there =
+      let
+        tag = hdecodeTag $ unHIdentity hthereTag
+      in
+        MaybeTable
+          { tag
+          , just = g $
+              runIdentity $
+              hunnullify (\a -> pure . hunnullifier a) $
+              hunlabel hunlabeler
+              hthere
+          }
+  }
--- a/src/Rel8/Type/Array.hs
+++ b/src/Rel8/Type/Array.hs
@ -32,6 +32,7 @@ array TypeInformation {typeName} =
  fromPrimArray .
  Opaleye.CastExpr (typeName <> "[]") .
  Opaleye.ArrayExpr . toList
+{-# INLINABLE array #-}


 listTypeInformation :: ()
--- a/src/Rel8/Type/Tag.hs
+++ b/src/Rel8/Type/Tag.hs
@ -19,7 +19,7 @@ import Prelude
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

 -- rel8
-import Rel8.Expr ( Expr )
+import {-# SOURCE #-} Rel8.Expr ( Expr )
 import Rel8.Expr.Eq ( (==.) )
 import Rel8.Expr.Opaleye ( zipPrimExprsWith )
 import Rel8.Expr.Serialize ( litExpr )