Remove Labelable type class; we don't really need labels at the type level anymore

rel8.cabal

@@ -79,7 +79,6 @@ library
 
     Rel8.Kind.Algebra
     Rel8.Kind.Context
-    Rel8.Kind.Labels
 
     Rel8.Generic.Construction
     Rel8.Generic.Construction.ADT
@@ -115,7 +114,6 @@ library
     Rel8.Query.Values
 
     Rel8.Schema.Context
-    Rel8.Schema.Context.Label
     Rel8.Schema.Context.Nullify
     Rel8.Schema.Dict
     Rel8.Schema.HTable

src/Rel8.hs

@@ -270,7 +270,6 @@ module Rel8
   , evaluate
 
     -- * Implementation details
-  , Labelable
   , HKDT(..)
   ) where
 
@@ -317,7 +316,6 @@ import Rel8.Query.SQL (showQuery)
 import Rel8.Query.Set
 import Rel8.Query.These
 import Rel8.Query.Values
-import Rel8.Schema.Context.Label
 import Rel8.Schema.HTable
 import Rel8.Schema.Name
 import Rel8.Schema.Null hiding ( nullable )

src/Rel8/Aggregate.hs

@@ -33,7 +33,6 @@ import qualified Opaleye.Internal.PackMap as Opaleye
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Schema.Context ( Interpretation(..) )
-import Rel8.Schema.Context.Label ( Labelable(..) )
 import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Null ( Sql )
@@ -62,7 +61,7 @@ instance Interpretation Aggregate where
   data Col Aggregate _spec where
     A :: ()
       => { unA :: !(Aggregate a) }
-      -> Col Aggregate ('Spec labels a)
+      -> Col Aggregate ('Spec a)
 
 
 instance Sql DBType a => Table Aggregate (Aggregate a) where
@@ -104,11 +103,6 @@ instance Sql DBType a =>
   Recontextualize Name Aggregate (Name a) (Aggregate a)
 
 
-instance Labelable Aggregate where
-  labeler (A aggregate) = A aggregate
-  unlabeler (A aggregate) = A aggregate
-
-
 -- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
 -- for the columns in @b@.
 type Aggregates :: Type -> Type -> Constraint

src/Rel8/Column.hs

@@ -20,7 +20,7 @@ import Rel8.Aggregate ( Aggregate, Col( A ) )
 import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.FCF ( Eval, Exp )
 import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
-import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
+import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Name ( Name(..), Col( N ) )
 import Rel8.Schema.Null ( Sql )
@@ -55,11 +55,11 @@ instance (Reifiable context, Sql DBType a) =>
   Table (Reify context) (AColumn context a)
  where
   type Context (AColumn context a) = Reify context
-  type Columns (AColumn context a) = HIdentity ('Spec '[] a)
+  type Columns (AColumn context a) = HType a
   type Unreify (AColumn context a) = Column context a
 
-  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
+  fromColumns (HType (Reify a)) = sfromColumn contextSing a
-  toColumns = HIdentity . Reify . stoColumn contextSing
+  toColumns = HType . Reify . stoColumn contextSing
   reify _ = AColumn
   unreify _ (AColumn a) = a
 
@@ -77,7 +77,7 @@ instance
 
 sfromColumn :: ()
   => SContext context
-  -> Col context ('Spec labels a)
+  -> Col context ('Spec a)
   -> AColumn context a
 sfromColumn = \case
   SAggregate -> \(A a) -> AColumn a
@@ -90,7 +90,7 @@ sfromColumn = \case
 stoColumn :: ()
   => SContext context
   -> AColumn context a
-  -> Col context ('Spec labels a)
+  -> Col context ('Spec a)
 stoColumn = \case
   SAggregate -> \(AColumn a) -> A a
   SExpr -> \(AColumn a) -> E a

src/Rel8/Expr.hs

@@ -39,7 +39,6 @@ import Rel8.Expr.Opaleye
   )
 import Rel8.Expr.Serialize ( litExpr )
 import Rel8.Schema.Context ( Interpretation, Col )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )
 import Rel8.Schema.Reify ( notReify )
@@ -128,7 +127,7 @@ instance Sql DBFloating a => Floating (Expr a) where
 
 instance Interpretation Expr where
   data Col Expr _spec where
-    E :: {unE :: !(Expr a)} -> Col Expr ('Spec labels a)
+    E :: {unE :: !(Expr a)} -> Col Expr ('Spec a)
 
 
 instance Sql DBType a => Table Expr (Expr a) where
@@ -148,8 +147,3 @@ instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)
 
 
 instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)
-
-
-instance Labelable Expr where
-  labeler (E a) = E a
-  unlabeler (E a) = E a

src/Rel8/Generic/Construction/ADT.hs

@@ -48,7 +48,6 @@ import Rel8.Generic.Construction.Record
   )
 import Rel8.Generic.Table.ADT ( GColumnsADT, GColumnsADT' )
 import Rel8.Generic.Table.Record ( GColumns )
-import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Identity ( HType )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
@@ -64,23 +63,23 @@ import Data.Text ( pack )
 
 
 type Null :: K.HContext -> Type
-type Null context = forall labels a. ()
+type Null context = forall a. ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> context ('Spec labels (Nullify a))
+  -> context ('Spec (Nullify a))
 
 
 type Nullifier :: K.HContext -> Type
-type Nullifier context = forall labels a. ()
+type Nullifier context = forall a. ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> context ('Spec labels a)
+  -> context ('Spec a)
-  -> context ('Spec labels (Nullify a))
+  -> context ('Spec (Nullify a))
 
 
 type Unnullifier :: K.HContext -> Type
-type Unnullifier context = forall labels a. ()
+type Unnullifier context = forall a. ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> context ('Spec labels (Nullify a))
+  -> context ('Spec (Nullify a))
-  -> context ('Spec labels a)
+  -> context ('Spec a)
 
 
 type NoConstructor :: Symbol -> Symbol -> ErrorMessage
@@ -222,24 +221,23 @@ class GConstructableADT _Table _Columns f context rep where
 instance
   ( htable ~ HLabel "tag" (HType Tag)
   , GConstructableADT' _Table _Columns f context htable rep
-  , HLabelable context
   )
   => GConstructableADT _Table _Columns f context (M1 D meta rep)
  where
   gbuildADT toColumns nullifier =
     gbuildADT' @_Table @_Columns @f @context @htable @rep toColumns nullifier .
-    hlabel hlabeler
+    hlabel
 
   gunbuildADT fromColumns unnullifier =
-    first (hunlabel hunlabeler) .
+    first hunlabel .
     gunbuildADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier
 
   gconstructADT toColumns null nullifier mk =
     gconstructADT' @_Table @_Columns @f @context @htable @rep toColumns null nullifier
-      (hlabel hlabeler . mk)
+      (hlabel . mk)
 
   gdeconstructADT fromColumns unnullifier cases =
-    first (hunlabel hunlabeler) .
+    first hunlabel .
     gdeconstructADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier cases
 
 
@@ -334,7 +332,6 @@ instance {-# OVERLAPPABLE #-}
   ( HTable (GColumns _Columns rep)
   , KnownSymbol label
   , meta ~ 'MetaCons label _fixity _isRecord
-  , HLabelable context
   , GConstructable _Table _Columns f context rep
   , GColumnsADT' _Columns htable (M1 C meta rep) ~
       HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
@@ -343,7 +340,7 @@ instance {-# OVERLAPPABLE #-}
  where
   gbuildADT' toColumns nullifier htable =
     HProduct htable .
-    hlabel hlabeler .
+    hlabel .
     hnullify (nullifier tag) .
     gconstruct @_Table @_Columns @f @context @rep toColumns
     where
@@ -354,13 +351,13 @@ instance {-# OVERLAPPABLE #-}
     , gdeconstruct @_Table @_Columns @f @context @rep fromColumns $
         runIdentity $
         hunnullify (\spec -> pure . unnullifier spec) $
-        hunlabel hunlabeler
+        hunlabel
         a
     )
 
   gconstructADT' toColumns _ nullifier mk =
     HProduct htable .
-    hlabel hlabeler .
+    hlabel .
     hnullify nullifier .
     gconstruct @_Table @_Columns @f @context @rep toColumns
     where
@@ -375,11 +372,11 @@ instance {-# OVERLAPPABLE #-}
       a = gdeconstruct @_Table @_Columns @f @context @rep fromColumns $
         runIdentity $
         hunnullify (\spec -> pure . unnullifier spec) $
-        hunlabel hunlabeler
+        hunlabel
         columns
       tag = Tag $ pack $ symbolVal (Proxy @label)
 
-  gfill null htable = HProduct htable (hlabel hlabeler (hnulls null))
+  gfill null htable = HProduct htable (hlabel (hnulls null))
 
 
 type GMakeableADT
@@ -403,7 +400,6 @@ instance
   , fallback ~ TypeError (NoConstructor datatype name)
   , fields ~ GFields f (GConstructorADT' name rep fallback)
   , GMakeableADT' _Table _Columns f context htable name rep fields
-  , HLabelable context
   , KnownSymbol name
   )
   => GMakeableADT _Table _Columns f context name (M1 D meta rep)
@@ -414,7 +410,7 @@ instance
       toColumns null nullifier htable
     where
       tag = Tag $ pack $ symbolVal (Proxy @name)
-      htable = hlabel hlabeler (wrap tag)
+      htable = hlabel (wrap tag)
 
 
 type GMakeableADT'
@@ -462,8 +458,6 @@ instance {-# OVERLAPS #-}
 
 instance {-# OVERLAPS #-}
   ( HTable (GColumns _Columns rep)
-  , KnownSymbol name
-  , HLabelable context
   , GConstructable _Table _Columns f context rep
   , fields ~ GFields f rep
   , GColumnsADT' _Columns htable (M1 C ('MetaCons name _fixity _isRecord) rep) ~
@@ -473,15 +467,13 @@ instance {-# OVERLAPS #-}
  where
   gmakeADT' toColumns _ nullifier htable =
     HProduct htable .
-    hlabel hlabeler .
+    hlabel .
     hnullify nullifier .
     gconstruct @_Table @_Columns @f @context @rep toColumns
 
 
 instance {-# OVERLAPPABLE #-}
   ( HTable (GColumns _Columns rep)
-  , KnownSymbol label
-  , HLabelable context
   , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~
       HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
   )
@@ -489,5 +481,5 @@ instance {-# OVERLAPPABLE #-}
  where
   gmakeADT' _ null _ htable _ =
     HProduct htable $
-    hlabel hlabeler $
+    hlabel $
     hnulls null

src/Rel8/Generic/Construction/Record.hs

@@ -27,15 +27,13 @@ import GHC.Generics
   )
 import GHC.TypeLits
   ( ErrorMessage( (:<>:), Text ), TypeError
-  , Symbol, KnownSymbol
+  , Symbol
   )
 import Prelude
 
 -- rel8
 import Rel8.FCF ( Eval, Exp )
 import Rel8.Generic.Table.Record ( GColumns )
-import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
-import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
 import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )
 import qualified Rel8.Schema.Kind as K
@@ -162,12 +160,9 @@ instance
 
 instance
   ( Eval (_Table a)
-  , HTable (Eval (_Columns a))
-  , HLabelable context
-  , KnownSymbol label
   , meta ~ 'MetaSel ('Just label) _su _ss _ds
   )
   => GConstructable _Table _Columns f context (M1 S meta (K1 i a))
  where
-  gconstruct toColumns = hlabel hlabeler . toColumns (Proxy @a)
+  gconstruct toColumns = hlabel . toColumns (Proxy @a)
-  gdeconstruct fromColumns = fromColumns (Proxy @a) . hunlabel hunlabeler
+  gdeconstruct fromColumns = fromColumns (Proxy @a) . hunlabel

src/Rel8/Generic/Rel8able.hs

@@ -36,7 +36,6 @@ import Rel8.Generic.Table ( GAlgebra )
 import qualified Rel8.Generic.Table.Record as G
 import qualified Rel8.Kind.Algebra as K ( Algebra(..) )
 import Rel8.Schema.Context ( Col )
-import Rel8.Schema.Context.Label ( Labelable )
 import Rel8.Schema.HTable ( HTable )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Reify ( Reify, UnwrapReify )
@@ -98,16 +97,16 @@ type Rel8able :: K.Rel8able -> Constraint
 class HTable (GColumns t) => Rel8able t where
   type GColumns t :: K.HTable
 
-  gfromColumns :: (Labelable context, Reifiable context)
+  gfromColumns :: Reifiable context
     => GColumns t (Col (Reify context)) -> t (Reify context)
 
-  gtoColumns :: (Labelable context, Reifiable context)
+  gtoColumns :: Reifiable context
     => t (Reify context) -> GColumns t (Col (Reify context))
 
-  greify :: (Labelable context, Reifiable context)
+  greify :: Reifiable context
     => t context -> t (Reify context)
 
-  gunreify :: (Labelable context, Reifiable context)
+  gunreify :: Reifiable context
     => t (Reify context) -> t context
 
   type GColumns t = G.GColumns TColumns (GRep t (Reify Result))

src/Rel8/Generic/Table.hs

@@ -148,10 +148,10 @@ ggtable :: forall algebra _Table _Columns rep context.
   , Eval (GGTable algebra _Table _Columns context rep)
   )
   => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)
-  -> (forall a labels. ()
+  -> (forall a. ()
-      => SSpec ('Spec labels a)
+      => SSpec ('Spec a)
-      -> context ('Spec labels a)
+      -> context ('Spec a)
-      -> context ('Spec labels (Nullify a)))
+      -> context ('Spec (Nullify a)))
   -> Eval (GGColumns algebra _Columns rep) context
 ggtable = case algebraSing @algebra of
   SProduct -> \table _ -> gtable @_Table @_Columns @_ @rep table

src/Rel8/Generic/Table/ADT.hs

@@ -37,7 +37,6 @@ import Rel8.Generic.Table.Record
   ( GTable, GColumns, gtable
   , GToExprs, gfromResult, gtoResult
   )
-import Rel8.Schema.Context.Label ( HLabelable, hlabeler, labeler, unlabeler )
 import Rel8.Schema.HTable ( HTable, hmap )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
@@ -96,10 +95,10 @@ class GTableADT _Table _Columns context rep where
 
   gtableADT :: ()
     => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)
-    -> (forall a labels. ()
+    -> (forall a. ()
-        => SSpec ('Spec labels a)
+        => SSpec ('Spec a)
-        -> context ('Spec labels a)
+        -> context ('Spec a)
-        -> context ('Spec labels (Nullify a)))
+        -> context ('Spec (Nullify a)))
     -> GColumnsADT _Columns rep context
 
 
@@ -136,10 +135,10 @@ type GTableADT'
 class GTableADT' _Table _Columns htable context rep where
   gtableADT' :: ()
     => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)
-    -> (forall a labels. ()
+    -> (forall a. ()
-        => SSpec ('Spec labels a)
+        => SSpec ('Spec a)
-        -> context ('Spec labels a)
+        -> context ('Spec a)
-        -> context ('Spec labels (Nullify a)))
+        -> context ('Spec (Nullify a)))
     -> htable context
     -> GColumnsADT' _Columns htable rep context
 
@@ -165,9 +164,7 @@ instance meta ~ 'MetaCons label _fixity _isRecord =>
 instance {-# OVERLAPPABLE #-}
   ( HTable (GColumns _Columns rep)
   , GTable _Table _Columns context rep
-  , HLabelable context
   , meta ~ 'MetaCons label _fixity _isRecord
-  , KnownSymbol label
   , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~
       HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))
   )
@@ -175,7 +172,7 @@ instance {-# OVERLAPPABLE #-}
  where
   gtableADT' table hnullifier htable =
     HProduct htable $
-      hlabel hlabeler $
+      hlabel $
       hnullify hnullifier $
       gtable @_Table @_Columns @_ @rep table
 
@@ -219,12 +216,12 @@ instance
       Just rep -> M1 rep
       _ -> error "ADT.fromColumns: mismatch between tag and data"
     where
-      tag = (\(HType (R a)) -> a) . hunlabel @_ @"tag" unlabeler
+      tag = (\(HType (R a)) -> a) . hunlabel @"tag"
 
   gtoResultADT toResult (M1 rep) =
     gtoResultADT' @_ToExprs @_Columns @_ @exprs toResult tag (Just rep)
     where
-      tag = hlabel @_ @"tag" labeler . HType . R
+      tag = hlabel @"tag" . HType . R
 
 
 type GToExprsADT'
@@ -342,15 +339,15 @@ instance {-# OVERLAPPABLE #-}
   gfromResultADT' fromResult tag (HProduct a b)
     | tag a == tag' =
         M1 . gfromResult @_ToExprs @_Columns @exprs fromResult <$>
-          hunnullify unnullifier (hunlabel unlabeler b)
+          hunnullify unnullifier (hunlabel b)
     | otherwise = Nothing
     where
       tag' = Tag $ pack $ symbolVal (Proxy @label)
 
   gtoResultADT' toResult tag = \case
-    Nothing -> HProduct (tag tag') (hlabel labeler (hnulls (const null)))
+    Nothing -> HProduct (tag tag') (hlabel (hnulls (const null)))
     Just (M1 rep) -> HProduct (tag tag') $
-      hlabel labeler $
+      hlabel $
       hnullify nullifier $
       gtoResult @_ToExprs @_Columns @exprs toResult rep
     where

src/Rel8/Generic/Table/Record.hs

@@ -26,13 +26,11 @@ import GHC.Generics
   , C, D, S
   , Meta( MetaSel )
   )
-import GHC.TypeLits ( KnownSymbol )
 import Prelude hiding ( null )
 
 -- rel8
 import Rel8.FCF ( Eval, Exp )
 import Rel8.Schema.Context ( Col )
-import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
 import Rel8.Schema.HTable ( HTable )
 import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
 import Rel8.Schema.HTable.Product ( HProduct(..) )
@@ -116,18 +114,15 @@ instance
 
 
 instance
-  ( HTable (Eval (_Columns a))
+  ( Eval (_Table a)
-  , Eval (_Table a)
-  , HLabelable context
-  , KnownSymbol label
   , meta ~ 'MetaSel ('Just label) _su _ss _ds
   , k1 ~ K1 i a
   )
   => GTable _Table _Columns context (M1 S meta k1)
  where
-  gfromColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler
+  gfromColumns fromColumns = M1 . K1 . fromColumns . hunlabel
-  gtoColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)
+  gtoColumns toColumns (M1 (K1 a)) = hlabel (toColumns a)
-  gtable table = hlabel hlabeler (table (Proxy @a))
+  gtable table = hlabel (table (Proxy @a))
 
 
 type GToExprs
@@ -193,7 +188,6 @@ instance
 instance
   ( Eval (_ToExprs exprs a)
   , HTable (Eval (_Columns exprs))
-  , KnownSymbol label
   , meta ~ 'MetaSel ('Just label) _su _ss _ds
   , k1 ~ K1 i exprs
   , k1' ~ K1 i a
@@ -201,6 +195,6 @@ instance
   => GToExprs _ToExprs _Columns (M1 S meta k1) (M1 S meta k1')
  where
   gfromResult fromResult =
-    M1 . K1 . fromResult (Proxy @exprs) . hunlabel hunlabeler
+    M1 . K1 . fromResult (Proxy @exprs) . hunlabel
   gtoResult toResult (M1 (K1 a)) =
-    hlabel hlabeler (toResult (Proxy @exprs) a)
+    hlabel (toResult (Proxy @exprs) a)

src/Rel8/Kind/Context.hs

@@ -7,7 +7,6 @@ module Rel8.Kind.Context
   ( Reifiable( contextSing )
   , SContext(..)
   , sReifiable
-  , sLabelable
   )
 where
 
@@ -20,7 +19,6 @@ import Rel8.Aggregate ( Aggregate )
 import Rel8.Expr ( Expr )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import Rel8.Schema.Context ( Interpretation )
-import Rel8.Schema.Context.Label ( Labelable )
 import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Name ( Name )
 import Rel8.Schema.Reify ( Reify )
@@ -69,13 +67,3 @@ sReifiable = \case
   SResult -> Dict
   SReify context -> case sReifiable context of
     Dict -> Dict
-
-
-sLabelable :: SContext context -> Dict Labelable context
-sLabelable = \case
-  SAggregate -> Dict
-  SExpr -> Dict
-  SName -> Dict
-  SResult -> Dict
-  SReify context -> case sLabelable context of
-    Dict -> Dict

src/Rel8/Kind/Labels.hs

@@ -1,57 +0,0 @@
-{-# language DataKinds #-}
-{-# language FlexibleContexts #-}
-{-# language FlexibleInstances #-}
-{-# language GADTs #-}
-{-# language LambdaCase #-}
-{-# language StandaloneKindSignatures #-}
-{-# language TypeOperators #-}
-
-module Rel8.Kind.Labels
-  ( Labels
-  , SLabels( SNil, SCons )
-  , KnownLabels( labelsSing )
-  , renderLabels
-  )
-where
-
--- base
-import Data.Kind ( Constraint, Type )
-import Data.List.NonEmpty ( NonEmpty, nonEmpty )
-import Data.Maybe ( fromMaybe )
-import Data.Proxy ( Proxy( Proxy ) )
-import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
-import Prelude
-
-
-type Labels :: Type
-type Labels = [Symbol]
-
-
-type SLabels :: Labels -> Type
-data SLabels labels where
-  SNil :: SLabels '[]
-  SCons :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)
-
-
-type KnownLabels :: Labels -> Constraint
-class KnownLabels labels where
-  labelsSing :: SLabels labels
-
-
-instance KnownLabels '[] where
-  labelsSing = SNil
-
-
-instance (KnownSymbol label, KnownLabels labels) =>
-  KnownLabels (label ': labels)
- where
-  labelsSing = SCons Proxy labelsSing
-
-
-renderLabels :: SLabels labels -> NonEmpty String
-renderLabels = fromMaybe (pure "anon") . nonEmpty . go
-  where
-    go :: SLabels labels -> [String]
-    go = \case
-      SNil -> []
-      SCons label labels -> symbolVal label : go labels

src/Rel8/Schema/Context/Label.hs

@@ -1,62 +0,0 @@
-{-# language DataKinds #-}
-{-# language FlexibleInstances #-}
-{-# language StandaloneKindSignatures #-}
-{-# language TypeFamilies #-}
-{-# language TypeOperators #-}
-
-module Rel8.Schema.Context.Label
-  ( Labelable( labeler, unlabeler )
-  , HLabelable( hlabeler, hunlabeler )
-  )
-where
-
--- base
-import Data.Kind ( Constraint )
-import Prelude hiding ( null )
-
--- rel8
-import Rel8.Schema.Context ( Interpretation )
-import Rel8.Schema.Dict ( Dict( Dict ) )
-import Rel8.Schema.Kind ( Context, HContext )
-import Rel8.Schema.Spec ( Spec( Spec ) )
-import Rel8.Schema.Result ( Col( R ), Result )
-import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
-
-
--- | The @Labelable@ class is an internal implementation detail of Rel8, and
--- indicates that we can successfully "name" all columns in a type.
-type Labelable :: Context -> Constraint
-class Interpretation context => Labelable context where
-  labeler :: ()
-    => Col context ('Spec labels a)
-    -> Col context ('Spec (label ': labels) a)
-
-  unlabeler :: ()
-    => Col context ('Spec (label ': labels) a)
-    -> Col context ('Spec labels a)
-
-
-instance Labelable Result where
-  labeler (R a) = R a
-  unlabeler (R a) = R a
-
-
-type HLabelable :: HContext -> Constraint
-class HLabelable context where
-  hlabeler :: ()
-    => context ('Spec labels a)
-    -> context ('Spec (label ': labels) a)
-
-  hunlabeler :: ()
-    => context ('Spec (label ': labels) a)
-    -> context ('Spec labels a)
-
-
-instance Labelable context => HLabelable (Col context) where
-  hlabeler = labeler
-  hunlabeler = unlabeler
-
-
-instance HLabelable (Dict (ConstrainDBType constraint)) where
-  hlabeler Dict = Dict
-  hunlabeler Dict = Dict

src/Rel8/Schema/Context/Nullify.hs

@@ -51,31 +51,30 @@ class Interpretation context => Nullifiable context where
 
   encodeTag ::
     ( Sql (ConstrainTag context) a
-    , KnownSymbol label
     , Taggable a
     )
     => Tag label a
-    -> Col context ('Spec labels a)
+    -> Col context ('Spec a)
 
   decodeTag ::
     ( Sql (ConstrainTag context) a
     , KnownSymbol label
     , Taggable a
     )
-    => Col context ('Spec labels a)
+    => Col context ('Spec a)
     -> Tag label a
 
   nullifier :: ()
     => Tag label a
     -> (Expr a -> Expr Bool)
-    -> SSpec ('Spec labels x)
+    -> SSpec ('Spec x)
-    -> Col context ('Spec labels x)
+    -> Col context ('Spec x)
-    -> Col context ('Spec labels (Nullify x))
+    -> Col context ('Spec (Nullify x))
 
   unnullifier :: ()
-    => SSpec ('Spec labels x)
+    => SSpec ('Spec x)
-    -> Col context ('Spec labels (Nullify x))
+    -> Col context ('Spec (Nullify x))
-    -> Col context ('Spec labels x)
+    -> Col context ('Spec x)
 
 
 instance Nullifiable Aggregate where
@@ -147,23 +146,23 @@ class HNullifiable context where
 
   hencodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)
     => Tag label a
-    -> context ('Spec labels a)
+    -> context ('Spec a)
 
   hdecodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)
-    => context ('Spec labels a)
+    => context ('Spec a)
     -> Tag label a
 
   hnullifier :: ()
     => Tag label a
     -> (Expr a -> Expr Bool)
-    -> SSpec ('Spec labels x)
+    -> SSpec ('Spec x)
-    -> context ('Spec labels x)
+    -> context ('Spec x)
-    -> context ('Spec labels (Nullify x))
+    -> context ('Spec (Nullify x))
 
   hunnullifier :: ()
-    => SSpec ('Spec labels x)
+    => SSpec ('Spec x)
-    -> context ('Spec labels (Nullify x))
+    -> context ('Spec (Nullify x))
-    -> context ('Spec labels x)
+    -> context ('Spec x)
 
 
 instance Nullifiable context => HNullifiable (Col context) where

src/Rel8/Schema/HTable/Either.hs

@@ -15,17 +15,16 @@ import Prelude ()
 
 -- rel8
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Identity ( HIdentity(..) )
+import Rel8.Schema.HTable.Identity ( HType )
 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 ( EitherTag )
 
 
 type HEitherTable :: K.HTable -> K.HTable -> K.HTable
 data HEitherTable left right context = HEitherTable
-  { htag :: HIdentity ('Spec '["isRight"] EitherTag) context
+  { htag :: HLabel "isRight" (HType EitherTag) context
   , hleft :: HLabel "Left" (HNullify left) context
   , hright :: HLabel "Right" (HNullify right) context
   }

src/Rel8/Schema/HTable/Identity.hs

@@ -25,10 +25,10 @@ import Rel8.Schema.Spec ( Spec( Spec ), KnownSpec, specSing )
 
 
 type HType :: Type -> K.HTable
-type HType a = HIdentity ('Spec '[] a)
+type HType a = HIdentity ('Spec a)
 
 
-pattern HType :: context ('Spec '[] a) -> HType a context
+pattern HType :: context ('Spec a) -> HType a context
 pattern HType a = HIdentity a
 {-# COMPLETE HType #-}
 

src/Rel8/Schema/HTable/Label.hs

@@ -1,83 +1,58 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE LambdaCase #-}
-{-# language ConstraintKinds #-}
 {-# language DataKinds #-}
-{-# language FlexibleInstances #-}
-{-# language GADTs #-}
-{-# language MultiParamTypeClasses #-}
-{-# language QuantifiedConstraints #-}
-{-# language RankNTypes #-}
 {-# language RecordWildCards #-}
 {-# language ScopedTypeVariables #-}
 {-# language StandaloneKindSignatures #-}
+{-# language TypeApplications #-}
 {-# language TypeFamilies #-}
-{-# language TypeOperators #-}
-{-# language UndecidableInstances #-}
 
 module Rel8.Schema.HTable.Label
-  ( HLabel, Label
+  ( HLabel, hlabel, hrelabel, hunlabel
-  , hlabel, hunlabel
   )
 where
 
 -- base
+import Data.Kind ( Type )
 import Data.Proxy ( Proxy( Proxy ) )
-import GHC.TypeLits ( KnownSymbol, Symbol )
+import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )
 import Prelude
 
 -- rel8
-import Rel8.Kind.Labels ( SLabels( SCons ) )
 import Rel8.Schema.HTable
-  ( HTable
-  , hfield, htabulate, hspecs
-  )
 import qualified Rel8.Schema.Kind as K
-import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
+import Rel8.Schema.Spec ( Spec, SSpec(..) )
-import Rel8.FCF
-import Rel8.Schema.HTable.MapTable
-import GHC.Generics (Generic)
 
 
 type HLabel :: Symbol -> K.HTable -> K.HTable
-newtype HLabel label table context = HLabel (HMapTable (Label label) table context)
+newtype HLabel label table context = HLabel (table context)
-  deriving stock Generic
-  deriving anyclass HTable
 
 
-data Label :: Symbol -> Spec -> Exp Spec
+type HLabelField :: Symbol -> K.HTable -> Spec -> Type
+newtype HLabelField label table spec = HLabelField (HField table spec)
 
 
-type instance Eval (Label label ('Spec labels a)) = 'Spec (label : labels) a
+instance (HTable table, KnownSymbol label) => HTable (HLabel label table) where
+  type HField (HLabel label table) = HLabelField label table
+  type HConstrainTable (HLabel label table) constraint =
+    HConstrainTable table constraint
+
+  hfield (HLabel a) (HLabelField field) = hfield a field
+  htabulate f = HLabel (htabulate (f . HLabelField))
+  htraverse f (HLabel a) = HLabel <$> htraverse f a
+  hdicts = HLabel (hdicts @table)
+  hspecs = HLabel $ htabulate $ \field -> case hfield (hspecs @table) field of
+    SSpec {..} -> SSpec {labels = symbolVal (Proxy @label) : labels, ..}
 
 
-instance KnownSymbol l => MapSpec (Label l) where
+hlabel :: forall label t context. t context -> HLabel label t context
-  mapInfo = \case
+hlabel = HLabel
-    SSpec {..} -> SSpec {labels = SCons Proxy labels, ..}
-
-
-hlabel :: (HTable t, KnownSymbol label)
-  => (forall labels a. ()
-    => context ('Spec labels a)
-    -> context ('Spec (label ': labels) a))
-  -> t context
-  -> HLabel label t context
-hlabel labeler a = HLabel $ htabulate $ \(HMapTableField field) ->
-  case hfield hspecs field of
-    SSpec {} -> labeler (hfield a field)
 {-# INLINABLE hlabel #-}
 
 
-hunlabel :: (HTable t, KnownSymbol label)
+hrelabel :: forall label' label t context. HLabel label t context -> HLabel label' t context
-  => (forall labels a. ()
+hrelabel = hlabel . hunlabel
-    => context ('Spec (label ': labels) a)
+{-# INLINABLE hrelabel #-}
-    -> context ('Spec labels a))
+
-  -> HLabel label t context
+
-  -> t context
+hunlabel :: forall label t context. HLabel label t context -> t context
-hunlabel unlabler (HLabel as) =
+hunlabel (HLabel a) = a
-  htabulate $ \field -> 
-    case hfield hspecs field of
-      SSpec {} -> case hfield as (HMapTableField field) of
-        a -> unlabler a
 {-# INLINABLE hunlabel #-}

src/Rel8/Schema/HTable/Maybe.hs

@@ -15,17 +15,16 @@ import Prelude
 
 -- rel8
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Identity ( HIdentity(..) )
+import Rel8.Schema.HTable.Identity ( HType )
 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 )
 
 
 type HMaybeTable :: K.HTable -> K.HTable
 data HMaybeTable table context = HMaybeTable
-  { htag :: HIdentity ('Spec '["isJust"] (Maybe MaybeTag)) context
+  { htag :: HLabel "isJust" (HType (Maybe MaybeTag)) context
   , hjust :: HLabel "Just" (HNullify table) context
   }
   deriving stock Generic

src/Rel8/Schema/HTable/Nullify.hs

@@ -10,6 +10,7 @@
 {-# language NamedFieldPuns #-}
 {-# language QuantifiedConstraints #-}
 {-# language RankNTypes #-}
+{-# language RecordWildCards #-}
 {-# language ScopedTypeVariables #-}
 {-# language StandaloneKindSignatures #-}
 {-# language TypeFamilies #-}
@@ -50,25 +51,24 @@ newtype HNullify table context = HNullify (HMapTable Nullify table context)
 data Nullify :: Spec -> Exp Spec
 
 
-type instance Eval (Nullify ('Spec labels a)) =
+type instance Eval (Nullify ('Spec a)) =
-  'Spec labels (Type.Nullify a)
+  'Spec (Type.Nullify a)
 
 
 instance MapSpec Nullify where
   mapInfo = \case
-    SSpec{labels, info, nullity} -> SSpec
+    SSpec {nullity, ..} -> SSpec
-      { labels
+      { nullity = case nullity of
-      , info
-      , nullity = case nullity of
           Null    -> Null
           NotNull -> Null
+      , ..
       } 
 
 
 hnulls :: HTable t
-  => (forall labels a. ()
+  => (forall a. ()
-    => SSpec ('Spec labels a)
+    => SSpec ('Spec a)
-    -> context ('Spec labels (Type.Nullify a)))
+    -> context ('Spec (Type.Nullify a)))
   -> HNullify t context
 hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of
   spec@SSpec {} -> null spec
@@ -76,10 +76,10 @@ hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspe
 
 
 hnullify :: HTable t
-  => (forall labels a. ()
+  => (forall a. ()
-    => SSpec ('Spec labels a)
+    => SSpec ('Spec a)
-    -> context ('Spec labels a)
+    -> context ('Spec a)
-    -> context ('Spec labels (Type.Nullify a)))
+    -> context ('Spec (Type.Nullify a)))
   -> t context
   -> HNullify t context
 hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->
@@ -89,10 +89,10 @@ hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->
 
 
 hunnullify :: (HTable t, Apply m)
-  => (forall labels a. ()
+  => (forall a. ()
-    => SSpec ('Spec labels a)
+    => SSpec ('Spec a)
-    -> context ('Spec labels (Type.Nullify a))
+    -> context ('Spec (Type.Nullify a))
-    -> m (context ('Spec labels a)))
+    -> m (context ('Spec a)))
   -> HNullify t context
   -> m (t context)
 hunnullify unnullifier (HNullify as) =

src/Rel8/Schema/HTable/These.hs

@@ -15,19 +15,18 @@ import Prelude
 
 -- rel8
 import Rel8.Schema.HTable ( HTable )
-import Rel8.Schema.HTable.Identity ( HIdentity )
+import Rel8.Schema.HTable.Identity ( HType )
 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 )
 
 
 type HTheseTable :: K.HTable -> K.HTable -> K.HTable
 data HTheseTable here there context = HTheseTable
-  { hhereTag :: HIdentity ('Spec '["hasHere"] (Maybe MaybeTag)) context
+  { hhereTag :: HLabel "hereTag" (HType (Maybe MaybeTag)) context
   , hhere :: HLabel "Here" (HNullify here) context
-  , hthereTag :: HIdentity ('Spec '["hasThere"] (Maybe MaybeTag)) context
+  , hthereTag :: HLabel "thereTag" (HType (Maybe MaybeTag)) context
   , hthere :: HLabel "There" (HNullify there) context
   }
   deriving stock Generic

src/Rel8/Schema/HTable/Vectorize.hs

@@ -32,7 +32,6 @@ import Data.List.NonEmpty ( NonEmpty )
 import Prelude
 
 -- rel8
-import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.HTable
@@ -78,7 +77,7 @@ newtype HVectorize list table context = HVectorize (HMapTable (Vectorize list) t
 data Vectorize :: (Type -> Type) -> Spec -> Exp Spec
 
 
-type instance Eval (Vectorize list ('Spec labels a)) = 'Spec labels (list a)
+type instance Eval (Vectorize list ('Spec a)) = 'Spec (list a)
 
 
 instance Vector list => MapSpec (Vectorize list) where
@@ -92,10 +91,10 @@ instance Vector list => MapSpec (Vectorize list) where
 
 
 hvectorize :: (HTable t, Unzip f, Vector list)
-  => (forall labels a. ()
+  => (forall a. ()
-    => SSpec ('Spec labels a)
+    => SSpec ('Spec a)
-    -> f (context ('Spec labels a))
+    -> f (context ('Spec a))
-    -> context' ('Spec labels (list a)))
+    -> context' ('Spec (list a)))
   -> f (t context)
   -> HVectorize list t context'
 hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->
@@ -105,10 +104,10 @@ hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->
 
 
 hunvectorize :: (HTable t, Zip f, Vector list)
-  => (forall labels a. ()
+  => (forall a. ()
-    => SSpec ('Spec labels a)
+    => SSpec ('Spec a)
-    -> context ('Spec labels (list a))
+    -> context ('Spec (list a))
-    -> f (context' ('Spec labels a)))
+    -> f (context' ('Spec a)))
   -> HVectorize list t context
   -> f (t context')
 hunvectorize unvectorizer (HVectorize table) =
@@ -119,12 +118,12 @@ hunvectorize unvectorizer (HVectorize table) =
 
 
 happend :: (HTable t, Vector list) =>
-  ( forall labels a. ()
+  ( forall a. ()
     => Nullity a
     -> TypeInformation (Unnullify a)
-    -> context ('Spec labels (list a))
+    -> context ('Spec (list a))
-    -> context ('Spec labels (list a))
+    -> context ('Spec (list a))
-    -> context ('Spec labels (list a))
+    -> context ('Spec (list a))
   )
   -> HVectorize list t context
   -> HVectorize list t context
@@ -136,16 +135,11 @@ happend append (HVectorize as) (HVectorize bs) = HVectorize $
 
 
 hempty :: HTable t =>
-  ( forall labels a. ()
+  ( forall a. ()
     => Nullity a
     -> TypeInformation (Unnullify a)
-    -> context ('Spec labels [a])
+    -> context ('Spec [a])
   )
   -> HVectorize [] t context
 hempty empty = HVectorize $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of
   SSpec {nullity, info} -> empty nullity info
-
-
-instance HLabelable g => HLabelable (Precompose (Vectorize list) g) where
-  hlabeler = Precompose . hlabeler . precomposed
-  hunlabeler = Precompose . hunlabeler . precomposed

src/Rel8/Schema/Name.hs

@@ -28,7 +28,6 @@ import Prelude
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Schema.Context ( Interpretation, Col )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
 import Rel8.Schema.Null ( Sql )
 import Rel8.Schema.Reify ( notReify )
@@ -84,12 +83,7 @@ instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
 
 instance Interpretation Name where
   data Col Name _spec where
-    N :: {unN :: !(Name a)} -> Col Name ('Spec labels a)
+    N :: {unN :: !(Name a)} -> Col Name ('Spec a)
-
-
-instance Labelable Name where
-  labeler (N a) = N a
-  unlabeler (N a) = N a
 
 
 -- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for

src/Rel8/Schema/Reify.hs

@@ -23,7 +23,6 @@ import Prelude
 
 -- rel8
 import Rel8.Schema.Context ( Interpretation, Col )
-import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
 import Rel8.Schema.HTable ( HTable, hmap )
 import Rel8.Schema.Kind ( Context )
 
@@ -36,11 +35,6 @@ 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)
-
-
 hreify :: HTable t => t (Col context) -> t (Col (Reify context))
 hreify = hmap Reify
 

src/Rel8/Schema/Result.hs

@@ -6,7 +6,6 @@
 
 module Rel8.Schema.Result
   ( Col( R, unR ), Result
-  , relabel
   , null, nullifier, unnullifier
   , vectorizer, unvectorizer
   )
@@ -17,7 +16,6 @@ import Prelude hiding ( null )
 
 -- rel8
 import Rel8.Schema.Context ( Interpretation( Col ) )
-import Rel8.Schema.HTable.Identity ( HIdentity(..) )
 import Rel8.Schema.Kind ( Context )
 import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )
 import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
@@ -33,32 +31,26 @@ data Result a
 
 instance Interpretation Result where
   data Col Result _spec where
-    R :: {unR :: !a} -> Col Result ('Spec labels a)
+    R :: {unR :: !a} -> Col Result ('Spec a)
 
 
-relabel :: ()
+null :: Col Result ('Spec (Maybe a))
-  => HIdentity ('Spec labels a) (Col Result)
-  -> HIdentity ('Spec relabels a) (Col Result)
-relabel (HIdentity (R a)) = HIdentity (R a)
-
-
-null :: Col Result ('Spec labels (Maybe a))
 null = R Nothing
 
 
 nullifier :: ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> Col Result ('Spec labels a)
+  -> Col Result ('Spec a)
-  -> Col Result ('Spec labels (Nullify a))
+  -> Col Result ('Spec (Nullify a))
 nullifier SSpec {nullity} (R a) = R $ case nullity of
   Null -> a
   NotNull -> Just a
 
 
 unnullifier :: ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> Col Result ('Spec labels (Nullify a))
+  -> Col Result ('Spec (Nullify a))
-  -> Maybe (Col Result ('Spec labels a))
+  -> Maybe (Col Result ('Spec a))
 unnullifier SSpec {nullity} (R a) =
   case nullity of
     Null -> pure $ R a
@@ -66,14 +58,14 @@ unnullifier SSpec {nullity} (R a) =
 
 
 vectorizer :: Functor f
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> f (Col Result ('Spec labels a))
+  -> f (Col Result ('Spec a))
-  -> Col Result ('Spec labels (f a))
+  -> Col Result ('Spec (f a))
 vectorizer _ = R . fmap unR
 
 
 unvectorizer :: Functor f
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> Col Result ('Spec labels (f a))
+  -> Col Result ('Spec (f a))
-  -> f (Col Result ('Spec labels a))
+  -> f (Col Result ('Spec a))
 unvectorizer _ (R results) = R <$> results

src/Rel8/Schema/Spec.hs

@@ -13,27 +13,26 @@ where
 
 -- base
 import Data.Kind ( Constraint, Type )
-import Prelude ()
+import Prelude
 
 -- rel8
-import Rel8.Kind.Labels ( Labels, SLabels, KnownLabels, labelsSing )
 import Rel8.Schema.Null ( Nullity, Sql, Unnullify, nullable )
 import Rel8.Type ( DBType, typeInformation )
 import Rel8.Type.Information ( TypeInformation )
 
 
 type Spec :: Type
-data Spec = Spec Labels Type
+newtype Spec = Spec Type
 
 
 type SSpec :: Spec -> Type
 data SSpec spec where
   SSpec ::
-    { labels :: SLabels labels
+    { labels :: [String]
     , info :: TypeInformation (Unnullify a)
     , nullity :: Nullity a
     }
-    -> SSpec ('Spec labels a)
+    -> SSpec ('Spec a)
 
 
 type KnownSpec :: Spec -> Constraint
@@ -41,14 +40,9 @@ class KnownSpec spec where
   specSing :: SSpec spec
 
 
-instance
+instance Sql DBType a => KnownSpec ('Spec a) where
-  ( KnownLabels labels
-  , Sql DBType a
-  )
-  => KnownSpec ('Spec labels a)
- where
   specSing = SSpec
-    { labels = labelsSing
+    { labels = []
     , info = typeInformation
     , nullity = nullable
     }

src/Rel8/Schema/Spec/ConstrainDBType.hs

@@ -31,47 +31,47 @@ import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, nullity ) )
 
 type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint
 class
-  ( forall c labels a. ()
+  ( forall c a. ()
-     => (spec ~ 'Spec labels a)
+     => (spec ~ 'Spec a)
      => (forall x. (constraint x => c x)) => Sql c a
   )
   => ConstrainDBType constraint spec
 instance
-  ( spec ~ 'Spec labels a
+  ( spec ~ 'Spec a
   , Sql constraint a
   )
   => ConstrainDBType constraint spec
 
 
-dbTypeNullity :: Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
+dbTypeNullity :: Dict (ConstrainDBType c) ('Spec a) -> Nullity a
 dbTypeNullity = step2 . step1
   where
-    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
+    step1 :: Dict (ConstrainDBType c) ('Spec a) -> Dict (Sql c) a
     step1 Dict = Dict
 
     step2 :: Dict (Sql c) a -> Nullity a
     step2 Dict = nullable
 
 
-dbTypeDict :: Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
+dbTypeDict :: Dict (ConstrainDBType c) ('Spec a) -> Dict c (Unnullify a)
 dbTypeDict = step2 . step1
   where
-    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
+    step1 :: Dict (ConstrainDBType c) ('Spec a) -> Dict (Sql c) a
     step1 Dict = Dict
 
     step2 :: Dict (Sql c) a -> Dict c (Unnullify a)
     step2 Dict = Dict
 
 
-fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l a)
+fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec a)
 fromNullityDict Null Dict = Dict
 fromNullityDict NotNull Dict = Dict
 
 
 nullifier :: ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> Dict (ConstrainDBType c) ('Spec labels a)
+  -> Dict (ConstrainDBType c) ('Spec a)
-  -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
+  -> Dict (ConstrainDBType c) ('Spec (Nullify a))
 nullifier SSpec {} dict = case dbTypeDict dict of
   Dict -> case dbTypeNullity dict of
     Null -> Dict
@@ -79,9 +79,9 @@ nullifier SSpec {} dict = case dbTypeDict dict of
 
 
 unnullifier :: ()
-  => SSpec ('Spec labels a)
+  => SSpec ('Spec a)
-  -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
+  -> Dict (ConstrainDBType c) ('Spec (Nullify a))
-  -> Dict (ConstrainDBType c) ('Spec labels a)
+  -> Dict (ConstrainDBType c) ('Spec a)
 unnullifier SSpec {nullity} dict = case dbTypeDict dict of
   Dict -> case nullity of
     Null -> Dict

src/Rel8/Table.hs

@@ -41,11 +41,10 @@ import Rel8.Generic.Table
   )
 import Rel8.Generic.Record ( Record(..) )
 import Rel8.Generic.Reify ( ARep )
-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(..), HType )
-import Rel8.Schema.HTable.Label ( hlabel, hunlabel )
+import Rel8.Schema.HTable.Label ( hlabel, hrelabel, hunlabel )
 import Rel8.Schema.HTable.List ( HListTable )
 import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )
 import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
@@ -61,7 +60,6 @@ import Rel8.Schema.Reify
   )
 import Rel8.Schema.Result
   ( Col( R ), Result
-  , relabel
   , null, nullifier, unnullifier
   , vectorizer, unvectorizer
   )
@@ -247,20 +245,20 @@ instance (Table Result a, Table Result b) => Table Result (Either a b) where
 
   toColumns = \case
     Left table -> HEitherTable
-      { htag = HIdentity (R IsLeft)
+      { htag = hlabel (HType (R IsLeft))
-      , hleft = hlabel labeler (hnullify nullifier (toColumns table))
+      , hleft = hlabel (hnullify nullifier (toColumns table))
-      , hright = hlabel labeler (hnulls (const null))
+      , hright = hlabel (hnulls (const null))
       }
     Right table -> HEitherTable
-      { htag = HIdentity (R IsRight)
+      { htag = hlabel (HType (R IsRight))
-      , hleft = hlabel labeler (hnulls (const null))
+      , hleft = hlabel (hnulls (const null))
-      , hright = hlabel labeler (hnullify nullifier (toColumns table))
+      , hright = hlabel (hnullify nullifier (toColumns table))
       }
 
-  fromColumns HEitherTable {htag, hleft, hright} = case htag of
+  fromColumns HEitherTable {htag, hleft, hright} = case hunlabel htag of
-    HIdentity (R tag) -> case tag of
+    HType (R tag) -> case tag of
-      IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hleft)
+      IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel hleft)
-      IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hright)
+      IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel hright)
     where
       err = error "Either.fromColumns: mismatch between tag and data"
 
@@ -279,17 +277,17 @@ instance Table Result a => Table Result (Maybe a) where
 
   toColumns = \case
     Nothing -> HMaybeTable
-      { htag = HIdentity (R Nothing)
+      { htag = hlabel (HIdentity (R Nothing))
-      , hjust = hlabel labeler (hnulls (const null))
+      , hjust = hlabel (hnulls (const null))
       }
     Just table -> HMaybeTable
-      { htag = HIdentity (R (Just IsJust))
+      { htag = hlabel (HIdentity (R (Just IsJust)))
-      , hjust = hlabel labeler (hnullify nullifier (toColumns table))
+      , hjust = hlabel (hnullify nullifier (toColumns table))
       }
 
-  fromColumns HMaybeTable {htag, hjust} = case htag of
+  fromColumns HMaybeTable {htag, hjust} = case hunlabel htag of
-    HIdentity (R tag) -> tag $>
+    HType (R tag) -> tag $>
-      case hunnullify unnullifier (hunlabel unlabeler hjust) of
+      case hunnullify unnullifier (hunlabel hjust) of
         Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
         Just just -> fromColumns just
 
@@ -307,10 +305,10 @@ instance (Table Result a, Table Result b) => Table Result (These a b) where
   type Context (These a b) = Result
 
   toColumns tables = HTheseTable
-    { hhereTag = relabel hhereTag
+    { hhereTag = hrelabel hhereTag
-    , hhere = hlabel labeler (hunlabel unlabeler (toColumns hhere))
+    , hhere = hrelabel (toColumns hhere)
-    , hthereTag = relabel hthereTag
+    , hthereTag = hrelabel hthereTag
-    , hthere = hlabel labeler (hunlabel unlabeler (toColumns hthere))
+    , hthere = hrelabel (toColumns hthere)
     }
     where
       HMaybeTable
@@ -330,29 +328,27 @@ instance (Table Result a, Table Result b) => Table Result (These a b) where
       _ -> error "These.fromColumns: mismatch between tags and data"
     where
       mhere = HMaybeTable
-        { htag = relabel hhereTag
+        { htag = hrelabel hhereTag
-        , hjust = hlabel labeler (hunlabel unlabeler hhere)
+        , hjust = hrelabel hhere
         }
       mthere = HMaybeTable
-        { htag = relabel hthereTag
+        { htag = hrelabel hthereTag
-        , hjust = hlabel labeler (hunlabel unlabeler hthere)
+        , hjust = hrelabel hthere
         }
 
 
-instance (Table context a, Table context b, Labelable context)
+instance (Table context a, Table context b)
   => Table context (a, b)
 
 
 instance
   ( Table context a, Table context b, Table context c
-  , Labelable context
   )
   => Table context (a, b, c)
 
 
 instance
   ( Table context a, Table context b, Table context c, Table context d
-  , Labelable context
   )
   => Table context (a, b, c, d)
 
@@ -360,7 +356,6 @@ instance
 instance
   ( Table context a, Table context b, Table context c, Table context d
   , Table context e
-  , Labelable context
   )
   => Table context (a, b, c, d, e)
 
@@ -368,7 +363,6 @@ instance
 instance
   ( Table context a, Table context b, Table context c, Table context d
   , Table context e, Table context f
-  , Labelable context
   )
   => Table context (a, b, c, d, e, f)
 
@@ -376,7 +370,6 @@ instance
 instance
   ( Table context a, Table context b, Table context c, Table context d
   , Table context e, Table context f, Table context g
-  , Labelable context
   )
   => Table context (a, b, c, d, e, f, g)
 

src/Rel8/Table/Either.hs

@@ -32,10 +32,6 @@ import Prelude hiding ( undefined )
 -- rel8
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Serialize ( litExpr )
-import Rel8.Schema.Context.Label
-  ( Labelable
-  , HLabelable, hlabeler, hunlabeler
-  )
 import Rel8.Schema.Context.Nullify
   ( Nullifiable, ConstrainTag
   , HNullifiable, HConstrainTag
@@ -111,7 +107,7 @@ instance (Table Expr a, Table Expr b) => Semigroup (EitherTable a b) where
 
 instance
   ( Table context a, Table context b
-  , Labelable context, Nullifiable context, ConstrainTag context EitherTag
+  , Nullifiable context, ConstrainTag context EitherTag
   ) =>
   Table context (EitherTable a b)
  where
@@ -125,8 +121,8 @@ instance
 
 
 instance
-  ( Nullifiable from, Labelable from, ConstrainTag from EitherTag
+  ( Nullifiable from, ConstrainTag from EitherTag
-  , Nullifiable to, Labelable to, ConstrainTag to EitherTag
+  , Nullifiable to, ConstrainTag to EitherTag
   , Recontextualize from to a1 b1
   , Recontextualize from to a2 b2
   )
@@ -206,7 +202,6 @@ toColumns2 ::
   ( HTable t
   , HTable u
   , HConstrainTag context EitherTag
-  , HLabelable context
   , HNullifiable context
   )
   => (a -> t context)
@@ -215,18 +210,17 @@ toColumns2 ::
   -> HEitherTable t u context
 toColumns2 f g EitherTable {tag, left, right} = HEitherTable
   { htag
-  , hleft = hlabel hlabeler $ hnullify (hnullifier tag isLeft) $ f left
+  , hleft = hlabel $ hnullify (hnullifier tag isLeft) $ f left
-  , hright = hlabel hlabeler $ hnullify (hnullifier tag isRight) $ g right
+  , hright = hlabel $ hnullify (hnullifier tag isRight) $ g right
   }
   where
-    htag = HIdentity (hencodeTag tag)
+    htag = hlabel $ HType $ hencodeTag tag
 
 
 fromColumns2 ::
   ( HTable t
   , HTable u
   , HConstrainTag context EitherTag
-  , HLabelable context
   , HNullifiable context
   )
   => (t context -> a)
@@ -237,12 +231,12 @@ fromColumns2 f g HEitherTable {htag, hleft, hright} = EitherTable
   { tag
   , left = f $ runIdentity $
      hunnullify (\a -> pure . hunnullifier a) $
-     hunlabel hunlabeler
+     hunlabel
      hleft
   , right = g $ runIdentity $
      hunnullify (\a -> pure . hunnullifier a) $
-     hunlabel hunlabeler
+     hunlabel
      hright
   }
   where
-    tag = hdecodeTag $ unHIdentity htag
+    tag = hdecodeTag $ unHIdentity $ hunlabel htag

src/Rel8/Table/Maybe.hs

@@ -30,9 +30,6 @@ import Prelude hiding ( null, undefined )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( boolExpr )
 import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )
-import Rel8.Schema.Context.Label
-  ( Labelable, HLabelable, hlabeler, hunlabeler
-  )
 import Rel8.Schema.Context.Nullify
   ( Nullifiable, ConstrainTag
   , HNullifiable, HConstrainTag
@@ -131,7 +128,7 @@ instance (Table Expr a, Semigroup a) => Monoid (MaybeTable a) where
 
 instance
   ( Table context a
-  , Labelable context, Nullifiable context
+  , Nullifiable context
   , ConstrainTag context MaybeTag
   ) => Table context (MaybeTable a)
  where
@@ -145,8 +142,8 @@ instance
 
 
 instance
-  ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag
+  ( Nullifiable from, ConstrainTag from MaybeTag
-  , Labelable to, Nullifiable to, ConstrainTag to MaybeTag
+  , Nullifiable to, ConstrainTag to MaybeTag
   , Recontextualize from to a b
   )
   => Recontextualize from to (MaybeTable a) (MaybeTable b)
@@ -222,7 +219,6 @@ nameMaybeTable = MaybeTable . fromName
 toColumns1 ::
   ( HTable t
   , HConstrainTag context MaybeTag
-  , HLabelable context
   , HNullifiable context
   )
   => (a -> t context)
@@ -230,25 +226,24 @@ toColumns1 ::
   -> HMaybeTable t context
 toColumns1 f MaybeTable {tag, just} = HMaybeTable
   { htag
-  , hjust = hlabel hlabeler $ hnullify (hnullifier tag isNonNull) $ f just
+  , hjust = hlabel $ hnullify (hnullifier tag isNonNull) $ f just
   }
   where
-    htag = HIdentity (hencodeTag tag)
+    htag = hlabel (HType (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
+fromColumns1 f HMaybeTable {htag, hjust} = MaybeTable
   { tag
   , just = f $ runIdentity $
-      hunnullify (\a -> pure . hunnullifier a) (hunlabel hunlabeler hjust)
+      hunnullify (\a -> pure . hunnullifier a) (hunlabel hjust)
   }
   where
-    tag = hdecodeTag htag
+    tag = hdecodeTag (unHIdentity (hunlabel htag))

src/Rel8/Table/Name.hs

@@ -17,7 +17,8 @@ where
 -- base
 import Data.Foldable ( fold )
 import Data.Functor.Const ( Const( Const ), getConst )
-import Data.List.NonEmpty ( NonEmpty, intersperse )
+import Data.List.NonEmpty ( NonEmpty, intersperse, nonEmpty )
+import Data.Maybe ( fromMaybe )
 import Prelude
 
 -- opaleye
@@ -26,7 +27,6 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
 -- rel8
 import Rel8.Expr ( Expr, Col( E ) )
 import Rel8.Expr.Opaleye ( toPrimExpr )
-import Rel8.Kind.Labels ( renderLabels )
 import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
 import Rel8.Schema.Name ( Name( Name ), Col( N ) )
 import Rel8.Schema.Spec ( SSpec(..) )
@@ -82,3 +82,7 @@ showNames :: forall a. Table Name a => a -> [String]
 showNames (toColumns -> names) = getConst $
   htabulateA @(Columns a) $ \field -> case hfield names field of
     N (Name name) -> Const [name]
+
+
+renderLabels :: [String] -> NonEmpty String
+renderLabels labels = fromMaybe (pure "anon") (nonEmpty labels )

src/Rel8/Table/Recontextualize.hs

@@ -18,7 +18,6 @@ import Prelude ()
 
 -- rel8
 import Rel8.Schema.Context ( Col )
-import Rel8.Schema.Context.Label ( Labelable )
 import Rel8.Schema.HTable ( HTable )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.Null ( Sql )
@@ -54,8 +53,6 @@ instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))
 instance
   ( Recontextualize from to a1 b1
   , Recontextualize from to a2 b2
-  , Labelable from
-  , Labelable to
   )
   => Recontextualize from to (a1, a2) (b1, b2)
 
@@ -64,7 +61,6 @@ instance
   ( Recontextualize from to a1 b1
   , Recontextualize from to a2 b2
   , Recontextualize from to a3 b3
-  , Labelable from, Labelable to
   )
   => Recontextualize from to (a1, a2, a3) (b1, b2, b3)
 
@@ -74,7 +70,6 @@ instance
   , Recontextualize from to a2 b2
   , Recontextualize from to a3 b3
   , Recontextualize from to a4 b4
-  , Labelable from, Labelable to
   )
   => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)
 
@@ -85,6 +80,28 @@ instance
   , Recontextualize from to a3 b3
   , Recontextualize from to a4 b4
   , Recontextualize from to a5 b5
-  , Labelable from, Labelable to
   )
   => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
+
+
+instance
+  ( Recontextualize from to a1 b1
+  , Recontextualize from to a2 b2
+  , Recontextualize from to a3 b3
+  , Recontextualize from to a4 b4
+  , Recontextualize from to a5 b5
+  , Recontextualize from to a6 b6
+  )
+  => Recontextualize from to (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6)
+
+
+instance
+  ( Recontextualize from to a1 b1
+  , Recontextualize from to a2 b2
+  , Recontextualize from to a3 b3
+  , Recontextualize from to a4 b4
+  , Recontextualize from to a5 b5
+  , Recontextualize from to a6 b6
+  , Recontextualize from to a7 b7
+  )
+  => Recontextualize from to (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7)

src/Rel8/Table/Rel8able.hs

@@ -25,7 +25,7 @@ import qualified Rel8.Kind.Algebra as K
 import Rel8.Kind.Context
   ( SContext( SReify )
   , Reifiable, contextSing
-  , sLabelable, sReifiable
+  , sReifiable
   )
 import Rel8.Generic.Rel8able
   ( Rel8able, Algebra
@@ -33,7 +33,6 @@ import Rel8.Generic.Rel8able
   , greify, gunreify
   )
 import Rel8.Schema.Context ( Col )
-import Rel8.Schema.Context.Label ( Labelable )
 import Rel8.Schema.Dict ( Dict( Dict ) )
 import qualified Rel8.Schema.Kind as K
 import Rel8.Schema.HTable ( HConstrainTable, hdicts )
@@ -54,7 +53,7 @@ import Rel8.Type.Eq ( DBEq )
 import Rel8.Type.Ord ( DBOrd )
 
 
-instance (Rel8able t, Labelable context, Reifiable context) =>
+instance (Rel8able t, Reifiable context) =>
   Table context (t context)
  where
   type Columns (t context) = GColumns t
@@ -65,20 +64,18 @@ instance (Rel8able t, Labelable context, Reifiable context) =>
   toColumns = hunreify . gtoColumns . greify
 
   reify Refl = case contextSing @context of
-    SReify context -> case sLabelable context of
+    SReify context -> case sReifiable context of
-      Dict -> case sReifiable context of
+      Dict -> greify
-        Dict -> greify
 
   unreify Refl = case contextSing @context of
-    SReify context -> case sLabelable context of
+    SReify context -> case sReifiable context of
-      Dict -> case sReifiable context of
+      Dict -> gunreify
-        Dict -> gunreify
 
 
 instance
   ( Rel8able t
-  , Labelable from, Reifiable from
+  , Reifiable from
-  , Labelable to, Reifiable to
+  , Reifiable to
   , Congruent (t from) (t to)
   )
   => Recontextualize from to (t from) (t to)

src/Rel8/Table/These.hs

@@ -36,10 +36,6 @@ import Prelude hiding ( undefined )
 import Rel8.Expr ( Expr )
 import Rel8.Expr.Bool ( (&&.), not_ )
 import Rel8.Expr.Null ( isNonNull )
-import Rel8.Schema.Context.Label
-  ( Labelable
-  , HLabelable, hlabeler, hunlabeler
-  )
 import Rel8.Schema.Context.Nullify
   ( Nullifiable, ConstrainTag
   , HNullifiable, HConstrainTag
@@ -136,7 +132,7 @@ instance (Table Expr a, Table Expr b, Semigroup a, Semigroup b) =>
 
 instance
   ( Table context a, Table context b
-  , Labelable context, Nullifiable context, ConstrainTag context MaybeTag
+  , Nullifiable context, ConstrainTag context MaybeTag
   ) => Table context (TheseTable a b)
  where
   type Columns (TheseTable a b) = HTheseTable (Columns a) (Columns b)
@@ -149,8 +145,8 @@ instance
 
 
 instance
-  ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag
+  ( Nullifiable from, ConstrainTag from MaybeTag
-  , Labelable to, Nullifiable to, ConstrainTag to MaybeTag
+  , Nullifiable to, ConstrainTag to MaybeTag
   , Recontextualize from to a1 b1
   , Recontextualize from to a2 b2
   ) =>
@@ -285,7 +281,6 @@ toColumns2 ::
   ( HTable t
   , HTable u
   , HConstrainTag context MaybeTag
-  , HLabelable context
   , HNullifiable context
   )
   => (a -> t context)
@@ -293,12 +288,12 @@ toColumns2 ::
   -> TheseTable a b
   -> HTheseTable t u context
 toColumns2 f g TheseTable {here, there} = HTheseTable
-  { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))
+  { hhereTag = hlabel $ HType $ hencodeTag (toHereTag (tag here))
   , hhere =
-      hlabel hlabeler $ hnullify (hnullifier (tag here) isNonNull) $ f (just here)
+      hlabel $ hnullify (hnullifier (tag here) isNonNull) $ f (just here)
-  , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))
+  , hthereTag = hlabel $ HType $ hencodeTag (toThereTag (tag there))
   , hthere =
-      hlabel hlabeler $ hnullify (hnullifier (tag there) isNonNull) $ g (just there)
+      hlabel $ hnullify (hnullifier (tag there) isNonNull) $ g (just there)
   }
 
 
@@ -306,7 +301,6 @@ fromColumns2 ::
   ( HTable t
   , HTable u
   , HConstrainTag context MaybeTag
-  , HLabelable context
   , HNullifiable context
   )
   => (t context -> a)
@@ -316,26 +310,26 @@ fromColumns2 ::
 fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} = TheseTable
   { here =
       let
-        tag = hdecodeTag $ unHIdentity hhereTag
+        tag = hdecodeTag $ unHIdentity $ hunlabel hhereTag
       in
         MaybeTable
           { tag
           , just = f $
               runIdentity $
               hunnullify (\a -> pure . hunnullifier a) $
-              hunlabel hunlabeler
+              hunlabel
               hhere
           }
   , there =
       let
-        tag = hdecodeTag $ unHIdentity hthereTag
+        tag = hdecodeTag $ unHIdentity $ hunlabel hthereTag
       in
         MaybeTable
           { tag
           , just = g $
               runIdentity $
               hunnullify (\a -> pure . hunnullifier a) $
-              hunlabel hunlabeler
+              hunlabel
               hthere
           }
   }