From ffa98e9196c427e07be6e6e7c4bbd6a5e1a45977 Mon Sep 17 00:00:00 2001
From: Ollie Charles <ollie@ocharles.org.uk>
Date: Tue, 14 Mar 2017 12:24:00 +0000
Subject: [PATCH] Smaller core

---
 Rel8.hs                  |  62 ++++-
 Rel8/IO.hs               |  15 +-
 Rel8/Internal.hs         |   1 -
 Rel8/Internal/Generic.hs | 101 --------
 Rel8/Internal/Table.hs   | 514 +++++++++++++++++++--------------------
 Rel8/Internal/Types.hs   |  54 +++-
 default.nix              |   3 +-
 doc/Example.hs           |  28 ++-
 rel8.cabal               |   5 +-
 9 files changed, 383 insertions(+), 400 deletions(-)
 delete mode 100644 Rel8/Internal/Generic.hs

diff --git a/Rel8.hs b/Rel8.hs
index 2681fad..38bf188 100644
--- a/Rel8.hs
+++ b/Rel8.hs
@@ -19,8 +19,10 @@ module Rel8
 
     -- * Defining Tables
     C
+  , Anon
   , HasDefault(..)
   , BaseTable(tableName)
+  , Table
 
     -- * Querying Tables
   , O.Query, O.QueryArr
@@ -43,6 +45,7 @@ module Rel8
   , asc, desc, orderNulls, O.orderBy, OrderNulls(..)
 
     -- * Aggregation
+    -- $aggregation
   , aggregate
   , AggregateTable
   , count, groupBy, DBSum(..), countStar, DBMin(..), DBMax(..), DBAvg(..)
@@ -50,7 +53,6 @@ module Rel8
   , countRows, Aggregate
 
     -- * Tables
-  , Table
   , MaybeTable, isTableNull
   , Col(..)
 
@@ -92,7 +94,7 @@ module Rel8
   , delete
 
     -- * Interpretations
-  , QueryResult, Schema, Anon
+  , QueryResult, SchemaInfo, Anon
 
     -- * Re-exported symbols
   , Connection, Stream, Of, Generic
@@ -105,10 +107,11 @@ module Rel8
   , dbBinOp
   ) where
 
+import Data.Functor.Rep (mzipWithRep)
 import Control.Applicative (liftA2)
 import Control.Category ((.), id)
+import Control.Lens (view, from)
 import Control.Monad.Rel8
-import Control.Monad.Zip
 import Data.List (foldl')
 import Data.Profunctor (lmap)
 import Data.Text (Text)
@@ -132,10 +135,8 @@ import qualified Opaleye.Operators as O
 import qualified Opaleye.Order as O
 import Prelude hiding (not, (.), id)
 import Rel8.Internal
-import Rel8.Internal.DBType
 import Streaming (Of, Stream)
 
-
 --------------------------------------------------------------------------------
 -- | Take the @LEFT JOIN@ of two queries.
 leftJoin
@@ -160,7 +161,7 @@ leftJoin condition l r =
 -- given query. The input to the 'QueryArr' is a predicate function against
 -- rows in the to-be-joined query.
 --
--- === __Example__
+-- === Example
 -- @
 -- -- Return all users and comments, including users who haven't made a comment.
 -- usersAndComments :: Query (User Expr, MaybeTable (Comment Expr))
@@ -242,11 +243,10 @@ unionAll =
        (O.PackMap
           (\f (l, r) ->
              fmap
-               (viewFrom expressions)
+               (view (from expressions))
                (sequenceA
-                  ((mzipWith
-                      (\(Some (Expr prim1)) (Some (Expr prim2)) ->
-                         Some . Expr <$> f (prim1, prim2))
+                  ((mzipWithRep
+                      (\prim1 prim2 -> f (prim1, prim2))
                       (view expressions l)
                       (view expressions r)))))))
 
@@ -314,6 +314,7 @@ unionAll =
      } deriving (Generic)
 
    instance 'BaseTable' Part where 'tableName' = \"part\"
+   instance 'Table' (Part 'Expr') (Part 'QueryResult')
    @
 
    The @Part@ table has 5 columns, each defined with the @C f ..@
@@ -325,9 +326,11 @@ unionAll =
       managed by the database.
    3. The type of the column.
 
-   After defining the table, we finally need to make an instance of 'BaseTable'
-   so @rel8@ can query this table. By using @deriving (Generic)@, we simply need
-   to write @instance BaseTable Part where tableName = "part"@.
+   After defining the table, we finally need to make instances of 'BaseTable' and
+   'Table' so @rel8@ can query this table. By using @deriving (Generic)@, we
+   simply need to write @instance BaseTable Part where tableName = "part"@. The
+   'Table' instance demonstrates that a @Part Expr@ value can be selected from
+   the database as @Part QueryResult@.
 
    === Querying tables
 
@@ -399,6 +402,7 @@ unionAll =
      } deriving (Generic)
 
    instance 'BaseTable' Supplier where 'tableName' = "supplier"
+   instance 'Table' (Supplier 'Expr') (Supplier 'QueryResult')
    @
 
    We can take the product of all parts paired against all suppliers:
@@ -493,3 +497,35 @@ unionAll =
    though in @rel8@ we're a little bit more general.
 
 -}
+
+
+{- $aggregation
+
+   To aggregate a series of rows, use the 'aggregate' query transform.
+   @aggregate@ takes a 'Query' that returns any 'AggregateTable' as a result.
+   @AggregateTable@s are like @Tables@, except that all expressions describe
+   a way to aggregate data. While tuples are instances of @AggregateTable@,
+   it's recommended to introduce new data types to represent aggregations for
+   clarity:
+
+   === Example
+
+   @
+   data UserInfo f = UserInfo
+     { userCount :: Anon f Int64
+     , latestLogin :: Anon f UTCTime
+     , uType :: Anon f Type
+     } deriving (Generic)
+
+   instance AggregateTable (UserInfo Aggregate) (UserInfo Expr)
+
+   userInfo :: Query (UserInfo Expr)
+   userInfo = aggregate $ proc _ -> do
+     user <- queryTable -< ()
+     returnA -< UserInfo { userCount = count (userId user)
+                         , latestLogin = max (userLastLoggedIn user)
+                         , uType = groupBy (userType user)
+                         }
+   @
+
+-}
diff --git a/Rel8/IO.hs b/Rel8/IO.hs
index 4601e07..5704374 100644
--- a/Rel8/IO.hs
+++ b/Rel8/IO.hs
@@ -22,6 +22,7 @@ module Rel8.IO
   , streamCursor
   ) where
 
+import Control.Lens (nullOf)
 import Control.Monad (void)
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -31,9 +32,9 @@ import qualified Data.List.NonEmpty as NEL
 import Data.Maybe (fromJust)
 import Data.String (fromString)
 import Database.PostgreSQL.Simple (Connection)
+import Database.PostgreSQL.Simple (defaultFoldOptions)
 import qualified Database.PostgreSQL.Simple as Pg
 import qualified Database.PostgreSQL.Simple.FromRow as Pg
-import Database.PostgreSQL.Simple (defaultFoldOptions)
 import Database.PostgreSQL.Simple.Streaming
        (queryWith_, streamWithOptionsAndParser_)
 import qualified Opaleye as O
@@ -41,8 +42,8 @@ import qualified Opaleye.Internal.RunQuery as O
 import qualified Opaleye.Internal.Table as O
 import Rel8.Internal.Expr
 import Rel8.Internal.Operators
-import Rel8.Internal.Table
-import Rel8.Internal.Types (Insert, QueryResult)
+import Rel8.Internal.Table hiding (columns)
+import Rel8.Internal.Types
 import Streaming (Stream, Of)
 import qualified Streaming.Prelude as S
 
@@ -61,7 +62,7 @@ type QueryRunner m = forall a. Pg.RowParser a -> Pg.Query -> Stream (Of a) m ()
 -- @
 -- 'stream' = 'queryWith_'
 -- @
-stream :: (MonadResource m, MonadMask m) => Connection -> QueryRunner m
+stream :: (MonadResource m) => Connection -> QueryRunner m
 stream conn parser query = queryWith_ parser conn query
 
 -- | Stream the results of a query and fetch the results using a PostgreSQL
@@ -139,7 +140,7 @@ update conn f up =
 -- | Update rows in a 'BaseTable' and return the results. Corresponds to
 -- @UPDATE ... RETURNING@.
 updateReturning
-  :: (BaseTable table, DBBool bool, MonadIO m)
+  :: (BaseTable table, DBBool bool)
   => QueryRunner m
   -> (table Expr -> Expr bool)
   -> (table Expr -> table Expr)
@@ -163,8 +164,8 @@ delete conn f =
 queryRunner :: Table a b => O.QueryRunner a b
 queryRunner =
   O.QueryRunner (void unpackColumns)
-                rowParser
-                (Prelude.not . null . view expressions)
+                (const rowParser)
+                (Prelude.not . nullOf (expressions . traverse))
 
 --------------------------------------------------------------------------------
 
diff --git a/Rel8/Internal.hs b/Rel8/Internal.hs
index dbb2b78..250a566 100644
--- a/Rel8/Internal.hs
+++ b/Rel8/Internal.hs
@@ -5,7 +5,6 @@ module Rel8.Internal (module X) where
 import Rel8.Internal.Aggregate as X
 import Rel8.Internal.DBType as X
 import Rel8.Internal.Expr as X
-import Rel8.Internal.Generic as X
 import Rel8.Internal.Operators as X
 import Rel8.Internal.Order as X
 import Rel8.Internal.Table as X
diff --git a/Rel8/Internal/Generic.hs b/Rel8/Internal/Generic.hs
deleted file mode 100644
index bf2aa10..0000000
--- a/Rel8/Internal/Generic.hs
+++ /dev/null
@@ -1,101 +0,0 @@
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module Rel8.Internal.Generic where
-
-import Control.Applicative (liftA2)
-import Data.Profunctor (dimap, lmap)
-import Data.Profunctor.Product ((***!))
-import Data.Proxy (Proxy(..))
-import GHC.Generics (K1(..), M1(..), (:*:)(..))
-import GHC.TypeLits (symbolVal, KnownSymbol)
-import qualified Opaleye.Internal.Column as O
-import qualified Opaleye.Internal.HaskellDB.PrimQuery as O
-import qualified Opaleye.Internal.Table as O
-import Prelude hiding (not, id)
-import Rel8.Internal.Expr
-import Rel8.Internal.Types
-
---------------------------------------------------------------------------------
--- | The class of values that can be traversed for 'O.PrimExpr's.
-
-class MapPrimExpr s where
-  mapPrimExpr :: Applicative f => (O.PrimExpr -> f O.PrimExpr) -> s -> f s
-
-instance MapPrimExpr (Expr column) where
-  mapPrimExpr f (Expr a) = fmap Expr (f a)
-
-
---------------------------------------------------------------------------------
--- | Witness the schema definition for table columns.
-class WitnessSchema a where
-  schema :: a
-
-instance KnownSymbol name =>
-         WitnessSchema (SchemaInfo name def t) where
-  schema = SchemaInfo (symbolVal (Proxy @name))
-
-
---------------------------------------------------------------------------------
-class GTraverseSchema schema expr | schema -> expr where
-  gtraverseSchema
-    :: Applicative f
-    => (forall a. String -> f (Expr a)) -> schema x -> f (expr y)
-
-instance (GTraverseSchema schema expr) =>
-         GTraverseSchema (M1 i c schema) (M1 i c expr) where
-  gtraverseSchema f (M1 a) = M1 <$> gtraverseSchema f a
-
-instance (GTraverseSchema fSchema fExpr, GTraverseSchema gSchema gExpr) =>
-         GTraverseSchema (fSchema :*: gSchema) (fExpr :*: gExpr) where
-  gtraverseSchema f (l :*: r) =
-    liftA2 (:*:) (gtraverseSchema f l) (gtraverseSchema f r)
-
-instance GTraverseSchema (K1 i (SchemaInfo name def a)) (K1 i (Expr a)) where
-  gtraverseSchema f (K1 (SchemaInfo a)) = K1 <$> f a
-
-
---------------------------------------------------------------------------------
--- | Form 'O.Writer's from a schema specification
-class Writer (f :: * -> *) schema expr | f schema -> expr where
-  columnWriter :: proxy f -> schema a -> O.Writer (expr a) ()
-
-instance (Writer f schema expr) =>
-         Writer f (M1 i c schema) (M1 i c expr) where
-  columnWriter p (M1 s) = lmap (\(M1 a) -> a) (columnWriter p s)
-
-instance (Writer f fSchema fExpr, Writer f gSchema gExpr) =>
-         Writer f (fSchema :*: gSchema) (fExpr :*: gExpr) where
-  columnWriter p (l :*: r) =
-    dimap (\(l' :*: r') -> (l', r')) fst (columnWriter p l ***! columnWriter p r)
-
-instance Writer Expr (K1 i (SchemaInfo name d a)) (K1 i (Expr a)) where
-  columnWriter _ (K1 (SchemaInfo name)) =
-    dimap
-      (\(K1 expr) -> exprToColumn expr)
-      (const ())
-      (O.required name)
-
-instance Writer Insert (K1 i (SchemaInfo name 'NoDefault a)) (K1 i (Expr a)) where
-  columnWriter _ (K1 (SchemaInfo name)) =
-    dimap
-      (\(K1 expr) -> exprToColumn expr)
-      (const ())
-      (O.required name)
-
-instance Writer Insert (K1 i (SchemaInfo name 'HasDefault a)) (K1 i (Default (Expr a))) where
-  columnWriter _ (K1 (SchemaInfo name)) =
-    dimap
-      (\(K1 def) ->
-         case def of
-           InsertDefault -> O.Column O.DefaultInsertExpr
-           OverrideDefault expr -> exprToColumn expr)
-      (const ())
-      (O.required name)
diff --git a/Rel8/Internal/Table.hs b/Rel8/Internal/Table.hs
index ec8cebd..1da9a16 100644
--- a/Rel8/Internal/Table.hs
+++ b/Rel8/Internal/Table.hs
@@ -1,39 +1,39 @@
-{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FunctionalDependencies #-}
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds #-}
 
 -- | This module defines the 'Table' type class.
 module Rel8.Internal.Table where
 
-import Data.Functor.Product
-import Data.Profunctor
-import Control.Applicative (liftA2)
+import Data.Proxy
+import GHC.TypeLits
+import Control.Applicative
+import Control.Lens (Iso', from, iso, view)
 import Control.Monad (replicateM_)
 import Data.Aeson (FromJSON, ToJSON)
-import Data.Functor.Compose (Compose(..))
+import Data.Foldable (traverse_)
 import Data.Functor.Identity
+import Data.Functor.Product
+import Data.Functor.Rep (Representable, index, tabulate, pureRep)
 import Data.Maybe (fromMaybe)
-import Data.Profunctor (dimap, lmap)
-import Data.Profunctor.Product ((***!))
-import Data.Proxy (Proxy(..))
+import Data.Profunctor (dimap)
 import Data.Tagged (Tagged(..), untag)
-import Database.PostgreSQL.Simple.FromField (FromField)
 import Database.PostgreSQL.Simple.FromRow (RowParser, field)
 import GHC.Generics
-       ((:*:)(..), Generic, K1(..), M1(..), Rep, from, to)
-import Generics.OneLiner
-       (ADTRecord, Constraints, For(..), createA, nullaryOp)
+       ((:*:)(..), Generic, K1(..), M1(..), Rep, to)
+import GHC.Generics.Lens (generic, _M1, _K1)
+import Generics.OneLiner (nullaryOp, ADTRecord, Constraints, For(..))
 import qualified Opaleye.Aggregate as O
 import qualified Opaleye.Column as O
 import qualified Opaleye.Internal.Aggregate as O
@@ -48,20 +48,7 @@ import Prelude hiding (not)
 import Prelude hiding (not, id)
 import Rel8.Internal.DBType
 import Rel8.Internal.Expr
-import Rel8.Internal.Generic
 import Rel8.Internal.Types
-import Control.Monad.Zip
-
---------------------------------------------------------------------------------
-
-data Some f where
-  Some :: f a -> Some f
-
-view :: ((a -> Identity b) -> (s -> Identity t)) -> s -> a
-view = undefined
-
-viewFrom :: ((a -> Identity b) -> (s -> Identity t)) -> a -> s
-viewFrom = undefined
 
 type family MkRowF a :: * -> * where
   MkRowF (M1 i c f) = MkRowF f
@@ -79,94 +66,90 @@ type family MkRowF a :: * -> * where
 -- 'Table' - but cannot be inserted as it doesn't belong to any base table.
 --
 -- You should not need to define your own instances of 'Table' in idiomatic
--- @rel8@ usage - all 'BaseTable's are 'Table's, and the tupling of two (or
--- more) 'Table's is also a 'Table'.
-class (MonadZip (RowF expr), Traversable (RowF expr)) => Table expr haskell | expr -> haskell, haskell -> expr where
+-- @rel8@ usage - beyond simplying deriving an instance and using generics.
+class (Representable (RowF expr), Traversable (RowF expr)) =>
+      Table expr haskell | expr -> haskell, haskell -> expr where
+
+  -- | Every 'Table' is isomorphic to a 'Functor' with finite cardinality
+  -- (a 'Representable' functor). This type witnesses what that functor
+  -- is. By default, this functor can be derived from the generic representation
+  -- of @expr@.
   type RowF expr :: * -> *
   type RowF expr = MkRowF (Rep expr)
 
-  rowParser :: expr -> RowParser haskell
+  -- | Witness the isomorphism between the expression's functor of primitive
+  -- expressions, and the user friendly expression type. A default
+  -- implementation is provided, assuming every field in @expr@ contains
+  -- exactly one 'Expr'.
+  expressions :: Iso' expr (RowF expr O.PrimExpr)
 
-  expressions
-    :: (Profunctor p, Functor f)
-    => p (RowF expr (Some Expr)) (f (RowF expr (Some Expr))) -> p expr (f expr)
-
-  ---------------------------------------------------------------------------------------
+  -- Every expression can be parsed into Haskell, once results have been
+  -- retrieved from the database. A generic implementation is provided which
+  -- assumes that every field in @haskell@ represents exactly one column
+  -- in the result.
+  rowParser :: RowParser haskell
 
   default
     rowParser
-      :: (Generic haskell, Generic expr, GTable (Rep expr) (Rep haskell))
-      => expr -> RowParser haskell
-  rowParser = fmap to . growParser . from
+      :: (Generic haskell, GTable (Rep expr) (Rep haskell))
+      => RowParser haskell
+  rowParser = fmap to growParser
 
   default
     expressions
       :: ( Generic expr
          , GTable (Rep expr) (Rep haskell)
-         , Functor f
-         , Profunctor p
          , RowF expr ~ MkRowF (Rep expr)
          )
-      => p (RowF expr (Some Expr)) (f (RowF expr (Some Expr))) -> p expr (f expr)
-  expressions = dimap from (fmap to) . gexpressions
+      => Iso' expr (RowF expr O.PrimExpr)
+  expressions = generic . gexpressions
 
 
 --------------------------------------------------------------------------------
 class GTable expr haskell | expr -> haskell, haskell -> expr where
-  growParser :: expr a -> RowParser (haskell a)
-  gexpressions
-    :: (Profunctor p, Functor f)
-    => p (MkRowF expr (Some Expr)) (f (MkRowF expr (Some Expr)))
-    -> p (expr ()) (f (expr ()))
+  growParser :: RowParser (haskell a)
+  gexpressions :: Iso' (expr a) (MkRowF expr O.PrimExpr)
 
 instance GTable expr haskell => GTable (M1 i c expr) (M1 i c haskell) where
-  growParser (M1 a) = M1 <$> growParser a
-  gexpressions = dimap (\(M1 a) -> view gexpressions a) (fmap (M1 . viewFrom gexpressions))
+  growParser = M1 <$> growParser
+  gexpressions = _M1 . gexpressions
 
 instance (GTable le lh, GTable re rh) =>
          GTable (le :*: re) (lh :*: rh) where
-  growParser (a :*: b) = liftA2 (:*:) (growParser a) (growParser b)
+  growParser = liftA2 (:*:) growParser growParser
   gexpressions =
-    dimap
-      (\(a :*: b) -> Pair (view gexpressions a) (view gexpressions b))
-      (fmap (\(Pair a b) -> viewFrom gexpressions a :*: viewFrom gexpressions b))
+    iso
+      (\(l :*: r) -> Pair (view gexpressions l) (view gexpressions r))
+      (\(Pair l r) ->
+         view (from gexpressions) l :*: view (from gexpressions) r)
 
-instance {-# OVERLAPPABLE #-} Table expr haskell => GTable (K1 i expr) (K1 i haskell) where
-  growParser (K1 expr) = K1 <$> rowParser expr
-  gexpressions = dimap (\(K1 a) -> view expressions a) (fmap (K1 . viewFrom expressions))
+instance {-# OVERLAPPABLE #-}
+         Table expr haskell => GTable (K1 i expr) (K1 i haskell) where
+  growParser = K1 <$> rowParser
+  gexpressions = _K1 . expressions
 
 instance DBType a =>
          GTable (K1 i (Expr a)) (K1 i a) where
-  growParser _ = K1 <$> field
+  growParser = K1 <$> field
   gexpressions =
-    dimap
-      (\(K1 a) -> Identity (Some a))
-      (fmap (\(Identity (Some (Expr prim))) -> K1 (Expr prim)))
+    iso
+      (\(K1 (Expr prim)) -> Identity prim)
+      (\(Identity prim) -> K1 (Expr prim))
 
 --------------------------------------------------------------------------------
 -- Stock instances of 'Table'
 
--- | Any 'BaseTable' is a 'Table'.
-instance {-# OVERLAPPABLE #-}
-         ( BaseTable table
-         , f ~ Expr
-         , g ~ QueryResult
-         , BaseTableF table ~ RowF (table Expr)
-         ) =>
-         Table (table f) (table g) where
-  rowParser _ = parseBaseTable
-  expressions = baseTableExprs
-
-instance (Table a a', Table b b') =>
-         Table (a, b) (a', b') where
+instance (Table a a', Table b b') => Table (a, b) (a', b') where
   type RowF (a, b) = Product (RowF a) (RowF b)
 
   expressions =
     dimap
       (\(l, r) -> Pair (view expressions l) (view expressions r))
-      (fmap (\(Pair l r) -> (viewFrom expressions l, viewFrom expressions r)))
+      (fmap
+         (\(Pair l r) ->
+            (view (from expressions) l, view (from expressions) r)))
 
-  rowParser (l, r) = (,) <$> rowParser l <*> rowParser r
+  rowParser = (,) <$> rowParser <*> rowParser
 
 instance (Table a a', Table b b', Table c c') =>
          Table (a, b, c) (a', b', c') where
@@ -180,11 +163,11 @@ instance (Table a a', Table b b', Table c c') =>
            (view expressions c))
       (fmap
          (\(Pair (Pair a b) c) ->
-            ( viewFrom expressions a
-            , viewFrom expressions b
-            , viewFrom expressions c)))
+            ( view (from expressions) a
+            , view (from expressions) b
+            , view (from expressions) c)))
 
-  rowParser (a, b, c) = (,,) <$> rowParser a <*> rowParser b <*> rowParser c
+  rowParser = (,,) <$> rowParser <*> rowParser <*> rowParser
 
 instance (Table a a', Table b b', Table c c', Table d d') =>
          Table (a, b, c, d) (a', b', c', d') where
@@ -200,16 +183,16 @@ instance (Table a a', Table b b', Table c c', Table d d') =>
            (view expressions d))
       (fmap
          (\(Pair (Pair (Pair a b) c) d) ->
-            ( viewFrom expressions a
-            , viewFrom expressions b
-            , viewFrom expressions c
-            , viewFrom expressions d)))
+            ( view (from expressions) a
+            , view (from expressions) b
+            , view (from expressions) c
+            , view (from expressions) d)))
 
-  rowParser (a, b, c, d) =
-    (,,,) <$> rowParser a
-          <*> rowParser b
-          <*> rowParser c
-          <*> rowParser d
+  rowParser =
+    (,,,) <$> rowParser
+          <*> rowParser
+          <*> rowParser
+          <*> rowParser
 
 instance (Table a a', Table b b', Table c c', Table d d', Table e e') =>
          Table (a, b, c, d, e) (a', b', c', d', e') where
@@ -227,18 +210,18 @@ instance (Table a a', Table b b', Table c c', Table d d', Table e e') =>
            (view expressions e))
       (fmap
          (\(Pair (Pair (Pair (Pair a b) c) d) e) ->
-            ( viewFrom expressions a
-            , viewFrom expressions b
-            , viewFrom expressions c
-            , viewFrom expressions d
-            , viewFrom expressions e)))
+            ( view (from expressions) a
+            , view (from expressions) b
+            , view (from expressions) c
+            , view (from expressions) d
+            , view (from expressions) e)))
 
-  rowParser (a, b, c, d, e) =
-    (,,,,) <$> rowParser a
-           <*> rowParser b
-           <*> rowParser c
-           <*> rowParser d
-           <*> rowParser e
+  rowParser =
+    (,,,,) <$> rowParser
+           <*> rowParser
+           <*> rowParser
+           <*> rowParser
+           <*> rowParser
 
 
 --------------------------------------------------------------------------------
@@ -249,25 +232,27 @@ data MaybeTable row = MaybeTable (Expr (Maybe Bool)) row
 
 -- | The result of a left/right join is a table, but the table may be entirely
 -- @null@ sometimes.
-instance (Table expr haskell) =>
-         Table (MaybeTable expr) (Maybe haskell) where
+instance (Table expr haskell) => Table (MaybeTable expr) (Maybe haskell) where
   type RowF (MaybeTable expr) = Product Identity (RowF expr)
 
   expressions =
     dimap
-      (\(MaybeTable tag row) -> Pair (view expressions tag) (view expressions row))
+      (\(MaybeTable tag row) ->
+         Pair (view expressions tag) (view expressions row))
       (fmap
          (\(Pair tag row) ->
-            MaybeTable (viewFrom expressions tag) (viewFrom expressions row)))
+            MaybeTable
+              (view (from expressions) tag)
+              (view (from expressions) row)))
 
-  rowParser (MaybeTable _ row)  = do
+  rowParser = do
     isNull' <- field
     if fromMaybe True isNull'
-      then Nothing <$ replicateM_ (length (view expressions row)) (field :: RowParser (Maybe ()))
-      else fmap Just (rowParser row)
-
-  -- traverseBinary f (MaybeTable tagL l, MaybeTable tagR r) =
-  --   MaybeTable <$> traverseBinary f (tagL, tagR) <*> traverseBinary f (l, r)
+      then Nothing <$
+           replicateM_
+             (length (pureRep () :: RowF expr ()))
+             (field :: RowParser (Maybe ()))
+      else fmap Just rowParser
 
 -- | Project an expression out of a 'MaybeTable', preserving the fact that this
 -- column might be @null@. Like field selection.
@@ -328,19 +313,18 @@ newtype Col a = Col { unCol :: a }
   deriving (Show, ToJSON, FromJSON, Read, Eq, Ord)
 
 -- | Single 'Expr'essions are tables, but the result will be wrapped in 'Col'.
-instance (DBType a) =>
-         Table (Expr a) (Col a) where
+instance DBType a => Table (Expr a) (Col a) where
   type RowF (Expr a) = Identity
-  expressions = dimap (Identity . Some) (fmap (\(Identity (Some (Expr prim))) -> Expr prim))
-  rowParser _ = fmap Col field
+  expressions = dimap (\(Expr a) -> return a) (fmap (Expr . runIdentity))
+  rowParser = fmap Col field
 
 --------------------------------------------------------------------------------
 traversePrimExprs
   :: (Applicative f, Table expr haskell)
   => (O.PrimExpr -> f O.PrimExpr) -> expr -> f expr
-traversePrimExprs f =
-  fmap (viewFrom expressions) .
-  traverse (\(Some (Expr prim)) -> Some . Expr <$> f prim) . view expressions
+traversePrimExprs f expr =
+  expressions (traverse f) expr
+
 
 --------------------------------------------------------------------------------
 unpackColumns :: Table expr haskell => O.Unpackspec expr expr
@@ -349,130 +333,103 @@ unpackColumns = O.Unpackspec (O.PackMap traversePrimExprs)
 
 --------------------------------------------------------------------------------
 -- | A 'BaseTable' is a table that is specified directly in a relational
--- database schema with @CREATE TABLE@. You introduce 'BaseTables' by defining
--- Haskell records parameterised over some functor @f@, and then use 'C' to
--- define individual columns. Finally, derive 'Generic' and provide a minimal
--- 'BaseTable' instance.
---
--- === Example
---
--- @
--- data Part f =
---   Part { partId     :: 'C' f \"PID\" ''HasDefault' Int
---        , partName   :: 'C' f \"PName\" ''NoDefault' Text
---        , partColor  :: 'C' f \"Color\" ''NoDefault' Int
---        } deriving (Generic)
---
--- instance 'BaseTable' Part where tableName = "part"
--- @
-class (Table (table Expr) (table QueryResult)) => BaseTable table where
-  type BaseTableF table :: * -> *
-  type BaseTableF table = MkRowF (Rep (table Expr))
+-- database schema with @CREATE TABLE@. This allows you to both @SELECT FROM@
+-- rows from this table, @UPDATE@ and @DELETE@ existing rows and @INSERT@ new
+-- rows.
 
+class Table (table Expr) (table QueryResult) => BaseTable table where
   -- | The name of this table in the database. You can use the 'FromString'
   -- instance for 'Tagged' to simply write
   -- @tableName = "employees"@, for example.
   tableName :: Tagged table String
 
   -- | Witness the schema of a table at the value level.
-  tableSchema :: table Schema
+  columns :: table SchemaInfo
 
-  -- | Parse query results for this table.
-  parseBaseTable :: RowParser (table QueryResult)
-
-  -- | Traverse over all column names in a schema, converting to 'Expr's that
-  -- would select those columns.
-  traverseSchema
-    :: Applicative f
-    => (forall a. String -> f (Expr a)) -> table Schema -> f (table Expr)
-
-  -- | Traverse over all primitive expressions in a table of expressions.
-  baseTableExprs
-    :: (Profunctor p, Functor f)
-    => p (BaseTableF table (Some Expr)) (f (BaseTableF table (Some Expr)))
-    -> p (table Expr) (f (table Expr))
-
-  -- | Traverse over all aggregates in a table of aggregations, converting them
-  -- to the expressions that refer to aggregation results.
-  traverseBaseTableAggregates :: O.Aggregator (table Aggregate) (table Expr)
-
-  insertWriter :: O.Writer (table Insert) a
-
-  updateWriter :: O.Writer (table Expr) a
+  -- | Any 'BaseTable' is isomorphic to a set of interpretations. These
+  -- interpretations can be viewed as colimits if we throw away the type
+  -- information.
+  tabular
+    :: Interpretation f
+    -> Iso' (table f) (RowF (table Expr) (Colimit f))
 
   ------------------------------------------------------------------------------
 
   default
-    parseBaseTable :: ( ADTRecord (table QueryResult)
-                      , Constraints (table QueryResult) FromField
-                      )
-                   => RowParser (table QueryResult)
-  parseBaseTable =
-    head (getCompose (createA (For :: For FromField) (Compose [field])))
-
-  default
-    tableSchema
-      :: (ADTRecord (table Schema), Constraints (table Schema) WitnessSchema)
-      => table Schema
-  tableSchema = nullaryOp (For :: For WitnessSchema) schema
-
-  default
-    traverseSchema
-      :: ( GTraverseSchema (Rep (table Schema)) (Rep (table Expr))
-         , Generic (table Schema)
-         , Generic (table Expr)
-         , Applicative f
+    columns
+      :: ( ADTRecord (table SchemaInfo)
+         , Constraints (table SchemaInfo) WitnessSchema
          )
-      => (forall a. String -> f (Expr a)) -> table Schema -> f (table Expr)
-  traverseSchema f = fmap to . gtraverseSchema f . from
+      => table SchemaInfo
+  columns = nullaryOp (For :: For WitnessSchema) schema
 
   default
-    baseTableExprs
-      :: ( Generic (table Expr)
-         , GTable (Rep (table Expr)) (Rep (table QueryResult))
-         , Functor f
-         , Profunctor p
-         , RowF (table Expr) ~ MkRowF (Rep (table Expr))
+    tabular
+      :: ( Generic (table f)
+         , GTabular Expr (Rep (table Expr)) (RowF (table Expr))
+         , GTabular SchemaInfo (Rep (table SchemaInfo)) (RowF (table Expr))
+         , GTabular Insert (Rep (table Insert)) (RowF (table Expr))
          )
-      => p (RowF (table Expr) (Some Expr)) (f (RowF (table Expr) (Some Expr)))
-      -> p (table Expr) (f (table Expr))
-  baseTableExprs = dimap from (fmap to) . gexpressions
-
-  default
-    traverseBaseTableAggregates
-      :: ( GTraverseAggregator (Rep (table Aggregate)) (Rep (table Expr))
-         , Generic (table Expr)
-         , Generic (table Aggregate)
-         )
-      => O.Aggregator (table Aggregate) (table Expr)
-  traverseBaseTableAggregates = dimap from to gaggregator
-
-  default
-    updateWriter
-      :: ( ADTRecord (table Expr)
-         , ADTRecord (table Schema)
-         , Writer Expr (Rep (table Schema)) (Rep (table Expr))
-         )
-      => O.Writer (table Expr) a
-  updateWriter =
-    case lmap from (columnWriter (Proxy @Expr) (from (tableSchema @table))) of
-      O.Writer f -> O.Writer f
-
-  default
-    insertWriter :: ( ADTRecord (table Schema)
-                    , Writer Insert (Rep (table Schema)) (Rep (table Insert))
-                    , Generic (table Insert)
-                    )
-                 => O.Writer (table Insert) a
-  insertWriter =
-    case lmap from (columnWriter (Proxy @Insert) (from (tableSchema @table))) of
-      O.Writer f -> O.Writer f
+      => Interpretation f -> Iso' (table f) (RowF (table Expr) (Colimit f))
+  tabular AsExpr = generic . gtabular AsExpr
+  tabular AsSchemaInfo = generic . gtabular AsSchemaInfo
+  tabular AsInsert = generic . gtabular AsInsert
 
 --------------------------------------------------------------------------------
-viewTable :: BaseTable table => table Expr
+class GTabular i repIn repOut where
+  gtabular :: Interpretation i -> Iso' (repIn a) (repOut (Colimit i))
+
+instance GTabular i repIn repOut => GTabular i (M1 meta c repIn) repOut where
+  gtabular i = _M1 . gtabular i
+
+instance (GTabular i inl outl, GTabular i inr outr) =>
+         GTabular i (inl :*: inr) (Product outl outr) where
+  gtabular i =
+    iso
+      (\(a :*: b) -> Pair (view (gtabular i) a) (view (gtabular i) b))
+      (\(Pair a b) -> view (from (gtabular i)) a :*: view (from (gtabular i)) b)
+
+instance GTabular Expr (K1 i (Expr a)) Identity where
+  gtabular _ =
+    _K1 . iso (Identity . Colimit) (\(Identity (Colimit (Expr a))) -> Expr a)
+
+instance GTabular SchemaInfo (K1 i (SchemaInfo (a :: k))) Identity where
+  gtabular _ =
+    _K1 .
+    iso
+      (\(SchemaInfo a) -> Identity (Colimit (SchemaInfo a)))
+      (\(Identity (Colimit (SchemaInfo a))) -> SchemaInfo a)
+
+-- This is only proper if OverrideDefault DefaultInsertExpr can't occur.
+instance GTabular Insert (K1 i (Default (Expr a))) Identity where
+  gtabular _ = _K1 . iso forward backward
+    where
+      forward (OverrideDefault a) = Identity (Colimit (InsertExpr a))
+      forward InsertDefault =
+        Identity (Colimit (InsertExpr (Expr O.DefaultInsertExpr)))
+      backward (Identity (Colimit (InsertExpr (Expr O.DefaultInsertExpr)))) =
+        InsertDefault
+      backward (Identity (Colimit (InsertExpr (Expr prim)))) =
+        OverrideDefault (Expr prim)
+
+instance GTabular Insert (K1 i (Expr a)) Identity where
+  gtabular _ = _K1 . iso forward backward
+    where
+      forward = Identity . Colimit . InsertExpr
+      backward (Identity (Colimit (InsertExpr (Expr a)))) = Expr a
+
+
+--------------------------------------------------------------------------------
+viewTable
+  :: forall table.
+     BaseTable table
+  => table Expr
 viewTable =
-  runIdentity
-    (traverseSchema (Identity . Expr . O.BaseTableAttrExpr) tableSchema)
+  view
+    (from expressions)
+    (fmap
+       (\(Colimit (SchemaInfo str)) -> O.BaseTableAttrExpr str)
+       (view (tabular AsSchemaInfo) (columns @table)))
 
 
 --------------------------------------------------------------------------------
@@ -491,7 +448,23 @@ tableDefinition
 tableDefinition =
   O.Table
     (untag @table tableName)
-    (O.TableProperties insertWriter (O.View viewTable))
+    (O.TableProperties
+       (O.Writer
+          (O.PackMap
+             (\f a ->
+                let columnName =
+                      index
+                        (fmap
+                           (\(Colimit (SchemaInfo str)) -> str)
+                           (view (tabular AsSchemaInfo) (columns @table)))
+                    exprs =
+                      fmap
+                        (fmap (\(Colimit (InsertExpr (Expr x))) -> x) .
+                         view (tabular AsInsert))
+                        a
+                    foo rep = f (fmap (`index` rep) exprs, columnName rep)
+                in traverse_ id (tabulate @(RowF (table Expr)) foo))))
+       (O.View viewTable))
 
 tableDefinitionUpdate
   :: forall table.
@@ -500,76 +473,91 @@ tableDefinitionUpdate
 tableDefinitionUpdate =
   O.Table
     (untag @table tableName)
-    (O.TableProperties updateWriter (O.View viewTable))
+    (O.TableProperties
+       (O.Writer
+          (O.PackMap
+             (\f a ->
+                let columnName =
+                      index
+                        (fmap
+                           (\(Colimit (SchemaInfo str)) -> str)
+                           (view (tabular AsSchemaInfo) (columns @table)))
+                    exprs = fmap (view expressions) a
+                    foo rep = f (fmap (`index` rep) exprs, columnName rep)
+                in traverse_ id (tabulate @(RowF (table Expr)) foo))))
+       (O.View viewTable))
 
 
 --------------------------------------------------------------------------------
 -- | 'AggregateTable' is used to demonstrate that a table only contains
 -- aggregation or @GROUP BY@ expressions. If you wish to use your own records
 -- for aggregation results, parameterise the record over @f@, use 'Anon' to
--- specify the columns, and then generically derive 'AggregateTable':
---
--- __Example__
---
--- @
--- data UserInfo f = UserInfo
---   { userCount :: Anon f Int64
---   , latestLogin :: Anon f UTCTime
---   } deriving (Generic)
--- instance AggregateTable (UserInfo Aggregate) (UserInfo Expr)
--- @
-
+-- specify the columns, and then generically derive 'AggregateTable'
 class AggregateTable columns result | columns -> result, result -> columns where
-  traverseAggregates :: O.Aggregator columns result
+  aggregations :: Iso' columns (RowF result (Limit Aggregate))
 
   default
-    traverseAggregates
-      :: ( GTraverseAggregator (Rep columns) (Rep result)
-         , Generic columns
-         , Generic result
-         )
-      => O.Aggregator columns result
-  traverseAggregates = dimap from to gaggregator
+    aggregations
+      :: (GTraverseAggregator (Rep columns) (Rep result), Generic columns)
+      => Iso' columns (MkRowF (Rep result) (Limit Aggregate))
+  aggregations = generic . gaggregations
 
 -- | A single column aggregates to a single expression.
 instance AggregateTable (Aggregate a) (Expr a) where
-  traverseAggregates =
-    O.Aggregator (O.PackMap (\f (Aggregate a b) -> fmap Expr (f (a, b))))
+  aggregations =
+    iso
+      (\(Aggregate a e) -> Identity (Limit (Aggregate a e)))
+      (runLimit . runIdentity)
 
 instance (AggregateTable a1 b1, AggregateTable a2 b2) =>
          AggregateTable (a1, a2) (b1, b2) where
-  traverseAggregates = traverseAggregates ***! traverseAggregates
-
--- | Any base table can be aggregated, provided you specify how to aggregate
--- each column.
-instance {-# OVERLAPPABLE #-}
-  (BaseTable table, f ~ Aggregate, g ~ Expr) => AggregateTable (table f) (table g) where
-  traverseAggregates = traverseBaseTableAggregates
+  aggregations =
+    iso
+      (\(a, b) -> Pair (view aggregations a) (view aggregations b))
+      (\(Pair l r) ->
+         (view (from aggregations) l, view (from aggregations) r))
 
 --------------------------------------------------------------------------------
 class GTraverseAggregator aggregator expr | aggregator -> expr where
-  gaggregator
-    :: O.Aggregator (aggregator x) (expr y)
+  gaggregations
+    :: Iso' (aggregator x) (MkRowF expr (Limit Aggregate))
 
-instance (GTraverseAggregator aggregator expr) =>
-         GTraverseAggregator (M1 i c aggregator) (M1 i c expr) where
-  gaggregator = dimap (\(M1 a) -> a) M1 gaggregator
+instance (GTraverseAggregator aggregator f) =>
+         GTraverseAggregator (M1 i c aggregator) (M1 i c f) where
+  gaggregations = _M1 . gaggregations
 
 instance ( GTraverseAggregator fAggregator fExpr
          , GTraverseAggregator gAggregator gExpr
          ) =>
          GTraverseAggregator (fAggregator :*: gAggregator) (fExpr :*: gExpr) where
-  gaggregator =
-    dimap (\(a :*: b) -> (a, b)) (uncurry (:*:)) (gaggregator ***! gaggregator)
+  gaggregations =
+    iso
+      (\(a :*: b) -> Pair (view gaggregations a) (view gaggregations b))
+      (\(Pair a b) ->
+         view (from gaggregations) a :*: view (from gaggregations) b)
 
 instance AggregateTable a b => GTraverseAggregator (K1 i a) (K1 i b) where
-  gaggregator = dimap (\(K1 a) -> a) K1 traverseAggregates
+  gaggregations = _K1 . aggregations
 
 
 --------------------------------------------------------------------------------
 -- | Evaluate aggregation over a query. The 'AggregateTable' constraint
 -- requires that all columns in each row must be grouped or aggregated.
 aggregate
-  :: AggregateTable table result
+  :: (AggregateTable table result, Table result haskell)
   => O.Query table -> O.Query result
-aggregate = O.aggregate traverseAggregates
+aggregate =
+  O.aggregate $
+  O.Aggregator $
+  O.PackMap $ \f ->
+    fmap (view (from expressions)) .
+    traverse (\(Limit (Aggregate a e)) -> f (a, e)) . view aggregations
+
+--------------------------------------------------------------------------------
+-- | Witness the schema definition for table columns.
+class WitnessSchema a where
+  schema :: a
+
+instance KnownSymbol name =>
+         WitnessSchema (SchemaInfo '(name, (def :: k), (t :: j))) where
+  schema = SchemaInfo (symbolVal (Proxy @name))
diff --git a/Rel8/Internal/Types.hs b/Rel8/Internal/Types.hs
index 6696ffd..9c515b9 100644
--- a/Rel8/Internal/Types.hs
+++ b/Rel8/Internal/Types.hs
@@ -1,12 +1,14 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE RoleAnnotations #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Rel8.Internal.Types where
 
-import GHC.TypeLits (Symbol)
-import Rel8.Internal.Expr (Expr)
+import Rel8.Internal.Expr
 import qualified Opaleye.Internal.HaskellDB.PrimQuery as O
 
 --------------------------------------------------------------------------------
@@ -18,16 +20,14 @@ data QueryResult column
 -- Used to indicate that we will be inserting values. If columns are marked as
 -- having a default value, it will be possible to use 'Default' to let the
 -- database generate a value.
-data Insert a
+data Insert a = InsertExpr (Expr a)
 
 
 --------------------------------------------------------------------------------
 -- | Used internal to reflect the schema of a table from types into values.
-data Schema a
-
---------------------------------------------------------------------------------
-data SchemaInfo (name :: Symbol) (hasDefault :: HasDefault) t =
+data SchemaInfo a =
   SchemaInfo String
+  deriving (Show)
 
 
 --------------------------------------------------------------------------------
@@ -42,14 +42,13 @@ data Default a
   = OverrideDefault a
   | InsertDefault
 
-
 --------------------------------------------------------------------------------
 {-| All metadata about a column in a table.
 
     'C' is used to specify information about individual columns in base
     tables.
 
-    === __Example__
+    === Example
 
     @
     data Employee f =
@@ -59,17 +58,50 @@ data Default a
 type family C f columnName hasDefault columnType :: * where
   C Expr _name _def t = Expr t
   C QueryResult _name _def t = t
-  C Schema name hasDefault t = SchemaInfo name hasDefault t
+  C SchemaInfo name hasDefault t = SchemaInfo '(name, hasDefault, t)
   C Insert name 'HasDefault t = Default (Expr t)
   C Insert name 'NoDefault t = Expr t
   C Aggregate name _ t = Aggregate t
 
-
+-- | @Anon@ can be used to define columns like 'C', but does not contain the
+-- extra metadata needed to define a 'BaseTable' instance. The main use of
+-- 'Anon' is to define "anonymous" tables that represent the intermediate
+-- parts of a query.
+--
+-- === Example
+--
+-- @
+-- data EmployeeAndManager f = EmployeeAndManager
+--   { employee :: Anon f Text
+--   , manager :: Anon f Text
+--   }
+--
+-- employeeAndManager :: Query (EmployeeAndManager Expr)
+-- employeeAndManager = proc _ -> do
+--   employee <- queryTable -< ()
+--   manager <- queryTable -< ()
+--   where_ -< employeeManager employee ==. managerId manager
+--   id -< EmployeeAndManager { employee = employeeName employee
+--                            , manager = managerName manager
+--                            }
+-- @
 type family Anon f columnType :: * where
   Anon Expr t = Expr t
   Anon QueryResult t = t
   Anon Aggregate t = Aggregate t
 
+newtype Limit f = Limit
+  { runLimit :: forall a. f a
+  }
+
+data Colimit f where
+  Colimit :: f a -> Colimit f
+
+data Interpretation f where
+  AsExpr :: Interpretation Expr
+  AsSchemaInfo :: Interpretation SchemaInfo
+  AsInsert :: Interpretation Insert
+
 --------------------------------------------------------------------------------
 -- | Indicate whether or not a column has a default value. Used in conjunction
 -- with 'C'
diff --git a/default.nix b/default.nix
index 810b855..f849853 100644
--- a/default.nix
+++ b/default.nix
@@ -1,6 +1,7 @@
 { mkDerivation, base, one-liner, opaleye, postgresql-simple
 , product-profunctors, profunctors, scientific, stdenv, streaming
 , tagged, text, exceptions, free, streaming-postgresql-simple
+, lens
 }:
 mkDerivation {
   pname = "rel8";
@@ -9,7 +10,7 @@ mkDerivation {
   libraryHaskellDepends = [
     base one-liner opaleye postgresql-simple product-profunctors
     profunctors scientific streaming tagged text exceptions free
-    streaming-postgresql-simple
+    streaming-postgresql-simple lens
   ];
   license = stdenv.lib.licenses.bsd3;
 }
diff --git a/doc/Example.hs b/doc/Example.hs
index d1bdd91..e7e5e2a 100644
--- a/doc/Example.hs
+++ b/doc/Example.hs
@@ -1,10 +1,12 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE StandaloneDeriving #-}
 -- This is the example from the documentation. We don't run any tests,
 -- just compiling is deemed satisfactory. If this fails to compile,
 -- make sure to update the documentation with the necessary changes!
 
 {-# LANGUAGE Arrows, DataKinds, DeriveGeneric, FlexibleInstances,
-             OverloadedStrings #-}
+             OverloadedStrings, MultiParamTypeClasses #-}
 
 module Main where
 
@@ -13,6 +15,27 @@ import Control.Arrow
 import Rel8
 import Data.Int
 
+data Small f =
+  Small { smallId     :: C f "PID" 'HasDefault Int32
+       , smallName   :: C f "PName" 'NoDefault String
+       -- , partColor  :: C f "Color" 'NoDefault Int32
+       -- , partWeight :: C f "Weight" 'NoDefault Double
+       -- , partCity   :: C f "City" 'NoDefault String
+       } deriving (Generic)
+
+instance Table (Small Expr) (Small QueryResult)
+instance BaseTable Small where
+  tableName = "small"
+  -- tabular DomExpr =
+  --   iso
+  --     (\s@(Small a b) -> Pair (Identity (Colimit a)) (Identity (Colimit b)))
+  --     (\(Pair (Identity (Colimit (Expr a))) (Identity (Colimit (Expr b)))) -> Small (Expr a) (Expr b))
+  -- tabular DomSchemaInfo =
+  --   iso
+  --     (\s@(Small a b) -> Pair (Identity (Colimit a)) (Identity (Colimit b)))
+  --     (\(Pair (Identity (Colimit (Expr a))) (Identity (Colimit (Expr b)))) -> Small (Expr a) (Expr b))
+
+
 data Part f =
   Part { partId     :: C f "PID" 'HasDefault Int32
        , partName   :: C f "PName" 'NoDefault String
@@ -21,8 +44,10 @@ data Part f =
        , partCity   :: C f "City" 'NoDefault String
        } deriving (Generic)
 
+instance Table (Part Expr) (Part QueryResult)
 instance BaseTable Part where tableName = "part"
 deriving instance Show (Part QueryResult)
+deriving instance Show (Part SchemaInfo)
 
 allParts :: Query (Part Expr)
 allParts = queryTable
@@ -54,6 +79,7 @@ data Supplier f = Supplier
   , supplierCity :: C f "City" 'NoDefault String
   } deriving (Generic)
 
+instance Table (Supplier Expr) (Supplier QueryResult)
 instance BaseTable Supplier where tableName = "supplier"
 deriving instance Show (Supplier QueryResult)
 
diff --git a/rel8.cabal b/rel8.cabal
index f33f227..2970f71 100644
--- a/rel8.cabal
+++ b/rel8.cabal
@@ -24,7 +24,6 @@ library
   other-modules:       Rel8.Internal.Aggregate
                        Rel8.Internal.DBType
                        Rel8.Internal.Expr
-                       Rel8.Internal.Generic
                        Rel8.Internal.Operators
                        Rel8.Internal.Order
                        Rel8.Internal.Table
@@ -53,9 +52,11 @@ library
                      , transformers
                      , uuid
                      , vector
+                     , lens
+                     , adjunctions
   -- hs-source-dirs:
   default-language:    Haskell2010
-  ghc-options:         -Wall
+  ghc-options:         -Wall -fwarn-redundant-constraints -fwarn-incomplete-uni-patterns
 
 
 test-suite example