diff --git a/.ghci b/.ghci
new file mode 100644
index 00000000..a48e262f
--- /dev/null
+++ b/.ghci
@@ -0,0 +1 @@
+:set -XDeriveAnyClass -XDeriveGeneric -XTemplateHaskell
diff --git a/bare_shell.nix b/bare_shell.nix
new file mode 100644
index 00000000..e6efd0cf
--- /dev/null
+++ b/bare_shell.nix
@@ -0,0 +1,4 @@
+let pkgs = (builtins.getFlake "nixpkgs").legacyPackages.x86_64-linux;
+in
+  pkgs.mkShell { buildInputs = with pkgs; [ghc cabal-install postgresql postgresql.dev zlib
+  pkg-config];}
diff --git a/cabal.project b/cabal.project
index 2a04d302..bd28403f 100644
--- a/cabal.project
+++ b/cabal.project
@@ -9,3 +9,5 @@ source-repository-package
 
 allow-newer: base16:base, base16:deepseq, base16:text
 allow-newer: *:base, *:template-haskell, *:ghc-prim
+
+tests: true
diff --git a/rel8-internal/src/Rel8/Internal/Generic/Rel8able.hs b/rel8-internal/src/Rel8/Internal/Generic/Rel8able.hs
index 0a36d1a5..04cddf91 100644
--- a/rel8-internal/src/Rel8/Internal/Generic/Rel8able.hs
+++ b/rel8-internal/src/Rel8/Internal/Generic/Rel8able.hs
@@ -16,12 +16,11 @@
 {-# language UndecidableInstances #-}
 
 module Rel8.Internal.Generic.Rel8able
-  ( KRel8able, Rel8able
+  ( KRel8able, Rel8able(..)
   , Algebra
   , GRep
-  , GColumns, gfromColumns, gtoColumns
-  , GFromExprs, gfromResult, gtoResult
-  , TSerialize, serialize, deserialize
+  , TSerialize, Serialize, serialize, deserialize
+  , GColumns
   )
 where
 
diff --git a/rel8-internal/src/Rel8/Internal/Schema/HTable/Label.hs b/rel8-internal/src/Rel8/Internal/Schema/HTable/Label.hs
index 701120f7..2cb24317 100644
--- a/rel8-internal/src/Rel8/Internal/Schema/HTable/Label.hs
+++ b/rel8-internal/src/Rel8/Internal/Schema/HTable/Label.hs
@@ -7,7 +7,7 @@
 {-# language TypeFamilies #-}
 
 module Rel8.Internal.Schema.HTable.Label
-  ( HLabel, hlabel, hrelabel, hunlabel
+  ( HLabel(..), hlabel, hrelabel, hunlabel
   , hproject
   )
 where
diff --git a/rel8/rel8.cabal b/rel8/rel8.cabal
index caa59bbe..24c10f79 100644
--- a/rel8/rel8.cabal
+++ b/rel8/rel8.cabal
@@ -28,6 +28,9 @@ library
     , product-profunctors
     , semigroupoids
     , time
+    , containers
+    , template-haskell
+    , th-abstraction
 
   default-language:
     Haskell2010
@@ -45,6 +48,7 @@ library
 
   hs-source-dirs:
     src
+
   exposed-modules:
     Rel8
     Rel8.Array
@@ -55,6 +59,7 @@ library
     Rel8.Expr.Time
     Rel8.Range
     Rel8.Tabulate
+    Rel8.TH
 
 test-suite tests
   type:             exitcode-stdio-1.0
@@ -84,6 +89,7 @@ test-suite tests
 
   other-modules:
     Rel8.Generic.Rel8able.Test
+    Rel8.TH.Rel8able.Test
 
   main-is:          Main.hs
   hs-source-dirs:   tests
diff --git a/rel8/src/Rel8/TH.hs b/rel8/src/Rel8/TH.hs
new file mode 100644
index 00000000..a5bfa0c7
--- /dev/null
+++ b/rel8/src/Rel8/TH.hs
@@ -0,0 +1,242 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE CPP #-}
+module Rel8.TH (deriveRel8able, parseDatatype) where
+
+import Prelude hiding (foldr1)
+import Rel8.Internal.Table.Serialize ( ToExprs )
+import Language.Haskell.TH (Q)
+import qualified Language.Haskell.TH as TH
+import qualified Language.Haskell.TH.Syntax as TH
+import Language.Haskell.TH.Datatype (reifyDatatype, DatatypeInfo (..), datatypeCons, constructorFields, ConstructorVariant (RecordConstructor), constructorVariant)
+import qualified Language.Haskell.TH.Datatype as TH.Datatype
+import Rel8.Internal.Generic.Rel8able ( Rel8able(..), Serialize, serialize, deserialize)
+import Rel8.Internal.Schema.Result (Result)
+import Rel8.Internal.Schema.HTable.Product (HProduct(HProduct))
+import Rel8.Internal.Kind.Context (SContext(..))
+import Rel8.Internal.Column ( Column )
+import Rel8.Internal.Expr ( Expr )
+import Rel8.Internal.Table (Columns, toColumns, fromColumns, Transpose)
+import Rel8.Internal.Schema.Kind (Context)
+import Data.List (unsnoc)
+import Rel8.Internal.Schema.HTable.Label (HLabel(..))
+import Data.Proxy (Proxy(Proxy))
+import qualified Data.Map.Strict as M
+import Data.Type.Equality (type (==))
+import Control.Monad (zipWithM)
+import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.Foldable1 (foldr1)
+import Data.Foldable (toList)
+import Rel8.Internal.Schema.HTable.Identity (HIdentity)
+
+
+-- We derive a Rel8able instance using TH.
+-- At it's core a Rel8able instance is a bijection between a datatype and the the SQL columns corresponding to its fields.
+-- We only support datatypes with one constructor.
+-- The datatype must have exactly one type arg and it is the index for our HKD stuff.
+-- Question: Can we support multiple type args?
+---
+-- We have three types of fields:
+-- 1) Column f Text : Directly using Column, easy. This is just a special case of (3)
+-- 2) OtherType f : They embed another Rel8able type
+-- 3) TabledType : They embed a type with a table instance.
+--     eg, we might see something like (Column f Text, Column f Bool). (,) has a Table instance,
+--     so we know how to map this type to SQL columns.
+--
+-- We represent a vector of SQL columns with basically:
+-- HLabel "field label" (HIdentity Text) `HProduct` HLabel "another field" (HIdentity Bool) ...
+-- Nothing too complicated here. I'm not sure if we are allowed to leave the HLabels out or if that will cause everything to explode.
+-- This H* stuff is also used to thread around contexts if you look at the definitions of these things
+
+data ParsedDatatype =
+  ParsedDatatype
+  { name :: TH.Name
+  , conName :: TH.Name
+  , fBinder :: TH.Name
+  , fields :: NonEmpty ParsedField
+  }
+  deriving (Show)
+
+data ParsedField =
+  ParsedField
+  { fieldSelector :: Maybe TH.Name
+  , fieldVariant :: ParsedFieldVariant
+  , fieldType :: TH.Type
+  , fieldColumnType :: TH.Type
+  , fieldFreshName :: TH.Name
+  }
+  deriving (Show)
+
+data ParsedFieldVariant = TableField
+  deriving (Show)
+
+-- | 'fail' but indicate that the failure is coming from our code
+prettyFail :: String -> Q a
+prettyFail str = fail $ "deriveRel8able: " ++ str
+
+parseDatatype :: DatatypeInfo -> Q ParsedDatatype
+parseDatatype datatypeInfo = do
+  constructor <-
+    -- Check that it only has one constructor
+    case datatypeCons datatypeInfo of
+      [cons] -> pure cons
+      _ -> prettyFail "exepecting a datatype with exactly 1 constructor"
+  let conName = TH.Datatype.constructorName constructor
+  let name = datatypeName datatypeInfo
+  fBinder <- case unsnoc $ datatypeInstTypes datatypeInfo of
+    Just (_, candidate) -> parseFBinder candidate
+    Nothing -> prettyFail "expecting the datatype to have a context type parameter like `data Foo f = ...`"
+  let fieldSelectors = case constructorVariant constructor of
+        -- Only record constructors have field names
+        RecordConstructor names -> map Just names
+        _ -> repeat Nothing
+  fieldList <- zipWithM (parseField fBinder) (constructorFields constructor) fieldSelectors
+  fields <- maybe (prettyFail "Expected at least one field") pure $ nonEmpty fieldList
+  pure ParsedDatatype{..}
+
+parseFBinder :: TH.Type -> Q TH.Name
+parseFBinder (TH.SigT x (TH.ConT kind))
+  | kind == ''Context = parseFBinder x
+  | otherwise = prettyFail $ "expected kind encountered for the context type argument: " ++ show kind
+parseFBinder (TH.VarT name) = pure name
+parseFBinder typ = prettyFail $ "unexpected type encountered while looking for the context type argument to the datatype: " ++ show typ
+
+parseField :: TH.Name -> TH.Type -> Maybe TH.Name -> Q ParsedField
+parseField fBinder fieldType fieldSelector = do
+  n <- TH.newName "x"
+  let ft = TH.Datatype.applySubstitution (M.fromList [(fBinder, TH.ConT ''Expr)]) $ resolveColumnF fBinder fieldType
+  columnType <- case ft of
+    -- Without special casing this, we get an UndecidableInstance error, since
+    (TH.ConT exprName' `TH.AppT` x) | exprName' == ''Expr -> [t|HIdentity $(pure x)|]--
+    _ -> [t|Columns $(pure ft) |]
+  pure $ ParsedField { fieldSelector = fieldSelector, fieldVariant =  TableField, fieldType = ft, fieldColumnType = columnType, fieldFreshName = n}
+
+generateGColumns :: ParsedDatatype -> Q TH.Type
+generateGColumns ParsedDatatype{..} =
+  foldr1 (\x y -> [t|HProduct $x $y|]) $ fmap generateGColumn fields
+  where
+    generateGColumn ParsedField{..} =
+      labelled fieldSelector [t| $(pure fieldColumnType)|]
+    labelled Nothing x = x
+    labelled (Just (TH.Name (TH.OccName fieldSelector) _)) x = [t|HLabel $(TH.litT $ TH.strTyLit fieldSelector) $x|]
+
+generateColumnsE :: ParsedDatatype -> (Q TH.Type -> Q TH.Exp -> Q TH.Exp) -> Q TH.Exp
+generateColumnsE ParsedDatatype{..} g =
+  foldr1 (\x y -> TH.conE 'HProduct `TH.appE` x `TH.appE` y) $ fmap generateColumnE fields
+  where
+    generateColumnE ParsedField{..} =
+      labelled fieldSelector $
+      case fieldVariant of
+        TableField -> g (pure fieldType) $ TH.varE fieldFreshName
+    labelled Nothing x = x
+    labelled (Just _) x = TH.conE 'HLabel `TH.appE`x
+
+generateColumnsP :: ParsedDatatype -> TH.Pat
+generateColumnsP ParsedDatatype{..} =
+  foldr1 (\x y -> TH.ConP 'HProduct [] [x, y]) $ fmap generateColumnP fields
+  where
+    generateColumnP ParsedField{..} =
+      labelled fieldSelector $
+      case fieldVariant of
+        TableField -> TH.VarP fieldFreshName
+    labelled Nothing x = x
+    labelled (Just _) x = TH.ConP 'HLabel [] [x]
+
+generateConstructorE :: ParsedDatatype -> (Q TH.Type -> Q TH.Exp -> Q TH.Exp) -> Q TH.Exp
+generateConstructorE parsedDatatype g =
+  foldl' TH.appE (TH.conE (conName parsedDatatype)) . fmap generateFieldE $ fields parsedDatatype
+  where
+    generateFieldE ParsedField{..} =
+      case fieldVariant of
+        TableField -> g (pure fieldType) $ TH.varE fieldFreshName
+
+-- These two functions exist solely so we can write the splices without using TypeApplications, which require an extra language extension in client code, and are required here to appease the type checker.
+-- Otherwise it gets confused.
+deserialize' :: forall transposition expr a. Proxy expr -> (Serialize transposition expr a, transposition ~ (a == Transpose Result expr)) => Columns expr Result -> a
+deserialize' _ = deserialize @_ @expr
+
+serialize' :: forall transposition expr a. Proxy expr -> (Serialize transposition expr a, transposition ~ (a == Transpose Result expr)) => a -> Columns expr Result
+serialize' _ = serialize @_ @expr
+
+deriveRel8able :: TH.Name -> Q [TH.Dec]
+deriveRel8able name = do
+  datatypeInfo <- reifyDatatype name
+  parsedDatatype <- parseDatatype datatypeInfo
+  let gColumns = generateGColumns parsedDatatype
+  let constructorE = generateConstructorE parsedDatatype
+  let constructorP = pure $ TH.ConP (conName parsedDatatype) [] . toList . fmap (TH.VarP . fieldFreshName) $ fields parsedDatatype
+  let columnsE = generateColumnsE parsedDatatype
+  let columnsP = pure $ generateColumnsP parsedDatatype
+  contextName <- TH.newName "context"
+  [d|
+   instance {-# OVERLAPPING #-} (x ~ $(TH.conT name) Expr, result ~ Result) => ToExprs x ($(TH.conT name) result)
+   instance Rel8able $(TH.conT name) where
+          -- Really the Generic code substitutes Expr for f and then does stuff. Maybe we want to move closer to that?
+          type GColumns $( TH.conT name) =
+            $gColumns
+
+          type GFromExprs $( TH.conT name ) =
+            $( TH.conT name ) Result
+
+          -- the rest of the definition is just a few functions to go back and forth between Columns and the datatype
+          gfromColumns $( TH.varP contextName ) v =
+            case $( TH.varE contextName ) of
+              SResult    -> case v of $columnsP -> $(constructorE (\ft x -> [| deserialize' (Proxy :: Proxy $ft) $x |]))
+              SExpr      -> case v of $columnsP -> $(constructorE (\_ x -> [| fromColumns $x |] ))
+              SField     -> case v of $columnsP -> $(constructorE (\_ x -> [| fromColumns $x |] ))
+              SName      -> case v of $columnsP -> $(constructorE (\_ x -> [| fromColumns $x |] ))
+
+          gtoColumns $(TH.varP contextName) $constructorP =
+            case $( TH.varE contextName ) of
+              SExpr      -> $(columnsE (\_ x -> [| toColumns $x |]))
+              SField     -> $(columnsE (\_ x -> [| toColumns $x |]))
+              SName      -> $(columnsE (\_ x -> [| toColumns $x |]))
+              SResult    -> $(columnsE (\ft x -> [| serialize' (Proxy :: Proxy $ft) $x |]))
+
+          gfromResult $columnsP =
+              $( constructorE (\ft x -> [| deserialize' (Proxy :: Proxy $ft) $x |] ))
+
+          gtoResult $constructorP =
+              $( columnsE (\ft x -> [| serialize' (Proxy :: Proxy $ft) $x |] ))
+
+   |]
+
+-- | Walk 'TH.Type' and replace all occurences of @Column f x@ with @Expr x@.
+resolveColumnF :: TH.Name -> TH.Type -> TH.Type
+resolveColumnF fBinder (TH.ForallT tvs context t) =
+  TH.ForallT tvs context (resolveColumnF fBinder t)
+resolveColumnF fBinder (TH.AppT f x)
+  | TH.ConT columnName `TH.AppT` (TH.VarT fBinder') <- f
+  , columnName == ''Column
+  , fBinder == fBinder' = TH.AppT (TH.ConT ''Expr) (resolveColumnF fBinder x)
+  | otherwise = TH.AppT (resolveColumnF fBinder f) (resolveColumnF fBinder x)
+resolveColumnF fBinder (TH.SigT t k)      = TH.SigT (resolveColumnF fBinder t) (resolveColumnF fBinder k) -- k could be Kind
+resolveColumnF fBinder (TH.InfixT l c r)  = TH.InfixT (resolveColumnF fBinder l) c (resolveColumnF fBinder r)
+resolveColumnF fBinder (TH.UInfixT l c r) = TH.UInfixT (resolveColumnF fBinder l) c (resolveColumnF fBinder r)
+resolveColumnF fBinder (TH.ParensT t)     = TH.ParensT (resolveColumnF fBinder t)
+#if MIN_VERSION_template_haskell(2,15,0)
+resolveColumnF fBinder (TH.AppKindT t k)  = TH.AppKindT (resolveColumnF fBinder t) (resolveColumnF fBinder k)
+resolveColumnF fBinder (TH.ImplicitParamT n t)
+  = TH.ImplicitParamT n (resolveColumnF fBinder t)
+#endif
+#if MIN_VERSION_template_haskell(2,16,0)
+resolveColumnF fBinder (TH.ForallVisT tvs t) =
+  TH.ForallVisT tvs (resolveColumnF fBinder t)
+#endif
+#if MIN_VERSION_template_haskell(2,19,0)
+resolveColumnF fBinder (TH.PromotedInfixT l c r)
+  = TH.PromotedInfixT (resolveColumnF fBinder l) c (resolveColumnF fBinder r)
+resolveColumnF fBinder (TH.PromotedUInfixT l c r)
+  = TH.PromotedUInfixT (resolveColumnF fBinder l) c (resolveColumnF fBinder r)
+#endif
+resolveColumnF _ t = t
diff --git a/rel8/src/Rel8/Tabulate.hs b/rel8/src/Rel8/Tabulate.hs
index 77962513..3a5c3ce6 100644
--- a/rel8/src/Rel8/Tabulate.hs
+++ b/rel8/src/Rel8/Tabulate.hs
@@ -53,7 +53,7 @@ module Rel8.Tabulate
 where
 
 -- base
-import Control.Applicative ( (<|>), empty, liftA2 )
+import Control.Applicative ( (<|>), empty )
 import Control.Monad ( liftM2 )
 import Data.Bifunctor ( Bifunctor, bimap, first, second )
 import Data.Foldable ( traverse_ )
diff --git a/rel8/tests/Rel8/TH/Rel8able/Test.hs b/rel8/tests/Rel8/TH/Rel8able/Test.hs
new file mode 100644
index 00000000..f47869bb
--- /dev/null
+++ b/rel8/tests/Rel8/TH/Rel8able/Test.hs
@@ -0,0 +1,198 @@
+{-# language ScopedTypeVariables #-}
+{-# language DataKinds #-}
+{-# language DeriveAnyClass #-}
+{-# language DeriveGeneric #-}
+{-# language DerivingStrategies #-}
+{-# language DuplicateRecordFields #-}
+{-# language FlexibleInstances #-}
+{-# language MultiParamTypeClasses #-}
+{-# language OverloadedStrings #-}
+{-# language StandaloneDeriving #-}
+{-# language StandaloneKindSignatures #-}
+{-# language TypeApplications #-}
+{-# language TypeFamilies #-}
+{-# language TypeOperators #-}
+{-# language RecordWildCards #-}
+{-# language UndecidableInstances #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Rel8.TH.Rel8able.Test where
+-- aeson
+import Data.Aeson ( Value(..) )
+import qualified Data.Aeson.KeyMap as Aeson
+
+-- base
+import Data.Fixed ( Fixed ( MkFixed ), E2 )
+import Data.Int ( Int16, Int32, Int64 )
+import Data.Functor.Identity ( Identity(..) )
+import qualified Data.List.NonEmpty as NonEmpty
+import GHC.Generics ( Generic )
+import Prelude
+import Control.Applicative ( liftA3 )
+
+-- bytestring
+import Data.ByteString ( ByteString )
+import qualified Data.ByteString.Lazy as LB
+
+-- case-insensitive
+import Data.CaseInsensitive ( CI )
+import qualified Data.CaseInsensitive as CI
+
+-- containers
+import qualified Data.Map as Map
+
+-- hedgehog
+import qualified Hedgehog
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+
+-- rel8
+import Rel8 (
+  Column,
+  DBType,
+  Expr,
+  HADT,
+  HEither,
+  HKD,
+  HList,
+  HMaybe,
+  HNonEmpty,
+  HThese,
+  KRel8able,
+  Lift,
+  Name,
+  QualifiedName,
+  Rel8able,
+  Result,
+  TableSchema (TableSchema),
+  ToExprs,
+  namesFromLabels,
+  namesFromLabelsWith,
+ )
+import qualified Rel8
+
+-- scientific
+import Data.Scientific ( Scientific, fromFloatDigits )
+
+-- time
+import Data.Time.Calendar (Day)
+import Data.Time.Clock (UTCTime(..), secondsToDiffTime, secondsToNominalDiffTime)
+import Data.Time.LocalTime
+  ( CalendarDiffTime (CalendarDiffTime)
+  , LocalTime(..)
+  , TimeOfDay(..)
+  )
+
+-- text
+import Data.Text ( Text )
+import qualified Data.Text.Lazy as LT
+
+-- these
+import Data.These
+
+-- uuid
+import Data.UUID ( UUID )
+import qualified Data.UUID as UUID
+
+-- vector
+import qualified Data.Vector as Vector
+
+import Rel8.TH
+
+data TableTest f = TableTest
+  { foo :: Column f Bool
+  , bar :: Column f (Maybe Bool)
+  }
+
+deriveRel8able ''TableTest
+
+data TablePair f = TablePair
+  { foo :: Column f Bool
+  , bars :: (Column f Text, Column f Text)
+  }
+  
+deriveRel8able ''TablePair
+
+data TableDuplicate f = TableDuplicate
+  { foo :: TablePair f
+  , bar :: TablePair f
+  }
+
+deriveRel8able ''TableDuplicate 
+
+data TableMaybe f = TableMaybe
+  { foo :: Column f [Maybe Bool]
+  , bars :: HMaybe f (TablePair f, TablePair f)
+  }
+  
+deriveRel8able ''TableMaybe
+
+data TableEither f = TableEither
+  { foo :: Column f Bool
+  , bars :: HEither f (HMaybe f (TablePair f, TablePair f)) (Column f Char)
+  }
+  
+deriveRel8able ''TableEither
+
+data TableThese f = TableThese
+  { foo :: Column f Bool
+  , bars :: HThese f (TableMaybe f) (TableEither f)
+  }
+  
+deriveRel8able ''TableThese
+
+
+data TableList f = TableList
+  { foo :: Column f Bool
+  , bars :: HList f (TableThese f)
+  }
+  
+deriveRel8able ''TableList
+
+
+data TableNonEmpty f = TableNonEmpty
+  { foo :: Column f Bool
+  , bars :: HNonEmpty f (TableList f, TableMaybe f)
+  }
+  
+deriveRel8able ''TableNonEmpty
+
+data TableNest f = TableNest
+  { foo :: Column f Bool
+  , bars :: HList f (HMaybe f (TablePair f))
+  }
+  
+deriveRel8able ''TableNest
+
+
+data TableTestB f = TableTestB
+  { foo :: f Bool
+  , bar :: f (Maybe Bool)
+  }
+  
+--deriveRel8able ''TableTestB
+
+data NestedTableTestB f = NestedTableTestB
+  { foo :: f Bool
+  , bar :: f (Maybe Bool)
+  , baz :: Column f Char
+  , nest :: TableTestB f
+  }
+  
+--deriveRel8able ''NestedTableTestB
+
+newtype IdRecord a f = IdRecord { recordId :: Column f a }
+
+--deriveRel8able ''IdRecord
+
+data TableNumeric f = TableNumeric
+  { foo :: Column f (Fixed E2)
+  }
+  
+deriveRel8able ''TableNumeric
+
+
+data TableChar f = TableChar
+  { foo :: Column f Char
+  } 
+deriveRel8able ''TableChar